- AQAOPV22 ; IHS/ORDC/LJF - PRINT QI CODES BY NUMBER ;
- ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
- ;
- ;This routine prints listing of providers, persons, and/or vendors
- ;in order by QI code number.
- ;Routine added with Enhancement #1
- ;
- ;-- Logic Flow:
- ; ASK to ask user which groups to include (prov, pers, +/or vend)
- ; DEV to select print device
- ; PRINT checks groups selected:
- ; if ihs provider or employee selected:
- ; use PERSON^AQAOPV21 to print data for providers/persons
- ; if chs provider selected:
- ; use VENDOR^AQAOPV21 to print data for chs vendors
- ; EXIT to clean up and quit
- ;
- D BYNUM2^AQAOHPRV ;intro text
- ;
- ASK ; -- ask for groups to include
- K DIR W !! S DIR(0)="LO^1:3"
- S DIR("A")="Select ALL groups you want in report"
- S DIR("A",1)=" 1. Include IHS PROVIDERS"
- S DIR("A",2)=" 2. Include IHS EMPLOYEES"
- S DIR("A",3)=" 3. Include CHS PROVIDERS"
- S DIR("A",4)=" "
- D ^DIR I $D(DIRUT) D EXIT Q
- S AQAOSEL=Y
- ;
- ;
- DEV ; -- SUBRTN to get print device and call print rtn
- W !! S %ZIS="QP" D ^%ZIS
- I POP D EXIT Q
- I '$D(IO("Q")) D PRINT Q
- K IO("Q") S ZTRTN="PRINT^AQAOPV22",ZTDESC="QI CODES BY NUMBER"
- S ZTSAVE("AQAOSEL")="" D ^%ZTLOAD K ZTSK D ^%ZISC
- D PRTOPT^AQAOVAR D EXIT Q
- ;
- ;
- EXIT ; -- SUBRTN for eoj
- I '$D(ZTQUEUED),(IOST["C-") D PRTOPT^AQAOVAR ;ask to hit return
- D ^%ZISC D KILL^AQAOUTIL Q
- ;
- ;
- PRINT ;EP; -- check user selections and call proper subrtn
- U IO D INIT^AQAOUTIL S AQAOHCON="Provider"
- S AQAOTY="QI CODES BY NUMBER"
- D HEADING^AQAOUTIL,HEADING2
- ;
- I AQAOSEL[3 D VENDOR
- I (AQAOSEL[1)!(AQAOSEL[2) D PERSON
- D EXIT
- Q
- ;
- ;
- PERSON ; -- SUBRTN to print provider/person data
- NEW AQAO,AQAOX S AQAOX=0
- F S AQAOX=$O(^VA(200,AQAOX)) Q:AQAOX'=+AQAOX Q:AQAOSTOP=U D
- . Q:'$D(^VA(200,AQAOX,0))
- . I (AQAOSEL[1),(AQAOSEL'[2) Q:'$D(^XUSEC("PROVIDER",AQAOX))
- . I $Y>(IOSL-3) D NEWPG^AQAOUTIL Q:AQAOSTOP=U D HEADING2
- . D PERSON^AQAOPV21("I",AQAOX)
- Q
- ;
- VENDOR ; -- SUBRTN to print chs provider data
- NEW AQAO,AQAOX S AQAOX=0
- F S AQAOX=$O(^AUTTVNDR(AQAOX)) Q:AQAOX'=+AQAOX Q:AQAOSTOP=U D
- . Q:'$D(^AUTTVNDR(AQAOX,0))
- . Q:$$VALI^XBDIQ1(9999999.11,AQAOX,.05) ;screen out inactives
- . Q:$$VALI^XBDIQ1(9999999.11,AQAOX,1103)="" ;needs vendor type
- . I $Y>(IOSL-3) D NEWPG^AQAOUTIL Q:AQAOSTOP=U D HEADING2
- . D VENDOR^AQAOPV21("C",AQAOX)
- Q
- ;
- ;
- ;
- HEADING2 ; -- SUBRTN to print second half of heading
- D HEADING2^AQAOPV21 Q
- AQAOPV22 ; IHS/ORDC/LJF - PRINT QI CODES BY NUMBER ;
- +1 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
- +2 ;
- +3 ;This routine prints listing of providers, persons, and/or vendors
- +4 ;in order by QI code number.
- +5 ;Routine added with Enhancement #1
- +6 ;
- +7 ;-- Logic Flow:
- +8 ; ASK to ask user which groups to include (prov, pers, +/or vend)
- +9 ; DEV to select print device
- +10 ; PRINT checks groups selected:
- +11 ; if ihs provider or employee selected:
- +12 ; use PERSON^AQAOPV21 to print data for providers/persons
- +13 ; if chs provider selected:
- +14 ; use VENDOR^AQAOPV21 to print data for chs vendors
- +15 ; EXIT to clean up and quit
- +16 ;
- +17 ;intro text
- DO BYNUM2^AQAOHPRV
- +18 ;
- ASK ; -- ask for groups to include
- +1 KILL DIR
- WRITE !!
- SET DIR(0)="LO^1:3"
- +2 SET DIR("A")="Select ALL groups you want in report"
- +3 SET DIR("A",1)=" 1. Include IHS PROVIDERS"
- +4 SET DIR("A",2)=" 2. Include IHS EMPLOYEES"
- +5 SET DIR("A",3)=" 3. Include CHS PROVIDERS"
- +6 SET DIR("A",4)=" "
- +7 DO ^DIR
- IF $DATA(DIRUT)
- DO EXIT
- QUIT
- +8 SET AQAOSEL=Y
- +9 ;
- +10 ;
- DEV ; -- SUBRTN to get print device and call print rtn
- +1 WRITE !!
- SET %ZIS="QP"
- DO ^%ZIS
- +2 IF POP
- DO EXIT
- QUIT
- +3 IF '$DATA(IO("Q"))
- DO PRINT
- QUIT
- +4 KILL IO("Q")
- SET ZTRTN="PRINT^AQAOPV22"
- SET ZTDESC="QI CODES BY NUMBER"
- +5 SET ZTSAVE("AQAOSEL")=""
- DO ^%ZTLOAD
- KILL ZTSK
- DO ^%ZISC
- +6 DO PRTOPT^AQAOVAR
- DO EXIT
- QUIT
- +7 ;
- +8 ;
- EXIT ; -- SUBRTN for eoj
- +1 ;ask to hit return
- IF '$DATA(ZTQUEUED)
- IF (IOST["C-")
- DO PRTOPT^AQAOVAR
- +2 DO ^%ZISC
- DO KILL^AQAOUTIL
- QUIT
- +3 ;
- +4 ;
- PRINT ;EP; -- check user selections and call proper subrtn
- +1 USE IO
- DO INIT^AQAOUTIL
- SET AQAOHCON="Provider"
- +2 SET AQAOTY="QI CODES BY NUMBER"
- +3 DO HEADING^AQAOUTIL
- DO HEADING2
- +4 ;
- +5 IF AQAOSEL[3
- DO VENDOR
- +6 IF (AQAOSEL[1)!(AQAOSEL[2)
- DO PERSON
- +7 DO EXIT
- +8 QUIT
- +9 ;
- +10 ;
- PERSON ; -- SUBRTN to print provider/person data
- +1 NEW AQAO,AQAOX
- SET AQAOX=0
- +2 FOR
- SET AQAOX=$ORDER(^VA(200,AQAOX))
- IF AQAOX'=+AQAOX
- QUIT
- IF AQAOSTOP=U
- QUIT
- Begin DoDot:1
- +3 IF '$DATA(^VA(200,AQAOX,0))
- QUIT
- +4 IF (AQAOSEL[1)
- IF (AQAOSEL'[2)
- IF '$DATA(^XUSEC("PROVIDER",AQAOX))
- QUIT
- +5 IF $Y>(IOSL-3)
- DO NEWPG^AQAOUTIL
- IF AQAOSTOP=U
- QUIT
- DO HEADING2
- +6 DO PERSON^AQAOPV21("I",AQAOX)
- End DoDot:1
- +7 QUIT
- +8 ;
- VENDOR ; -- SUBRTN to print chs provider data
- +1 NEW AQAO,AQAOX
- SET AQAOX=0
- +2 FOR
- SET AQAOX=$ORDER(^AUTTVNDR(AQAOX))
- IF AQAOX'=+AQAOX
- QUIT
- IF AQAOSTOP=U
- QUIT
- Begin DoDot:1
- +3 IF '$DATA(^AUTTVNDR(AQAOX,0))
- QUIT
- +4 ;screen out inactives
- IF $$VALI^XBDIQ1(9999999.11,AQAOX,.05)
- QUIT
- +5 ;needs vendor type
- IF $$VALI^XBDIQ1(9999999.11,AQAOX,1103)=""
- QUIT
- +6 IF $Y>(IOSL-3)
- DO NEWPG^AQAOUTIL
- IF AQAOSTOP=U
- QUIT
- DO HEADING2
- +7 DO VENDOR^AQAOPV21("C",AQAOX)
- End DoDot:1
- +8 QUIT
- +9 ;
- +10 ;
- +11 ;
- HEADING2 ; -- SUBRTN to print second half of heading
- +1 DO HEADING2^AQAOPV21
- QUIT
