AQAOPV22.m

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