ACDRR2P ;IHS/ADC/EDE/KML - PRINT REPORT;
;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
;
START ;
D INIT
D BODY
D EOJ
Q
;
INIT ;
U IO
I '$D(ZTQUEUED),'$D(IO("S")),$E(IOST,1,2)="C-" W @IOF
S ACDPAGE=0,ACDSHDR=""
D HEADER
Q
;
BODY ; WRITE BODY OF REPORT
NEW C,H,Z
S ACDQ=0
D TOTALS
Q:ACDQ
D PROVS
Q:ACDQ
Q
;
TOTALS ; TOTALS REPORT
S X=^TMP("ACDRR2",ACDJOB,ACDBT,"SEEN")
W !
W $$LJRF^ACD("TOTAL PATIENTS SEEN",37,".")," ",X,!
W " (INFO/REFERRALS,CRISIS BRIEFS & INTERVENTIONS EXCLUDED)",!
;
S ACDSHDR="W ""TOTAL HOURS BY VISIT TYPE"""
D SUBHDR
Q:ACDQ
S ACDVT=""
F S ACDVT=$O(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE",ACDVT)) Q:ACDVT="" S Z=+$G(^(ACDVT,"HOURS")) D Q:ACDQ
. D F Q:ACDQ
. S X=$$PRTVT(ACDVT)
. W ?2,$$LJRF^ACD(X,35,".")," ",Z,!
. Q
Q:ACDQ
;
S ACDSHDR="W ""TOTAL HOURS BY CLIENT SERVICE"""
D SUBHDR
Q:ACDQ
S Y=0
F S Y=$O(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE","CS",Y)) Q:'Y S Z=+$G(^(Y,"HOURS")) D Q:ACDQ
. D F Q:ACDQ
. S X=$P(^ACDSERV(Y,0),U)
. W ?2,$$LJRF^ACD(X,35,".")," ",Z,!
. Q
Q:ACDQ
;
S ACDSHDR="W ""TOTAL HOURS BY PREVENTION ACTIVITY"""
D SUBHDR
Q:ACDQ
S Y=0
F S Y=$O(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE","PREV",Y)) Q:'Y S Z=+$G(^(Y,"HOURS")) D Q:ACDQ
. D F Q:ACDQ
. S X=$P(^ACDPREV(9002170.9,Y,0),U)
. W ?2,$$LJRF^ACD(X,35,".")," ",Z,!
. Q
Q:ACDQ
Q
;
PROVS ; PROVIDER REPORTS
;
S ACDPROV=""
F S ACDPROV=$O(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV)) Q:ACDPROV="" D PROVIDER Q:ACDQ
Q:ACDQ
Q
;
PROVIDER ; WRITE ONE PROVIDERS INFO
S ACDSHDR="W ""PROVIDER WORKLOAD INFORMATION"""
D EOP
Q:ACDQ
W "PROVIDER: ",ACDPROV,!
; total pp pats, total hours, total without hours
S Z=+$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"PP"))
W ?2,$$LJRF^ACD("PRIMARY PROVIDER PATIENT COUNT",35,".")," ",Z,!
S Z=+$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"TOT","TOTAL HOURS"))
W ?2,$$LJRF^ACD("TOTAL HOURS",35,".")," ",Z,!
S Z=+$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"TOT","HOURS NR"))
W ?2,$$LJRF^ACD("HOURS NOT RECORDED VISIT COUNT",35,".")," ",Z,!
; counts by visit type
S ACDSHDR="W ""HOURS/COUNT BY VISIT TYPE"",?38,""TOTAL"",?49,""AVG"",?61,""HC"",?71,""NRC"""
D SUBHDR
Q:ACDQ
F ACDTC="IN","RE","TD","FU","IR","OT","CS","PREV","INTV" D Q:ACDQ
. Q:'$D(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"VT",ACDTC))
. D F Q:ACDQ
. S H=+$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"VT",ACDTC,"HOURS"))
. S C=+$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"VT",ACDTC,"HOURS CNT"))
. S Z=+$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"VT",ACDTC,"HOURS NR"))
. S ACDTC=$$PRTVT(ACDTC)
. W ?2,$$LJRF^ACD(ACDTC,35,".")," ",H,?48,$S(C:$J(H/C,5,2),1:" 0"),?61,C,?71,Z,!
. Q
Q:ACDQ
; hours/counts by client service
S ACDSHDR="W ""HOURS/COUNT BY CLIENT SERVICE"",?38,""TOTAL"",?49,""AVG"",?61,""HC"",?71,""NRC"""
D SUBHDR
Q:ACDQ
S ACDCS=0
F S ACDCS=$O(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"VT","CS",ACDCS)) Q:'ACDCS D Q:ACDQ
. D F Q:ACDQ
. S H=+$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"VT","CS",ACDCS,"HOURS"))
. S C=+$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"VT","CS",ACDCS,"HOURS CNT"))
. S X=$P($G(^ACDSERV(ACDCS,0)),U)
. S Z=0
. W ?2,$$LJRF^ACD(X,35,".")," ",H,?48,$S(C:$J(H/C,5,2),1:" 0"),?61,C,?71,Z,!
. Q
Q:ACDQ
; hours/counts by prevention
S ACDSHDR="W ""HOURS/COUNT BY PREVENTION ACTIVITY"",?38,""TOTAL"",?49,""AVG"",?61,""HC"",?71,""NRC"""
D SUBHDR
Q:ACDQ
S ACDPREV=0
F S ACDPREV=$O(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"VT","PREV",ACDPREV)) Q:'ACDPREV D Q:ACDQ
. D F Q:ACDQ
. S H=+$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"VT","PREV",ACDPREV,"HOURS"))
. S C=+$G(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"VT","PREV",ACDPREV,"HOURS CNT"))
. S X=$P($G(^ACDPREV(9002170.9,ACDPREV,0)),U)
. S Z=0
. W ?2,$$LJRF^ACD(X,35,".")," ",H,?48,$S(C:$J(H/C,5,2),1:" 0"),?61,C,?71,Z,!
. Q
Q:ACDQ
;
Q
;
F ;Form feed
NEW V,W,X,Y,Z
I $Y+4>IOSL D EOP
Q
;
EOP ; END OF PAGE
S ACDQ=0
D PAUSE
Q:ACDQ
W @IOF
D HEADER
Q
;
PAUSE ; PAUSE FOR USER
I '$D(ZTQUEUED),'$D(IO("S")),$E(IOST,1,2)'="P-" D PAUSE^ACDDEU S:$D(DIRUT) ACDQ=1
Q
;
S ACDPAGE=ACDPAGE+1
W !,$$CTR^ACD("CDMIS PROVIDER WORKLOAD REPORT",80),!!
W "Run at ",ACDSITE," for ",$$USR^ACD()," on ",$$FMTE^XLFDT(DT),!
W "for date range ",$$FMTE^XLFDT(ACDDTLO)," through ",$$FMTE^XLFDT(ACDDTHI),?72,"Page ",$J(ACDPAGE,3),!
W $$REPEAT^XLFSTR("=",80),!
D SUBHDR
Q
;
SUBHDR ; WRITE SUB HEADER
Q:ACDSHDR=""
I $Y+7>IOSL D EOP Q
W !
X ACDSHDR
W !!
Q
;
PRTVT(VT) ; RETURN PRINTABLE VISIT TYPE
NEW X
S X=$T(@("VT"_VT)),X=$P(X,";;",2)
S:X="" X="???"
W:X="???" "-->"_VT_"<--",!
Q X
VTCS ;;CLIENT SERVICE
VTIN ;;INITIAL
VTRE ;;REOPEN
VTTD ;;TRANSFER/DISCHARGE/CLOSE
VTFU ;;FOLLOWUP
VTIR ;;INFO/REFERRAL
VTOT ;;CRISIS BRIEF
VTPREV ;;PREVENTION
VTINTV ;;INTERVENTION
;
EOJ ;
W:IO'=IO(0) @IOF
K ^TMP("ACDRR2",ACDJOB,ACDBT)
Q
ACDRR2P ;IHS/ADC/EDE/KML - PRINT REPORT;
+1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
+2 ;
START ;
+1 DO INIT
+2 DO BODY
+3 DO EOJ
+4 QUIT
+5 ;
INIT ;
+1 USE IO
+2 IF '$DATA(ZTQUEUED)
IF '$DATA(IO("S"))
IF $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
+3 SET ACDPAGE=0
SET ACDSHDR=""
+4 DO HEADER
+5 QUIT
+6 ;
BODY ; WRITE BODY OF REPORT
+1 NEW C,H,Z
+2 SET ACDQ=0
+3 DO TOTALS
+4 IF ACDQ
QUIT
+5 DO PROVS
+6 IF ACDQ
QUIT
+7 QUIT
+8 ;
TOTALS ; TOTALS REPORT
+1 SET X=^TMP("ACDRR2",ACDJOB,ACDBT,"SEEN")
+2 WRITE !
+3 WRITE $$LJRF^ACD("TOTAL PATIENTS SEEN",37,".")," ",X,!
+4 WRITE " (INFO/REFERRALS,CRISIS BRIEFS & INTERVENTIONS EXCLUDED)",!
+5 ;
+6 SET ACDSHDR="W ""TOTAL HOURS BY VISIT TYPE"""
+7 DO SUBHDR
+8 IF ACDQ
QUIT
+9 SET ACDVT=""
+10 FOR
SET ACDVT=$ORDER(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE",ACDVT))
IF ACDVT=""
QUIT
SET Z=+$GET(^(ACDVT,"HOURS"))
Begin DoDot:1
+11 DO F
IF ACDQ
QUIT
+12 SET X=$$PRTVT(ACDVT)
+13 WRITE ?2,$$LJRF^ACD(X,35,".")," ",Z,!
+14 QUIT
End DoDot:1
IF ACDQ
QUIT
+15 IF ACDQ
QUIT
+16 ;
+17 SET ACDSHDR="W ""TOTAL HOURS BY CLIENT SERVICE"""
+18 DO SUBHDR
+19 IF ACDQ
QUIT
+20 SET Y=0
+21 FOR
SET Y=$ORDER(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE","CS",Y))
IF 'Y
QUIT
SET Z=+$GET(^(Y,"HOURS"))
Begin DoDot:1
+22 DO F
IF ACDQ
QUIT
+23 SET X=$PIECE(^ACDSERV(Y,0),U)
+24 WRITE ?2,$$LJRF^ACD(X,35,".")," ",Z,!
+25 QUIT
End DoDot:1
IF ACDQ
QUIT
+26 IF ACDQ
QUIT
+27 ;
+28 SET ACDSHDR="W ""TOTAL HOURS BY PREVENTION ACTIVITY"""
+29 DO SUBHDR
+30 IF ACDQ
QUIT
+31 SET Y=0
+32 FOR
SET Y=$ORDER(^TMP("ACDRR2",ACDJOB,ACDBT,"VISIT TYPE","PREV",Y))
IF 'Y
QUIT
SET Z=+$GET(^(Y,"HOURS"))
Begin DoDot:1
+33 DO F
IF ACDQ
QUIT
+34 SET X=$PIECE(^ACDPREV(9002170.9,Y,0),U)
+35 WRITE ?2,$$LJRF^ACD(X,35,".")," ",Z,!
+36 QUIT
End DoDot:1
IF ACDQ
QUIT
+37 IF ACDQ
QUIT
+38 QUIT
+39 ;
PROVS ; PROVIDER REPORTS
+1 ;
+2 SET ACDPROV=""
+3 FOR
SET ACDPROV=$ORDER(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV))
IF ACDPROV=""
QUIT
DO PROVIDER
IF ACDQ
QUIT
+4 IF ACDQ
QUIT
+5 QUIT
+6 ;
PROVIDER ; WRITE ONE PROVIDERS INFO
+1 SET ACDSHDR="W ""PROVIDER WORKLOAD INFORMATION"""
+2 DO EOP
+3 IF ACDQ
QUIT
+4 WRITE "PROVIDER: ",ACDPROV,!
+5 ; total pp pats, total hours, total without hours
+6 SET Z=+$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"PP"))
+7 WRITE ?2,$$LJRF^ACD("PRIMARY PROVIDER PATIENT COUNT",35,".")," ",Z,!
+8 SET Z=+$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"TOT","TOTAL HOURS"))
+9 WRITE ?2,$$LJRF^ACD("TOTAL HOURS",35,".")," ",Z,!
+10 SET Z=+$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"TOT","HOURS NR"))
+11 WRITE ?2,$$LJRF^ACD("HOURS NOT RECORDED VISIT COUNT",35,".")," ",Z,!
+12 ; counts by visit type
+13 SET ACDSHDR="W ""HOURS/COUNT BY VISIT TYPE"",?38,""TOTAL"",?49,""AVG"",?61,""HC"",?71,""NRC"""
+14 DO SUBHDR
+15 IF ACDQ
QUIT
+16 FOR ACDTC="IN","RE","TD","FU","IR","OT","CS","PREV","INTV"
Begin DoDot:1
+17 IF '$DATA(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"VT",ACDTC))
QUIT
+18 DO F
IF ACDQ
QUIT
+19 SET H=+$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"VT",ACDTC,"HOURS"))
+20 SET C=+$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"VT",ACDTC,"HOURS CNT"))
+21 SET Z=+$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"VT",ACDTC,"HOURS NR"))
+22 SET ACDTC=$$PRTVT(ACDTC)
+23 WRITE ?2,$$LJRF^ACD(ACDTC,35,".")," ",H,?48,$SELECT(C:$JUSTIFY(H/C,5,2),1:" 0"),?61,C,?71,Z,!
+24 QUIT
End DoDot:1
IF ACDQ
QUIT
+25 IF ACDQ
QUIT
+26 ; hours/counts by client service
+27 SET ACDSHDR="W ""HOURS/COUNT BY CLIENT SERVICE"",?38,""TOTAL"",?49,""AVG"",?61,""HC"",?71,""NRC"""
+28 DO SUBHDR
+29 IF ACDQ
QUIT
+30 SET ACDCS=0
+31 FOR
SET ACDCS=$ORDER(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"VT","CS",ACDCS))
IF 'ACDCS
QUIT
Begin DoDot:1
+32 DO F
IF ACDQ
QUIT
+33 SET H=+$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"VT","CS",ACDCS,"HOURS"))
+34 SET C=+$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"VT","CS",ACDCS,"HOURS CNT"))
+35 SET X=$PIECE($GET(^ACDSERV(ACDCS,0)),U)
+36 SET Z=0
+37 WRITE ?2,$$LJRF^ACD(X,35,".")," ",H,?48,$SELECT(C:$JUSTIFY(H/C,5,2),1:" 0"),?61,C,?71,Z,!
+38 QUIT
End DoDot:1
IF ACDQ
QUIT
+39 IF ACDQ
QUIT
+40 ; hours/counts by prevention
+41 SET ACDSHDR="W ""HOURS/COUNT BY PREVENTION ACTIVITY"",?38,""TOTAL"",?49,""AVG"",?61,""HC"",?71,""NRC"""
+42 DO SUBHDR
+43 IF ACDQ
QUIT
+44 SET ACDPREV=0
+45 FOR
SET ACDPREV=$ORDER(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"VT","PREV",ACDPREV))
IF 'ACDPREV
QUIT
Begin DoDot:1
+46 DO F
IF ACDQ
QUIT
+47 SET H=+$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"VT","PREV",ACDPREV,"HOURS"))
+48 SET C=+$GET(^TMP("ACDRR2",ACDJOB,ACDBT,"PROV",ACDPROV,"VT","PREV",ACDPREV,"HOURS CNT"))
+49 SET X=$PIECE($GET(^ACDPREV(9002170.9,ACDPREV,0)),U)
+50 SET Z=0
+51 WRITE ?2,$$LJRF^ACD(X,35,".")," ",H,?48,$SELECT(C:$JUSTIFY(H/C,5,2),1:" 0"),?61,C,?71,Z,!
+52 QUIT
End DoDot:1
IF ACDQ
QUIT
+53 IF ACDQ
QUIT
+54 ;
+55 QUIT
+56 ;
F ;Form feed
+1 NEW V,W,X,Y,Z
+2 IF $Y+4>IOSL
DO EOP
+3 QUIT
+4 ;
EOP ; END OF PAGE
+1 SET ACDQ=0
+2 DO PAUSE
+3 IF ACDQ
QUIT
+4 WRITE @IOF
+5 DO HEADER
+6 QUIT
+7 ;
PAUSE ; PAUSE FOR USER
+1 IF '$DATA(ZTQUEUED)
IF '$DATA(IO("S"))
IF $EXTRACT(IOST,1,2)'="P-"
DO PAUSE^ACDDEU
IF $DATA(DIRUT)
SET ACDQ=1
+2 QUIT
+3 ;
+1 SET ACDPAGE=ACDPAGE+1
+2 WRITE !,$$CTR^ACD("CDMIS PROVIDER WORKLOAD REPORT",80),!!
+3 WRITE "Run at ",ACDSITE," for ",$$USR^ACD()," on ",$$FMTE^XLFDT(DT),!
+4 WRITE "for date range ",$$FMTE^XLFDT(ACDDTLO)," through ",$$FMTE^XLFDT(ACDDTHI),?72,"Page ",$JUSTIFY(ACDPAGE,3),!
+5 WRITE $$REPEAT^XLFSTR("=",80),!
+6 DO SUBHDR
+7 QUIT
+8 ;
SUBHDR ; WRITE SUB HEADER
+1 IF ACDSHDR=""
QUIT
+2 IF $Y+7>IOSL
DO EOP
QUIT
+3 WRITE !
+4 XECUTE ACDSHDR
+5 WRITE !!
+6 QUIT
+7 ;
PRTVT(VT) ; RETURN PRINTABLE VISIT TYPE
+1 NEW X
+2 SET X=$TEXT(@("VT"_VT))
SET X=$PIECE(X,";;",2)
+3 IF X=""
SET X="???"
+4 IF X="???"
WRITE "-->"_VT_"<--",!
+5 QUIT X
VTCS ;;CLIENT SERVICE
VTIN ;;INITIAL
VTRE ;;REOPEN
VTTD ;;TRANSFER/DISCHARGE/CLOSE
VTFU ;;FOLLOWUP
VTIR ;;INFO/REFERRAL
VTOT ;;CRISIS BRIEF
VTPREV ;;PREVENTION
VTINTV ;;INTERVENTION
+1 ;
EOJ ;
+1 IF IO'=IO(0)
WRITE @IOF
+2 KILL ^TMP("ACDRR2",ACDJOB,ACDBT)
+3 QUIT
