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
