AZXZVS1.m

AZXZVS1 ;REPORT -VISIT COUNTS BY PROVIDER OF SERVICE [ 05/01/95   1:25 PM ]

 ;06/02/92  JOHN H. LYNCH

 ;

 ;THIS PROGRAM WILL GIVE THE TOTAL NUMBER

 ;OF VISITS BY ALL PROVIDERS OF SERVICE.

 ;

 ;PATIENT NAME     (APC DATA)

 ;DATE OF SERVICE  (APC DATA)

 ;PRIMARY PROVIDER (APC DATA)

 ;CHART NUMBER     (APC DATA)

 ;

MAIN ;AZXZVS1 PROGRAM CONTROL     

 ;INITIALIZE LOCAL VARIABLES

 ;DELETE COMMENT ONLY IF RUNNING THIS ROUTINE IN PROGRAMMER MODE

 D ^XBKSET         ;INITIALIZE SYSTEM VARIABLES

 W @IOF      ;CLEAR SCREEN

 W !!!,"APC Visit Counts by Provider of Service Report..."

LBDATE ;READ USER INPUT ON LOWER BOUND DATE 

 R !!,"Please enter the Lower Date: ",LDATE

 ;IF "^" QUIT AND RETURN TO PREVIOUS MENU

 I (LDATE="^")!(LDATE="") Q

 ;IF "?" GIVE HELP AND RETURN TO LDATE PROMPT

 I (LDATE="?") W !!,"Enter Lower Boundary Date to search on for report." G LBDATE

 I (LDATE="??") W !!,"Enter Lower Boundary Date to search on for report."

 I (LDATE="??") W !!,"Date Formats:",?15,"MM/DD/YY",?29,"- STANDARD",!,?15,"T",?29,"- TODAY",!,?15,"T-###",?29,"- TODAY MINUS ### DAYS",!,?15,"NOW",?29,"- CURRENT DATE",!,?15,"MON ##, ####",?29,"- MON DAY, YEAR" G LBDATE

 I (LDATE="???") W !!,"Enter Lower Boundary Date to search on for report.",!!,"Date Examples:",?15,"Format",?29,"- Example User Input"

 I (LDATE="???") W !!,?15,"MM/DD/YY",?29,"- 01/01/92",!,?15,"T",?29,"- T",!,?15,"T-###",?29,"- T-10",!,?15,"NOW",?29,"- NOW",!,?15,"MON ##, ####",?29,"- SEP 01, 1992" G LBDATE

 ;CHECK TO SEE IF A VALID DATE HAS BEEN ENTERED

 I (LDATE?1.2N0.1"/"1.2N0.1"/"0.4N)!(LDATE?1"T"1"-"1.3N)!(LDATE="T")!(LDATE="NOW")!(LDATE?3A1" "1.2N1","1" "4N) G LBDATE2

 W !!,"Illegal date; check format and re-enter lower boundary date.",!,*7 

 G LBDATE

LBDATE2 ;CONVERT LDATE TO NEW FORMATS

 S X=LDATE   ;X = DATE TO CONVERT USING ^%DT

 D CONVERT   ;CONVERT USER DATE TO FILEMAN DATE FORMAT

 ;DATE FORMAT WAS ILLEGAL

 I Y<1 W !!,"Illegal date; check format and re-enter lower boundary date.",!,*7 G LBDATE

 S LDATE=Y

 S Y=LDATE D DD^%DT S LDATE1=Y   ;LDATE1 = DATE IN USER FORMAT

UBDATE ;READ USER INPUT ON UPPER BOUND DATE 

 R !!,"Please enter the Upper Date: ",UDATE

 ;IF "^" RETURN TO PREVIOUS PROMPT (LBDATE)

 I (UDATE="^")!(UDATE="") G LBDATE

 ;IF "?" GIVE HELP AND RETURN TO UDATE PROMPT

 I (UDATE="?") W !!,"Enter Upper Boundary Date to search on for report." G UBDATE

 I (UDATE="??") W !!,"Enter Upper Boundary Date to search on for report."

 I (UDATE="??") W !!,"Date Formats:",?15,"MM/DD/YY",?29,"- STANDARD",!,?15,"T",?29,"- TODAY",!,?15,"T-###",?29,"- TODAY MINUS ### DAYS",!,?15,"NOW",?29,"- CURRENT DATE",!,?15,"MON ##, ####",?29,"- MON DAY, YEAR" G UBDATE

 I (UDATE="???") W !!,"Enter Upper Boundary Date to search on for report.",!!,"Date Examples:",?15,"Format",?29,"- Example User Input"

 I (UDATE="???") W !!,?15,"MM/DD/YY",?29,"- 01/01/92",!,?15,"T",?29,"- T",!,?15,"T-###",?29,"- T-10",!,?15,"NOW",?29,"- NOW",!,?15,"MON ##, ####",?29,"- SEP 01, 1992" G UBDATE

 ;CHECK TO SEE IF A VALID DATE HAS BEEN ENTERED

 I (UDATE?1.2N0.1"/"1.2N0.1"/"0.4N)!(UDATE?1"T"1"-"1.3N)!(UDATE="T")!(UDATE="NOW")!(UDATE?3A1" "1.2N1","1" "4N) G UBDATE2

 W !!,"Illegal date; check format and re-enter upper boundary date.",!,*7 

 G UBDATE

UBDATE2 ;CONVERT UDATE TO NEW FORMATS

 S X=UDATE   ;X = DATE TO CONVERT USING ^%DT

 D CONVERT   ;CONVERT USER DATE TO FILEMAN DATE FORMAT

 W !         ;GIVE AN EXTRA LINE FEED

 ;DATE FORMAT WAS ILLEGAL

 I Y<1 W !!,"Illegal date; check format and re-enter upper boundary date.",!,*7 G UBDATE

 S UDATE=Y

 S Y=UDATE D DD^%DT S UDATE1=Y   ;UDATE1 = DATE IN USER FORMAT

 ;CHECK TO SEE IF UDATE > LDATE

 I (UDATE<LDATE) W !!,"Upper boundary date must be greater than or equal to lower boundary date.",!,*7 G UBDATE

 D GETPNUM   ;RETRIEVE DATA FROM MEDICAID ELIGIBLE

 ;KILL LOCAL VARIABLES

 Q

GETPNUM ;RETRIEVE DATA FROM "MEDICAID ELIGIBLE"

 ;INITIALIZE LOCAL VARIABLES

 S DEV=$I              ;ORIG. DEVICE

 S PATNUM=0            ;PATIENT NUMBER

 S INUM2=0

 ;CALL DEVICE

 ;IS DEVICE VALID (NO, ABORT REPORT)

 ;S %ZIS="FQMN" D ^%ZIS K %ZIS   ;CHECK FOR DEVICE CHARACTERISTICS

 ;I (IO="")!(IO="^") W !,*7,"No device specified." H 2 G MAIN

 ;I IO=$I,$D(IO("Q")) R !,"Do you really want me to queue to this device? NO//",YN I ("Nn"[$E(X,1))!(YN="") K IO("Q") G GETPNUM

 ;I $D(IO("Q")) K IO("Q") S ZTRTN="SETUP^AZXZVS1",ZTDESC="APC Visit Counts by Provider" F G="LDATE","UDATE","LDATE1","UDATE1","PATNUM","INUM2","IO","DEV" S ZTSAVE(G)=""

 ;I  D ^%ZTLOAD Q

 ;S IO=IO D ^%ZIS I 'POP G SETUP

 ;W !,"Device ",IO," busy." G GETPNUM

 D ^%ZIS U IO

SETUP ;SETUP FOR CALL FROM TASKMAN (OR DIRECT) 

 ;CHECK TO MAKE SURE REPORT ISN'T ALREADY RUNNING SOMEWHERE ELSE

 I $D(^AZXZTMP3(0)) D ERR Q

 ;INITIALIZE LOCAL VARIABLES

 S DFN=0           ;INTERNAL ENTRY NUMBER (COUNTER)

 S COUNTER=1       ;LINES PER PAGE COUNTER

 S COUNTER2=0      ;TOTAL # OF VISITS COUNTER

 S PAGE=0          ;INITIALIZE PAGE #

 S CHECK=1         ;INITIALIZE CHECK VARIABLE (PVDRCHK=PVDRNAME?)

 S RET=""          ;RET = IF IO=DEV CHECK FOR "^" TO EXIT

 ;SET 0-NODE FOR TMP GLOBAL (^AZXZTMP)

 S ^AZXZTMP3(0)="TMP FILE FOR AZXZVS1 PROGRAM^NEEDS TO BE DELETED IF A PROGRAM ERROR OCCURS"

 F  S INUM2=0,PATNUM=$O(^AAPCRCDS("B",PATNUM))  Q:PATNUM=""  F  S INUM2=$O(^AAPCRCDS("B",PATNUM,INUM2))  Q:INUM2=""  D CHKDATE

 ;CALL GETDATA

 D GETDATA             ;THE DEVICE DECIDES WHERE THE DATA GOES

 ;CLOSE DEVICE

 X ^%ZIS("C")

 Q

ERR ;THE ^AZXZTMP3 GLOBAL EXISTS (ERROR HAS OCCURRED OR

 ;THE PROGRAM IS CURRENTLY RUNNING ALREADY!!!

 I IO=DEV W @IOF       ;CLEAR SCREEN

 W !!!,"********************************************************************************",!!,"The ""APC Visit Counts by Provider of Service"" report is currently running."

 W !!,"If you find that the report is not currently running..."

 W !,"please contact the MIS Manager immediately, a program error"

 W !,"may have occured."

 W !!,"********************************************************************************"

 I IO=DEV R !!,"Press return to continue...",RET

 I IO'=DEV W #         ;SEND FORM FEED

 Q

CONVERT ;CONVERT USER DATES TO FILEMAN DATE FORMAT

 ;SET LOCAL VARIABLES

 S %DT="EX"       ;E=ECHO ANSWER;X=EXACT DATE

 D ^%DT            ;VALUE RETURNED IN Y

 Q

CHKDATE ;CHECK FOR A VALID DATE (WITHIN LDATE & UDATE)

 ;INITIALIZE LOCAL VARIABLES

 S FLAG=0          ;1 = VALID DATE, 0 = INVALID DATE

 S DATE=$P(^AAPCRCDS(INUM2,0),U,3)

 ;SET FLAG=1 IF DATE IS WITHING LDATE & UDATE (DO WRITETMP)

 I (DATE>(LDATE-1))&(DATE<(UDATE+1)) S FLAG=1

 ;CHECK TO MAKE SURE IT HAS A SPECIFIC PROVIDER

 D CHKSPEC

 I FLAG=1,FLAG2 D GETSPEC D GETNAME S Y=DATE D DD^%DT S DATE=Y D WRITETMP

 Q

CHKSPEC ;CHECK TO MAKE SURE IT HAS A SPECIFIC PROVIDER

 ;INITIALIZE VARIABLES

 S FLAG2=0              ;1 = SPECIFIC PROVIDER EXISTS;0 = NO SPEC. PROV.

 S SPEC=0               ;SPEC = NUMBER OF SPECIFIC PROVIDERS LISTED

 I $D(^AAPCRCDS(INUM2,5,0)) S SPEC=$P(^AAPCRCDS(INUM2,5,0),U,4)

 I SPEC>0 S FLAG2=1 F J=1:1:SPEC S SPECPVDR(J)=$P(^AAPCRCDS(INUM2,5,J,0),U,1)

 Q

GETSPEC ;GET SPECIFIC DISCIPLINE CODES (PROVIDER)

 I SPEC>0 F J=1:1:SPEC S INUM3=0,INUM3=$O(^DIC(6,"B",SPECPVDR(J),INUM3)),SPECNUM(J)=$P(^DIC(6,INUM3,0),U,4)

 Q

GETNAME ;GET REAL NAME OF SPECIFIC PROVIDER, PROVIDER CLASS NAME AND CODE

 ;(PROVIDER CLASS, PERSON)

 I SPEC>0 F J=1:1:SPEC S PVDRDISC(J)=$P(^DIC(7,SPECPVDR(J),0),U,1),SPECCODE(J)=$P(^DIC(7,SPECPVDR(J),9999999),U,1)

 I SPEC>0 F J=1:1:SPEC S PVDRNAME(J)=$P(^DIC(16,SPECPVDR(J),0),U,1)

 Q

WRITETMP ;WRITE DATA OUT TO TEMPORARY GLOBAL (^AZXZTMP3)

 ;WRITE SPECIFIC PROVIDER TO TMP GLOBAL

 I SPEC>0 F J=1:1:SPEC S DFN=DFN+1,^AZXZTMP3(DFN)=PVDRNAME(J)_"^"_PVDRDISC(J)_"^"_SPECCODE(J)

 I SPEC>0 S DFN=DFN-SPEC      ;RESET DFN COUNTER BACK BY SPEC

 I SPEC>0 F J=1:1:SPEC S DFN=DFN+1,^AZXZTMP3("B",PVDRNAME(J),PVDRDISC(J),DFN)=""

 K SPECPVDR,SPECNUM,PVDRDISC,PVDRNAME,SPECCODE  ;KILL ARRAYS

 Q

GETDATA ;GETDATA GATHERS ALL DATA, CALLS PRINT TO PRINT TO DEVICE

 ;INITIALIZE LOCAL VARIABLES

 S PVDR=""     ;PVDR = PROVIDER IN "B" CROSS-REF

 S DISC=""     ;DISC = PROVIDER DISCIPLINE NAME IN "B" CROSS-REF

 S INUM=0      ;INUM = INTERNAL ENTRY # IN "B" CROSS-REF

 S SUBTOTAL=0  ;SUBTOTAL = SUBTOTAL OF # OF VISITS PER PAGE

 S TOTAL=0     ;TOTAL = TOTAL # OF VISITS PER PROVIDER TYPE

 F  S PVDR=$O(^AZXZTMP3("B",PVDR)) Q:PVDR=""   S DISC="" F  S DISC=$O(^AZXZTMP3("B",PVDR,DISC)) Q:DISC=""  S INUM=0 F  S INUM=$O(^AZXZTMP3("B",PVDR,DISC,INUM)) Q:'INUM  D SETVARS D PRINT I RET="^" S PVDR="ZZZZZZZZ" Q

 I RET="",SUBTOTAL W !,?73,"_______",!,?64,"Subtotal:",?73,$J(SUBTOTAL,7,0)

 I RET="",TOTAL S TOTAL=TOTAL+SUBTOTAL W !,?73,"_______",!,?67,"Total:",?73,$J(TOTAL,7,0)

 I IO=DEV,RET="" R !,"Press return to continue...",RET W @IOF 

 R !!,"Do you want to print another report? YES// ",YN I ("Yy"[$E(X,1))!(YN="") K ^AZXZTMP3 S DFN=0 G MAIN

 ;KILL OFF LOCAL AND TEMPORARY VARIABLES

 K ^AZXZTMP3

 Q

SETVARS ;SET CURRENT VALUES OF VARIABLES TO PRINT OUT  

 S PVDRNAME=$P(^AZXZTMP3(INUM),U,1)

 S PVDRDISC=$P(^AZXZTMP3(INUM),U,2)

 S SPECCODE=$P(^AZXZTMP3(INUM),U,3)

 Q

PRINT ;PRINT ALL DATA TO DEVICE    

 ;CHECK = ONLY ON FIRST TIME THRU

 I CHECK=1 S PVDRCHK=PVDRNAME,DISCCHK=PVDRDISC,SPECCHK=SPECCODE,SITE=$P(^DIC(4,DUZ(2),0),U,1)

 ;CLEAR SCREEN IF IO=DEV, 1ST TIME

 I (CHECK=1),(IO=DEV) W @IOF S CHECK=CHECK+1

 I COUNTER=1 W !,"********************************************************************************" S PAGE=PAGE+1

 I COUNTER=1 W !,"APC Visit Counts by Provider of Service     From: ",LDATE1,"  To: ",UDATE1,!,SITE,?68,"Page: ",PAGE,!,"********************************************************************************"

 I COUNTER=1 W !!,"Provider of Service",?25,"Provider Discipline",?54,"Code",?64,"Number of Visits",! S COUNTER=COUNTER+7

 I PVDRCHK'=PVDRNAME W !,PVDRCHK,?25,DISCCHK,?54,SPECCHK,?73,$J(COUNTER2,7,0) S SUBTOTAL=SUBTOTAL+COUNTER2,COUNTER2=0,COUNTER=COUNTER+1,PVDRCHK=PVDRNAME,DISCCHK=PVDRDISC,SPECCHK=SPECCODE

 S COUNTER2=COUNTER2+1       ;INCREMENT # OF VISITS COUNTER

 I IO=DEV,COUNTER>18 W !,?73,"_______",!,?64,"Subtotal:",?73,$J(SUBTOTAL,7,0) R !,"Press return to continue...",RET S COUNTER=1,TOTAL=TOTAL+SUBTOTAL,SUBTOTAL=0 W @IOF

 I IO'=DEV,COUNTER>57 W !,?73,"_______",!,?64,"Subtotal:",?73,$J(SUBTOTAL,7,0) S COUNTER=1,TOTAL=TOTAL+SUBTOTAL,SUBTOTAL=0 W #

 Q

AZXZVS1   ;REPORT -VISIT COUNTS BY PROVIDER OF SERVICE [ 05/01/95   1:25 PM ]

 +1       ;06/02/92  JOHN H. LYNCH

 +2       ;

 +3       ;THIS PROGRAM WILL GIVE THE TOTAL NUMBER

 +4       ;OF VISITS BY ALL PROVIDERS OF SERVICE.

 +5       ;

 +6       ;PATIENT NAME     (APC DATA)

 +7       ;DATE OF SERVICE  (APC DATA)

 +8       ;PRIMARY PROVIDER (APC DATA)

 +9       ;CHART NUMBER     (APC DATA)

 +10      ;

MAIN      ;AZXZVS1 PROGRAM CONTROL     

 +1       ;INITIALIZE LOCAL VARIABLES

 +2  +3   ;DELETE COMMENT ONLY IF RUNNING THIS ROUTINE IN PROGRAMMER MODE

 +4       ;INITIALIZE SYSTEM VARIABLES

           DO ^XBKSET

 +5  +6   ;CLEAR SCREEN

           WRITE @IOF

 +7        WRITE !!!,"APC Visit Counts by Provider of Service Report..."

LBDATE    ;READ USER INPUT ON LOWER BOUND DATE 

 +1        READ !!,"Please enter the Lower Date: ",LDATE

 +2       ;IF "^" QUIT AND RETURN TO PREVIOUS MENU

 +3        IF (LDATE="^")!(LDATE="")

               QUIT 

 +4  +5   ;IF "?" GIVE HELP AND RETURN TO LDATE PROMPT

 +6        IF (LDATE="?")

               WRITE !!,"Enter Lower Boundary Date to search on for report."

               GOTO LBDATE

 +7        IF (LDATE="??")

               WRITE !!,"Enter Lower Boundary Date to search on for report."

 +8        IF (LDATE="??")

               WRITE !!,"Date Formats:",?15,"MM/DD/YY",?29,"- STANDARD",!,?15,"T",?29,"- TODAY",!,?15,"T-###",?29,"- TODAY MINUS ### DAYS",!,?15,"NOW",?29,"- CURRENT DATE",!,?15,"MON ##, ####",?29,"- MON DAY, YEAR"

               GOTO LBDATE

 +9        IF (LDATE="???")

               WRITE !!,"Enter Lower Boundary Date to search on for report.",!!,"Date Examples:",?15,"Format",?29,"- Example User Input"

 +10       IF (LDATE="???")

               WRITE !!,?15,"MM/DD/YY",?29,"- 01/01/92",!,?15,"T",?29,"- T",!,?15,"T-###",?29,"- T-10",!,?15,"NOW",?29,"- NOW",!,?15,"MON ##, ####",?29,"- SEP 01, 1992"

               GOTO LBDATE

 +11  +12 ;CHECK TO SEE IF A VALID DATE HAS BEEN ENTERED

 +13       IF (LDATE?1.2N0.1"/"1.2N0.1"/"0.4N)!(LDATE?1"T"1"-"1.3N)!(LDATE="T")!(LDATE="NOW")!(LDATE?3A1" "1.2N1","1" "4N)

               GOTO LBDATE2

 +14       WRITE !!,"Illegal date; check format and re-enter lower boundary date.",!,*7

 +15       GOTO LBDATE

 +16 LBDATE2 ;CONVERT LDATE TO NEW FORMATS

 +1       ;X = DATE TO CONVERT USING ^%DT

           SET X=LDATE

 +2       ;CONVERT USER DATE TO FILEMAN DATE FORMAT

           DO CONVERT

 +3       ;DATE FORMAT WAS ILLEGAL

 +4        IF Y<1

               WRITE !!,"Illegal date; check format and re-enter lower boundary date.",!,*7

               GOTO LBDATE

 +5        SET LDATE=Y

 +6       ;LDATE1 = DATE IN USER FORMAT

           SET Y=LDATE

           DO DD^%DT

           SET LDATE1=Y

 +7 UBDATE ;READ USER INPUT ON UPPER BOUND DATE 

 +1        READ !!,"Please enter the Upper Date: ",UDATE

 +2       ;IF "^" RETURN TO PREVIOUS PROMPT (LBDATE)

 +3        IF (UDATE="^")!(UDATE="")

               GOTO LBDATE

 +4       ;IF "?" GIVE HELP AND RETURN TO UDATE PROMPT

 +5        IF (UDATE="?")

               WRITE !!,"Enter Upper Boundary Date to search on for report."

               GOTO UBDATE

 +6        IF (UDATE="??")

               WRITE !!,"Enter Upper Boundary Date to search on for report."

 +7        IF (UDATE="??")

               WRITE !!,"Date Formats:",?15,"MM/DD/YY",?29,"- STANDARD",!,?15,"T",?29,"- TODAY",!,?15,"T-###",?29,"- TODAY MINUS ### DAYS",!,?15,"NOW",?29,"- CURRENT DATE",!,?15,"MON ##, ####",?29,"- MON DAY, YEAR"

               GOTO UBDATE

 +8        IF (UDATE="???")

               WRITE !!,"Enter Upper Boundary Date to search on for report.",!!,"Date Examples:",?15,"Format",?29,"- Example User Input"

 +9        IF (UDATE="???")

               WRITE !!,?15,"MM/DD/YY",?29,"- 01/01/92",!,?15,"T",?29,"- T",!,?15,"T-###",?29,"- T-10",!,?15,"NOW",?29,"- NOW",!,?15,"MON ##, ####",?29,"- SEP 01, 1992"

               GOTO UBDATE

 +10  +11 ;CHECK TO SEE IF A VALID DATE HAS BEEN ENTERED

 +12       IF (UDATE?1.2N0.1"/"1.2N0.1"/"0.4N)!(UDATE?1"T"1"-"1.3N)!(UDATE="T")!(UDATE="NOW")!(UDATE?3A1" "1.2N1","1" "4N)

               GOTO UBDATE2

 +13       WRITE !!,"Illegal date; check format and re-enter upper boundary date.",!,*7

 +14       GOTO UBDATE

 +15 UBDATE2 ;CONVERT UDATE TO NEW FORMATS

 +1       ;X = DATE TO CONVERT USING ^%DT

           SET X=UDATE

 +2       ;CONVERT USER DATE TO FILEMAN DATE FORMAT

           DO CONVERT

 +3       ;GIVE AN EXTRA LINE FEED

           WRITE !

 +4       ;DATE FORMAT WAS ILLEGAL

 +5        IF Y<1

               WRITE !!,"Illegal date; check format and re-enter upper boundary date.",!,*7

               GOTO UBDATE

 +6        SET UDATE=Y

 +7       ;UDATE1 = DATE IN USER FORMAT

           SET Y=UDATE

           DO DD^%DT

           SET UDATE1=Y

 +8  +9   ;CHECK TO SEE IF UDATE > LDATE

 +10       IF (UDATE<LDATE)

               WRITE !!,"Upper boundary date must be greater than or equal to lower boundary date.",!,*7

               GOTO UBDATE

 +11  +12 ;RETRIEVE DATA FROM MEDICAID ELIGIBLE

           DO GETPNUM

 +13  +14 ;KILL LOCAL VARIABLES

 +15       QUIT 

 +16 GETPNUM ;RETRIEVE DATA FROM "MEDICAID ELIGIBLE"

 +1       ;INITIALIZE LOCAL VARIABLES

 +2       ;ORIG. DEVICE

           SET DEV=$IO

 +3       ;PATIENT NUMBER

           SET PATNUM=0

 +4        SET INUM2=0

 +5  +6   ;CALL DEVICE

 +7       ;IS DEVICE VALID (NO, ABORT REPORT)

 +8       ;S %ZIS="FQMN" D ^%ZIS K %ZIS   ;CHECK FOR DEVICE CHARACTERISTICS

 +9       ;I (IO="")!(IO="^") W !,*7,"No device specified." H 2 G MAIN

 +10  +11 ;I IO=$I,$D(IO("Q")) R !,"Do you really want me to queue to this device? NO//",YN I ("Nn"[$E(X,1))!(YN="") K IO("Q") G GETPNUM

 +12      ;I $D(IO("Q")) K IO("Q") S ZTRTN="SETUP^AZXZVS1",ZTDESC="APC Visit Counts by Provider" F G="LDATE","UDATE","LDATE1","UDATE1","PATNUM","INUM2","IO","DEV" S ZTSAVE(G)=""

 +13      ;I  D ^%ZTLOAD Q

 +14      ;S IO=IO D ^%ZIS I 'POP G SETUP

 +15      ;W !,"Device ",IO," busy." G GETPNUM

 +16       DO ^%ZIS

           USE IO

 +17 SETUP ;SETUP FOR CALL FROM TASKMAN (OR DIRECT) 

 +1  +2   ;CHECK TO MAKE SURE REPORT ISN'T ALREADY RUNNING SOMEWHERE ELSE

 +3        IF $DATA(^AZXZTMP3(0))

               DO ERR

               QUIT 

 +4  +5   ;INITIALIZE LOCAL VARIABLES

 +6       ;INTERNAL ENTRY NUMBER (COUNTER)

           SET DFN=0

 +7       ;LINES PER PAGE COUNTER

           SET COUNTER=1

 +8       ;TOTAL # OF VISITS COUNTER

           SET COUNTER2=0

 +9       ;INITIALIZE PAGE #

           SET PAGE=0

 +10      ;INITIALIZE CHECK VARIABLE (PVDRCHK=PVDRNAME?)

           SET CHECK=1

 +11      ;RET = IF IO=DEV CHECK FOR "^" TO EXIT

           SET RET=""

 +12  +13 ;SET 0-NODE FOR TMP GLOBAL (^AZXZTMP)

 +14       SET ^AZXZTMP3(0)="TMP FILE FOR AZXZVS1 PROGRAM^NEEDS TO BE DELETED IF A PROGRAM ERROR OCCURS"

 +15  +16  FOR 

               SET INUM2=0

               SET PATNUM=$ORDER(^AAPCRCDS("B",PATNUM))

               IF PATNUM=""

                   QUIT 

               FOR 

                   SET INUM2=$ORDER(^AAPCRCDS("B",PATNUM,INUM2))

                   IF INUM2=""

                       QUIT 

                   DO CHKDATE

 +17  +18 ;CALL GETDATA

 +19      ;THE DEVICE DECIDES WHERE THE DATA GOES

           DO GETDATA

 +20  +21 ;CLOSE DEVICE

 +22       XECUTE ^%ZIS("C")

 +23       QUIT 

 +24 ERR  ;THE ^AZXZTMP3 GLOBAL EXISTS (ERROR HAS OCCURRED OR

 +1       ;THE PROGRAM IS CURRENTLY RUNNING ALREADY!!!

 +2       ;CLEAR SCREEN

           IF IO=DEV

               WRITE @IOF

 +3        WRITE !!!,"********************************************************************************",!!,"The ""APC Visit Counts by Provider of Service"" report is currently running."

 +4        WRITE !!,"If you find that the report is not currently running..."

 +5        WRITE !,"please contact the MIS Manager immediately, a program error"

 +6        WRITE !,"may have occured."

 +7        WRITE !!,"********************************************************************************"

 +8        IF IO=DEV

               READ !!,"Press return to continue...",RET

 +9       ;SEND FORM FEED

           IF IO'=DEV

               WRITE #

 +10       QUIT 

 +11 CONVERT ;CONVERT USER DATES TO FILEMAN DATE FORMAT

 +1       ;SET LOCAL VARIABLES

 +2       ;E=ECHO ANSWER;X=EXACT DATE

           SET %DT="EX"

 +3       ;VALUE RETURNED IN Y

           DO ^%DT

 +4        QUIT 

 +5 CHKDATE ;CHECK FOR A VALID DATE (WITHIN LDATE & UDATE)

 +1       ;INITIALIZE LOCAL VARIABLES

 +2       ;1 = VALID DATE, 0 = INVALID DATE

           SET FLAG=0

 +3        SET DATE=$PIECE(^AAPCRCDS(INUM2,0),U,3)

 +4  +5   ;SET FLAG=1 IF DATE IS WITHING LDATE & UDATE (DO WRITETMP)

 +6        IF (DATE>(LDATE-1))&(DATE<(UDATE+1))

               SET FLAG=1

 +7  +8   ;CHECK TO MAKE SURE IT HAS A SPECIFIC PROVIDER

 +9        DO CHKSPEC

 +10  +11  IF FLAG=1

               IF FLAG2

                   DO GETSPEC

                   DO GETNAME

                   SET Y=DATE

                   DO DD^%DT

                   SET DATE=Y

                   DO WRITETMP

 +12       QUIT 

 +13 CHKSPEC ;CHECK TO MAKE SURE IT HAS A SPECIFIC PROVIDER

 +1       ;INITIALIZE VARIABLES

 +2       ;1 = SPECIFIC PROVIDER EXISTS;0 = NO SPEC. PROV.

           SET FLAG2=0

 +3       ;SPEC = NUMBER OF SPECIFIC PROVIDERS LISTED

           SET SPEC=0

 +4  +5    IF $DATA(^AAPCRCDS(INUM2,5,0))

               SET SPEC=$PIECE(^AAPCRCDS(INUM2,5,0),U,4)

 +6        IF SPEC>0

               SET FLAG2=1

               FOR J=1:1:SPEC

                   SET SPECPVDR(J)=$PIECE(^AAPCRCDS(INUM2,5,J,0),U,1)

 +7        QUIT 

 +8 GETSPEC ;GET SPECIFIC DISCIPLINE CODES (PROVIDER)

 +1        IF SPEC>0

               FOR J=1:1:SPEC

                   SET INUM3=0

                   SET INUM3=$ORDER(^DIC(6,"B",SPECPVDR(J),INUM3))

                   SET SPECNUM(J)=$PIECE(^DIC(6,INUM3,0),U,4)

 +2        QUIT 

 +3 GETNAME ;GET REAL NAME OF SPECIFIC PROVIDER, PROVIDER CLASS NAME AND CODE

 +1       ;(PROVIDER CLASS, PERSON)

 +2        IF SPEC>0

               FOR J=1:1:SPEC

                   SET PVDRDISC(J)=$PIECE(^DIC(7,SPECPVDR(J),0),U,1)

                   SET SPECCODE(J)=$PIECE(^DIC(7,SPECPVDR(J),9999999),U,1)

 +3        IF SPEC>0

               FOR J=1:1:SPEC

                   SET PVDRNAME(J)=$PIECE(^DIC(16,SPECPVDR(J),0),U,1)

 +4        QUIT 

 +5 WRITETMP ;WRITE DATA OUT TO TEMPORARY GLOBAL (^AZXZTMP3)

 +1       ;WRITE SPECIFIC PROVIDER TO TMP GLOBAL

 +2        IF SPEC>0

               FOR J=1:1:SPEC

                   SET DFN=DFN+1

                   SET ^AZXZTMP3(DFN)=PVDRNAME(J)_"^"_PVDRDISC(J)_"^"_SPECCODE(J)

 +3       ;RESET DFN COUNTER BACK BY SPEC

           IF SPEC>0

               SET DFN=DFN-SPEC

 +4        IF SPEC>0

               FOR J=1:1:SPEC

                   SET DFN=DFN+1

                   SET ^AZXZTMP3("B",PVDRNAME(J),PVDRDISC(J),DFN)=""

 +5  +6   ;KILL ARRAYS

           KILL SPECPVDR,SPECNUM,PVDRDISC,PVDRNAME,SPECCODE

 +7        QUIT 

 +8 GETDATA ;GETDATA GATHERS ALL DATA, CALLS PRINT TO PRINT TO DEVICE

 +1       ;INITIALIZE LOCAL VARIABLES

 +2       ;PVDR = PROVIDER IN "B" CROSS-REF

           SET PVDR=""

 +3       ;DISC = PROVIDER DISCIPLINE NAME IN "B" CROSS-REF

           SET DISC=""

 +4       ;INUM = INTERNAL ENTRY # IN "B" CROSS-REF

           SET INUM=0

 +5       ;SUBTOTAL = SUBTOTAL OF # OF VISITS PER PAGE

           SET SUBTOTAL=0

 +6       ;TOTAL = TOTAL # OF VISITS PER PROVIDER TYPE

           SET TOTAL=0

 +7  +8    FOR 

               SET PVDR=$ORDER(^AZXZTMP3("B",PVDR))

               IF PVDR=""

                   QUIT 

               SET DISC=""

               FOR 

                   SET DISC=$ORDER(^AZXZTMP3("B",PVDR,DISC))

                   IF DISC=""

                       QUIT 

                   SET INUM=0

                   FOR 

                       SET INUM=$ORDER(^AZXZTMP3("B",PVDR,DISC,INUM))

                       IF 'INUM

                           QUIT 

                       DO SETVARS

                       DO PRINT

                       IF RET="^"

                           SET PVDR="ZZZZZZZZ"

                           QUIT 

 +9        IF RET=""

               IF SUBTOTAL

                   WRITE !,?73,"_______",!,?64,"Subtotal:",?73,$JUSTIFY(SUBTOTAL,7,0)

 +10       IF RET=""

               IF TOTAL

                   SET TOTAL=TOTAL+SUBTOTAL

                   WRITE !,?73,"_______",!,?67,"Total:",?73,$JUSTIFY(TOTAL,7,0)

 +11       IF IO=DEV

               IF RET=""

                   READ !,"Press return to continue...",RET

                   WRITE @IOF

 +12       READ !!,"Do you want to print another report? YES// ",YN

           IF ("Yy"[$EXTRACT(X,1))!(YN="")

               KILL ^AZXZTMP3

               SET DFN=0

               GOTO MAIN

 +13  +14 ;KILL OFF LOCAL AND TEMPORARY VARIABLES

 +15       KILL ^AZXZTMP3

 +16       QUIT 

 +17 SETVARS ;SET CURRENT VALUES OF VARIABLES TO PRINT OUT  

 +1        SET PVDRNAME=$PIECE(^AZXZTMP3(INUM),U,1)

 +2        SET PVDRDISC=$PIECE(^AZXZTMP3(INUM),U,2)

 +3        SET SPECCODE=$PIECE(^AZXZTMP3(INUM),U,3)

 +4        QUIT 

 +5 PRINT ;PRINT ALL DATA TO DEVICE    

 +1       ;CHECK = ONLY ON FIRST TIME THRU

 +2        IF CHECK=1

               SET PVDRCHK=PVDRNAME

               SET DISCCHK=PVDRDISC

               SET SPECCHK=SPECCODE

               SET SITE=$PIECE(^DIC(4,DUZ(2),0),U,1)

 +3  +4   ;CLEAR SCREEN IF IO=DEV, 1ST TIME

 +5        IF (CHECK=1)

               IF (IO=DEV)

                   WRITE @IOF

                   SET CHECK=CHECK+1

 +6  +7    IF COUNTER=1

               WRITE !,"********************************************************************************"

               SET PAGE=PAGE+1

 +8        IF COUNTER=1

               WRITE !,"APC Visit Counts by Provider of Service     From: ",LDATE1,"  To: ",UDATE1,!,SITE,?68,"Page: ",PAGE,!,"********************************************************************************"

 +9        IF COUNTER=1

               WRITE !!,"Provider of Service",?25,"Provider Discipline",?54,"Code",?64,"Number of Visits",!

               SET COUNTER=COUNTER+7

 +10       IF PVDRCHK'=PVDRNAME

               WRITE !,PVDRCHK,?25,DISCCHK,?54,SPECCHK,?73,$JUSTIFY(COUNTER2,7,0)

               SET SUBTOTAL=SUBTOTAL+COUNTER2

               SET COUNTER2=0

               SET COUNTER=COUNTER+1

               SET PVDRCHK=PVDRNAME

               SET DISCCHK=PVDRDISC

               SET SPECCHK=SPECCODE

 +11  +12 ;INCREMENT # OF VISITS COUNTER

           SET COUNTER2=COUNTER2+1

 +13  +14  IF IO=DEV

               IF COUNTER>18

                   WRITE !,?73,"_______",!,?64,"Subtotal:",?73,$JUSTIFY(SUBTOTAL,7,0)

                   READ !,"Press return to continue...",RET

                   SET COUNTER=1

                   SET TOTAL=TOTAL+SUBTOTAL

                   SET SUBTOTAL=0

                   WRITE @IOF

 +15       IF IO'=DEV

               IF COUNTER>57

                   WRITE !,?73,"_______",!,?64,"Subtotal:",?73,$JUSTIFY(SUBTOTAL,7,0)

                   SET COUNTER=1

                   SET TOTAL=TOTAL+SUBTOTAL

                   SET SUBTOTAL=0

                   WRITE #

 +16       QUIT