- 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
