ACDRLP1 ;IHS/ADC/EDE/KML - CONT OF ACDRLP;
;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
;
;
COVPAGE ;EP
W:$D(IOF) @IOF
W !?5,"CHEMICAL DEPENDENCY MIS ",$S(ACDPTVS="P":"PATIENT",1:"CDMIS RECORD")," ",$S(ACDCTYP="D":"LISTING",1:"COUNT")
W !!,"REPORT REQUESTED BY: ",$P(^VA(200,DUZ,0),U)
W !!,"The following report contains a ",$S(ACDPTVS="V":"CDMIS Record",1:"Patient")," report based on the",!,"following criteria:",!
SHOW ;
W !,$S(ACDPTVS="P":"PATIENT",1:"VISIT")," Selection Criteria"
I $D(ACDRDTR),$D(ACDBDD) W !!?6,"Visit Date range: ",ACDBDD," to ",ACDEDD,!
W:ACDPTVS="V" !!?6,"Visit Date range: ",ACDBDD," to ",ACDEDD,!
I '$D(^ACDRPTD(ACDRPT,11)) G SHOWP
S ACDI=0 F S ACDI=$O(^ACDRPTD(ACDRPT,11,ACDI)) Q:ACDI'=+ACDI D
.I $Y>(IOSL-5) D PAUSE^ACDRL01 W @IOF
.W !?6,$P(^ACDTITEM(ACDI,0),U),": "
.K ACDQ S ACDY=0,C=0 K ACDQ F S ACDY=$O(^ACDRPTD(ACDRPT,11,ACDI,11,"B",ACDY)) S C=C+1 W:C'=1&(ACDY'="") " ; " Q:ACDY=""!($D(ACDQ)) S X=ACDY X:$D(^ACDTITEM(ACDI,2)) ^(2) W X
K ACDQ
SHOWP ;
I ACDCTYP="F" W !!,"FLAT FILE BEING GENERATED: ",ACDFILE,!! W:'$D(ZTQUEUED) "HOLD ON......" Q
I ACDCTYP="T" D COUNT Q
I ACDCTYP="S" D I 1
.I $Y>(IOSL-6) D PAUSE^ACDRL01 W @IOF
.W !!,"Report will contain sub-totals by ",$P(^ACDTITEM(ACDSORT,0),U),"."
.I '$D(^TMP("ACDRL",ACDJOB,ACDBTH)) W !!,$S(ACDPTVS="V":"NO VISITS",1:"NO PATIENTS")_" TO REPORT.",! D PAUSE^ACDRL01 W:$D(IOF) @IOF
.Q
I ACDCTYP'="D" D PAUSE^ACDRL01 W:$D(IOF) @IOF Q
I $Y>(IOSL-4) D PAUSE^ACDRL01 W @IOF
W !!,"PRINT Field Selection"
I '$D(^ACDRPTD(ACDRPT,12)) G PAUSE
S ACDI=0 F S ACDI=$O(^ACDRPTD(ACDRPT,12,ACDI)) Q:ACDI'=+ACDI S ACDCRIT=$P(^ACDRPTD(ACDRPT,12,ACDI,0),U) D
.I $Y>(IOSL-4) D PAUSE^ACDRL01 W:$D(IOF) @IOF
.W !?6,$P(^ACDTITEM(ACDCRIT,0),U)," (" S X=$O(^ACDRPTD(ACDRPT,12,"B",ACDCRIT,"")) W $P(^ACDRPTD(ACDRPT,12,X,0),U,2),")"
I $Y>(IOSL-4) D PAUSE^ACDRL01 W:$D(IOF) @IOF
W !?10," TOTAL column width: ",ACDTCW
Q:'$G(ACDSORT)
I $Y>(IOSL-4) D PAUSE^ACDRL01 W:$D(IOF) @IOF
W !!?6,$S(ACDPTVS="V":"Records",1:"Patients")," will be sorted by: ",$P(^ACDTITEM(ACDSORT,0),U),!
I $Y>(IOSL-4) D PAUSE^ACDRL01 W:$D(IOF) @IOF
I $G(ACDSPAG) W !?6,"Each ",$P(^ACDTITEM(ACDSORT,0),U)," will be on a separate page.",!
I '$D(^TMP("ACDRL",ACDJOB,ACDBTH)) W !!,$S(ACDPTVS="V":"NO VISITS",1:"NO PATIENTS")_" TO REPORT.",!
PAUSE D PAUSE^ACDRL01 W:$D(IOF) @IOF
Q
COUNT ;if COUNTING entries only
I $Y>(IOSL-5) D PAUSE^ACDRL01 W:$D(IOF) @IOF
I '$D(^TMP("ACDRL",ACDJOB,ACDBTH)) W !!!,$S(ACDPTVS="V":"NO VISITS",1:"NO PATIENTS")_" TO REPORT.",!
I $D(ACDRCNT),ACDPTVS="V" W !!!,"Total COUNT of ",$S(ACDPTVS="P":"Patients",1:"Records"),": ",ACDRCNT
I $D(ACDPTCT),ACDPTVS="P" W !!!,"Total COUNT of ",$S(ACDPTVS="P":"Patients",1:"Records"),": ",ACDPTCT
Q
WP ;EP - Entry point to print wp fields pass node in ACDNODE
;PASS FILE IN ACDFILE, ENTRY IN ACDDA
K ^UTILITY($J,"W")
S ACDG=^DIC(ACDFILE,"GL",0),ACDG=ACDG_ACDDA_",ACDX)"
S DIWL=1,DIWR=$P(^ACDRPTD(ACDRPT,12,ACDI,0),U,2) F S ACDX=$O(@ACDG) Q:ACDX'=+ACDX D
.S Y=ACDG_",0)" S X=@Y D ^DIWP
.Q
WPS ;EP
S Z=0 F S Z=$O(^UTILITY($J,"W",DIWL,Z)) Q:Z'=+Z S ACDPCNT=ACDPCNT+1,ACDPRNM(ACDPCNT)=^UTILITY($J,"W",DIWL,Z,0)
K DIWL,DIWR,DIWF,Z
K ^UTILITY($J,"W"),ACDNODE,ACDFILE,ACDDA
Q
ACDRLP1 ;IHS/ADC/EDE/KML - CONT OF ACDRLP;
+1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
+2 ;
+3 ;
COVPAGE ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !?5,"CHEMICAL DEPENDENCY MIS ",$SELECT(ACDPTVS="P":"PATIENT",1:"CDMIS RECORD")," ",$SELECT(ACDCTYP="D":"LISTING",1:"COUNT")
+3 WRITE !!,"REPORT REQUESTED BY: ",$PIECE(^VA(200,DUZ,0),U)
+4 WRITE !!,"The following report contains a ",$SELECT(ACDPTVS="V":"CDMIS Record",1:"Patient")," report based on the",!,"following criteria:",!
SHOW ;
+1 WRITE !,$SELECT(ACDPTVS="P":"PATIENT",1:"VISIT")," Selection Criteria"
+2 IF $DATA(ACDRDTR)
IF $DATA(ACDBDD)
WRITE !!?6,"Visit Date range: ",ACDBDD," to ",ACDEDD,!
+3 IF ACDPTVS="V"
WRITE !!?6,"Visit Date range: ",ACDBDD," to ",ACDEDD,!
+4 IF '$DATA(^ACDRPTD(ACDRPT,11))
GOTO SHOWP
+5 SET ACDI=0
FOR
SET ACDI=$ORDER(^ACDRPTD(ACDRPT,11,ACDI))
IF ACDI'=+ACDI
QUIT
Begin DoDot:1
+6 IF $Y>(IOSL-5)
DO PAUSE^ACDRL01
WRITE @IOF
+7 WRITE !?6,$PIECE(^ACDTITEM(ACDI,0),U),": "
+8 KILL ACDQ
SET ACDY=0
SET C=0
KILL ACDQ
FOR
SET ACDY=$ORDER(^ACDRPTD(ACDRPT,11,ACDI,11,"B",ACDY))
SET C=C+1
IF C'=1&(ACDY'="")
WRITE " ; "
IF ACDY=""!($DATA(ACDQ))
QUIT
SET X=ACDY
IF $DATA(^ACDTITEM(ACDI,2))
XECUTE ^(2)
WRITE X
End DoDot:1
+9 KILL ACDQ
SHOWP ;
+1 IF ACDCTYP="F"
WRITE !!,"FLAT FILE BEING GENERATED: ",ACDFILE,!!
IF '$DATA(ZTQUEUED)
WRITE "HOLD ON......"
QUIT
+2 IF ACDCTYP="T"
DO COUNT
QUIT
+3 IF ACDCTYP="S"
Begin DoDot:1
+4 IF $Y>(IOSL-6)
DO PAUSE^ACDRL01
WRITE @IOF
+5 WRITE !!,"Report will contain sub-totals by ",$PIECE(^ACDTITEM(ACDSORT,0),U),"."
+6 IF '$DATA(^TMP("ACDRL",ACDJOB,ACDBTH))
WRITE !!,$SELECT(ACDPTVS="V":"NO VISITS",1:"NO PATIENTS")_" TO REPORT.",!
DO PAUSE^ACDRL01
IF $DATA(IOF)
WRITE @IOF
+7 QUIT
End DoDot:1
IF 1
+8 IF ACDCTYP'="D"
DO PAUSE^ACDRL01
IF $DATA(IOF)
WRITE @IOF
QUIT
+9 IF $Y>(IOSL-4)
DO PAUSE^ACDRL01
WRITE @IOF
+10 WRITE !!,"PRINT Field Selection"
+11 IF '$DATA(^ACDRPTD(ACDRPT,12))
GOTO PAUSE
+12 SET ACDI=0
FOR
SET ACDI=$ORDER(^ACDRPTD(ACDRPT,12,ACDI))
IF ACDI'=+ACDI
QUIT
SET ACDCRIT=$PIECE(^ACDRPTD(ACDRPT,12,ACDI,0),U)
Begin DoDot:1
+13 IF $Y>(IOSL-4)
DO PAUSE^ACDRL01
IF $DATA(IOF)
WRITE @IOF
+14 WRITE !?6,$PIECE(^ACDTITEM(ACDCRIT,0),U)," ("
SET X=$ORDER(^ACDRPTD(ACDRPT,12,"B",ACDCRIT,""))
WRITE $PIECE(^ACDRPTD(ACDRPT,12,X,0),U,2),")"
End DoDot:1
+15 IF $Y>(IOSL-4)
DO PAUSE^ACDRL01
IF $DATA(IOF)
WRITE @IOF
+16 WRITE !?10," TOTAL column width: ",ACDTCW
+17 IF '$GET(ACDSORT)
QUIT
+18 IF $Y>(IOSL-4)
DO PAUSE^ACDRL01
IF $DATA(IOF)
WRITE @IOF
+19 WRITE !!?6,$SELECT(ACDPTVS="V":"Records",1:"Patients")," will be sorted by: ",$PIECE(^ACDTITEM(ACDSORT,0),U),!
+20 IF $Y>(IOSL-4)
DO PAUSE^ACDRL01
IF $DATA(IOF)
WRITE @IOF
+21 IF $GET(ACDSPAG)
WRITE !?6,"Each ",$PIECE(^ACDTITEM(ACDSORT,0),U)," will be on a separate page.",!
+22 IF '$DATA(^TMP("ACDRL",ACDJOB,ACDBTH))
WRITE !!,$SELECT(ACDPTVS="V":"NO VISITS",1:"NO PATIENTS")_" TO REPORT.",!
PAUSE DO PAUSE^ACDRL01
IF $DATA(IOF)
WRITE @IOF
+1 QUIT
COUNT ;if COUNTING entries only
+1 IF $Y>(IOSL-5)
DO PAUSE^ACDRL01
IF $DATA(IOF)
WRITE @IOF
+2 IF '$DATA(^TMP("ACDRL",ACDJOB,ACDBTH))
WRITE !!!,$SELECT(ACDPTVS="V":"NO VISITS",1:"NO PATIENTS")_" TO REPORT.",!
+3 IF $DATA(ACDRCNT)
IF ACDPTVS="V"
WRITE !!!,"Total COUNT of ",$SELECT(ACDPTVS="P":"Patients",1:"Records"),": ",ACDRCNT
+4 IF $DATA(ACDPTCT)
IF ACDPTVS="P"
WRITE !!!,"Total COUNT of ",$SELECT(ACDPTVS="P":"Patients",1:"Records"),": ",ACDPTCT
+5 QUIT
WP ;EP - Entry point to print wp fields pass node in ACDNODE
+1 ;PASS FILE IN ACDFILE, ENTRY IN ACDDA
+2 KILL ^UTILITY($JOB,"W")
+3 SET ACDG=^DIC(ACDFILE,"GL",0)
SET ACDG=ACDG_ACDDA_",ACDX)"
+4 SET DIWL=1
SET DIWR=$PIECE(^ACDRPTD(ACDRPT,12,ACDI,0),U,2)
FOR
SET ACDX=$ORDER(@ACDG)
IF ACDX'=+ACDX
QUIT
Begin DoDot:1
+5 SET Y=ACDG_",0)"
SET X=@Y
DO ^DIWP
+6 QUIT
End DoDot:1
WPS ;EP
+1 SET Z=0
FOR
SET Z=$ORDER(^UTILITY($JOB,"W",DIWL,Z))
IF Z'=+Z
QUIT
SET ACDPCNT=ACDPCNT+1
SET ACDPRNM(ACDPCNT)=^UTILITY($JOB,"W",DIWL,Z,0)
+2 KILL DIWL,DIWR,DIWF,Z
+3 KILL ^UTILITY($JOB,"W"),ACDNODE,ACDFILE,ACDDA
+4 QUIT
