AQAOPC52 ; IHS/ORDC/LJF - PRINT QTR PROGRESS RPRT ;
;;1.01;QAI MANAGEMENT;;OCT 05, 1995
;
;This rtn prints occ finding/action counts by month in a matrix,
;months along the top and finding/action pairs down the side.
;Totals by month and totals by finding/action pair are also printed.
;Any action plans associated with the indicator are printed at the
;bottom of each indicator page.
;
INIT ; >> initialize variables
D MONTHS ;set array for all months included in report
;use wide margin if date range has more than 7 months
S AQAOIOMX=80
I Y>7 S AQAOIOM=IOM,(AQAOIOMX,X)=132 X:IOT'="HFS" ^%ZOSF("RM")
S AQAOLIN3="",$P(AQAOLIN3,"-",AQAOIOMX-10)=""
D INIT^AQAOUTIL S AQAOHCON="Patient"
S AQAOTY=$S($D(AQAORPTT):AQAORPTT,1:"PROGRESS REPORT")
S Y=AQAOBD X ^DD("DD") S AQAORNG="("_Y,Y=AQAOED-31 X ^DD("DD")
S AQAORNG=AQAORNG_" - "_Y_")" ;date range
;
LOOP ; >> loop thru ^tmp to get data then print it
S AQAOF=0
F S AQAOF=$O(^TMP("AQAOPC5",$J,1,AQAOF)) Q:AQAOF="" Q:AQAOSTOP=U D
.S:AQAOTYP=1 AQAOIND=$O(^TMP("AQAOPC5",$J,1,AQAOF,0)),AQAOM=$$INDNAME
.I AQAOPAGE=0 D HEADING^AQAOUTIL,HDG2 I 1
.E D NEWPG^AQAOUTIL Q:AQAOSTOP=U D HDG2
.S AQAOIND=0
.F S AQAOIND=$O(^TMP("AQAOPC5",$J,1,AQAOF,AQAOIND)) Q:AQAOIND="" Q:AQAOSTOP=U D
..I $Y>(IOSL-4) D NEWPG^AQAOUTIL Q:AQAOSTOP=U D HDG2
..S AQAOM=$$INDNAME ;set indicator heading
..I AQAOTYP>1 W !!,AQAOM,!
..S AQAOIT=$G(^TMP("AQAOPC5A",$J,AQAOF,AQAOIND))
..I AQAOIT=0 W !?10,">> NO OCCURRENCES FOUND FOR THIS INDICATOR <<" Q
..E D COUNTP ;print counts by month
..D ACTION^AQAOPC54 ;include action plans
;
;
EXIT ; >>> eoj
I IOST["C-" D PRTOPT^AQAOVAR
I $D(AQAOIOM),IOT'="HFS" S X=AQAOIOM X ^%ZOSF("RM")
D ^%ZISC D KILL^AQAOUTIL
K ^TMP("AQAOPC5",$J),^TMP("AQAOPC5A",$J),^TMP("AQAOPC5B",$J)
Q
;
;
;
COUNTP ; >> SUBRTN to print line for all find/act combos with counts by month
D MONTHS ;PATCH 2
S AQAOFA=0 ;get next finding
F S AQAOFA=$O(^TMP("AQAOPC5A",$J,AQAOF,AQAOIND,AQAOFA)) Q:AQAOFA="" Q:AQAOSTOP=U D
.S AQAOAC=0 ;get next action for this finding
.F S AQAOAC=$O(^TMP("AQAOPC5A",$J,AQAOF,AQAOIND,AQAOFA,AQAOAC)) Q:AQAOAC="" Q:AQAOSTOP=U D
..S AQAOFAT=^TMP("AQAOPC5A",$J,AQAOF,AQAOIND,AQAOFA,AQAOAC) ;f/a subtl
..I $Y>(IOSL-4) D NEWPG^AQAOUTIL Q:AQAOSTOP=U D HDG2
..W !,AQAOFA,"/",AQAOAC,?8
..;
..;fill in counts for all months
..S AQAOMON=0
..F S AQAOMON=$O(AQAOARM(AQAOMON)) Q:AQAOMON="" Q:AQAOSTOP=U D
...I '$D(^TMP("AQAOPC5A",$J,AQAOF,AQAOIND,AQAOFA,AQAOAC,AQAOMON)) D Q
....S X=$X+9 W ?X
...S X=^TMP("AQAOPC5A",$J,AQAOF,AQAOIND,AQAOFA,AQAOAC,AQAOMON)
...W ?($X+1),$J(X,8) ; print count for month
...S AQAOARM(AQAOMON)=AQAOARM(AQAOMON)+X ;increment total
..W ?AQAOIOMX-11,$J(AQAOFAT,8)
..;
..;fill in percentages for all months for this find/act combo
..I $Y>(IOSL-4) D NEWPG^AQAOUTIL Q:AQAOSTOP=U D HDG2
..W !?8 S AQAOMON=0
..F S AQAOMON=$O(AQAOARM(AQAOMON)) Q:AQAOMON="" Q:AQAOSTOP=U D
...I '$D(^TMP("AQAOPC5A",$J,AQAOF,AQAOIND,AQAOFA,AQAOAC,AQAOMON)) D Q
....S X=$X+9 W ?X
..W ?AQAOIOMX-12,$J(AQAOFAT/AQAOIT*100,8,2),"%" ;find/act as % total
;
;
;print monthly totals for this indicator
I $Y>(IOSL-4) D NEWPG^AQAOUTIL Q:AQAOSTOP=U D HDG2
W !?9,AQAOLIN3,!,"Monthly:" S AQAOMON=0
F S AQAOMON=$O(AQAOARM(AQAOMON)) Q:AQAOMON="" Q:AQAOSTOP=U D
.W ?($X+1),$J(AQAOARM(AQAOMON),8) ;# of occ by month
W ?AQAOIOMX-11,$J(+AQAOIT,8)
; ;print % for each month for ind
S AQAOMON=0 W !?8
F S AQAOMON=$O(AQAOARM(AQAOMON)) Q:AQAOMON="" Q:AQAOSTOP=U D
.W:AQAOIT>0 $J(AQAOARM(AQAOMON)/AQAOIT*100,8,2),"%" ;% of occ
W !
Q
;
;
MONTHS ; >> SUBRTN to create array for months in report&init their counts
S X=AQAOBD,Y=0 F Q:X>AQAOED D
.I $E(X,4,5)=13 S X=($E(X,1,3)+1)_"0100"
.S AQAOARM($E(X,1,5))=0
.S X=X+100,Y=Y+1
Q
;
;
HDG2 ; >> SUBRTN to print 2nd half of heading
W ?AQAOIOMX-$L(AQAORNG)/2,AQAORNG,!
I AQAOTYP=1 W ?AQAOIOMX-$L(AQAOM)/2,AQAOM
E W ?AQAOIOMX-$L(AQAOF)/2,AQAOF
W !,AQAOLIN2,!,"Find/Act"
S X=0
F S X=$O(AQAOARM(X)) Q:X="" W ?($X+2),1700+$E(X,1,3),"/",$E(X,4,5)
W ?AQAOIOMX-9," Totals"
W !,AQAOLINE
Q
;
;
INDNAME() ;ENTRY POINT EXTR VAR - sets the indicator heading variable
S AQAOT=^AQAO(2,AQAOIND,0),AQAOM=$P(AQAOT,U)_"-"_$P(AQAOT,U,2)
S Y=$P(AQAOT,U,3),C=$P(^DD(9002168.2,.03,0),U,2) D Y^DIQ
S AQAOZ=" ("_Y ;add on process vs. outcome
S Y=$P(AQAOT,U,4),C=$P(^DD(9002168.2,.04,0),U,2) D Y^DIQ
S AQAOZ=AQAOZ_"/"_Y ;add on sentinel vs. rate-based
S Y=$P(AQAOT,U,5) I Y]"" S C=$P(^DD(9002168.2,.05,0),U,2) D Y^DIQ
S AQAOZ=$S(Y="":AQAOZ_")",1:AQAOZ_"/"_Y_")"),AQAOM=AQAOM_AQAOZ
S AQAOM="*** "_AQAOM_" ***"
Q AQAOM
AQAOPC52 ; IHS/ORDC/LJF - PRINT QTR PROGRESS RPRT ;
+1 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
+2 ;
+3 ;This rtn prints occ finding/action counts by month in a matrix,
+4 ;months along the top and finding/action pairs down the side.
+5 ;Totals by month and totals by finding/action pair are also printed.
+6 ;Any action plans associated with the indicator are printed at the
+7 ;bottom of each indicator page.
+8 ;
INIT ; >> initialize variables
+1 ;set array for all months included in report
DO MONTHS
+2 ;use wide margin if date range has more than 7 months
+3 SET AQAOIOMX=80
+4 IF Y>7
SET AQAOIOM=IOM
SET (AQAOIOMX,X)=132
IF IOT'="HFS"
XECUTE ^%ZOSF("RM")
+5 SET AQAOLIN3=""
SET $PIECE(AQAOLIN3,"-",AQAOIOMX-10)=""
+6 DO INIT^AQAOUTIL
SET AQAOHCON="Patient"
+7 SET AQAOTY=$SELECT($DATA(AQAORPTT):AQAORPTT,1:"PROGRESS REPORT")
+8 SET Y=AQAOBD
XECUTE ^DD("DD")
SET AQAORNG="("_Y
SET Y=AQAOED-31
XECUTE ^DD("DD")
+9 ;date range
SET AQAORNG=AQAORNG_" - "_Y_")"
+10 ;
LOOP ; >> loop thru ^tmp to get data then print it
+1 SET AQAOF=0
+2 FOR
SET AQAOF=$ORDER(^TMP("AQAOPC5",$JOB,1,AQAOF))
IF AQAOF=""
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:1
+3 IF AQAOTYP=1
SET AQAOIND=$ORDER(^TMP("AQAOPC5",$JOB,1,AQAOF,0))
SET AQAOM=$$INDNAME
+4 IF AQAOPAGE=0
DO HEADING^AQAOUTIL
DO HDG2
IF 1
+5 IF '$TEST
DO NEWPG^AQAOUTIL
IF AQAOSTOP=U
QUIT
DO HDG2
+6 SET AQAOIND=0
+7 FOR
SET AQAOIND=$ORDER(^TMP("AQAOPC5",$JOB,1,AQAOF,AQAOIND))
IF AQAOIND=""
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:2
+8 IF $Y>(IOSL-4)
DO NEWPG^AQAOUTIL
IF AQAOSTOP=U
QUIT
DO HDG2
+9 ;set indicator heading
SET AQAOM=$$INDNAME
+10 IF AQAOTYP>1
WRITE !!,AQAOM,!
+11 SET AQAOIT=$GET(^TMP("AQAOPC5A",$JOB,AQAOF,AQAOIND))
+12 IF AQAOIT=0
WRITE !?10,">> NO OCCURRENCES FOUND FOR THIS INDICATOR <<"
QUIT
+13 ;print counts by month
IF '$TEST
DO COUNTP
+14 ;include action plans
DO ACTION^AQAOPC54
End DoDot:2
End DoDot:1
+15 ;
+16 ;
EXIT ; >>> eoj
+1 IF IOST["C-"
DO PRTOPT^AQAOVAR
+2 IF $DATA(AQAOIOM)
IF IOT'="HFS"
SET X=AQAOIOM
XECUTE ^%ZOSF("RM")
+3 DO ^%ZISC
DO KILL^AQAOUTIL
+4 KILL ^TMP("AQAOPC5",$JOB),^TMP("AQAOPC5A",$JOB),^TMP("AQAOPC5B",$JOB)
+5 QUIT
+6 ;
+7 ;
+8 ;
COUNTP ; >> SUBRTN to print line for all find/act combos with counts by month
+1 ;PATCH 2
DO MONTHS
+2 ;get next finding
SET AQAOFA=0
+3 FOR
SET AQAOFA=$ORDER(^TMP("AQAOPC5A",$JOB,AQAOF,AQAOIND,AQAOFA))
IF AQAOFA=""
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:1
+4 ;get next action for this finding
SET AQAOAC=0
+5 FOR
SET AQAOAC=$ORDER(^TMP("AQAOPC5A",$JOB,AQAOF,AQAOIND,AQAOFA,AQAOAC))
IF AQAOAC=""
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:2
+6 ;f/a subtl
SET AQAOFAT=^TMP("AQAOPC5A",$JOB,AQAOF,AQAOIND,AQAOFA,AQAOAC)
+7 IF $Y>(IOSL-4)
DO NEWPG^AQAOUTIL
IF AQAOSTOP=U
QUIT
DO HDG2
+8 WRITE !,AQAOFA,"/",AQAOAC,?8
+9 ;
+10 ;fill in counts for all months
+11 SET AQAOMON=0
+12 FOR
SET AQAOMON=$ORDER(AQAOARM(AQAOMON))
IF AQAOMON=""
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:3
+13 IF '$DATA(^TMP("AQAOPC5A",$JOB,AQAOF,AQAOIND,AQAOFA,AQAOAC,AQAOMON))
Begin DoDot:4
+14 SET X=$X+9
WRITE ?X
End DoDot:4
QUIT
+15 SET X=^TMP("AQAOPC5A",$JOB,AQAOF,AQAOIND,AQAOFA,AQAOAC,AQAOMON)
+16 ; print count for month
WRITE ?($X+1),$JUSTIFY(X,8)
+17 ;increment total
SET AQAOARM(AQAOMON)=AQAOARM(AQAOMON)+X
End DoDot:3
+18 WRITE ?AQAOIOMX-11,$JUSTIFY(AQAOFAT,8)
+19 ;
+20 ;fill in percentages for all months for this find/act combo
+21 IF $Y>(IOSL-4)
DO NEWPG^AQAOUTIL
IF AQAOSTOP=U
QUIT
DO HDG2
+22 WRITE !?8
SET AQAOMON=0
+23 FOR
SET AQAOMON=$ORDER(AQAOARM(AQAOMON))
IF AQAOMON=""
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:3
+24 IF '$DATA(^TMP("AQAOPC5A",$JOB,AQAOF,AQAOIND,AQAOFA,AQAOAC,AQAOMON))
Begin DoDot:4
+25 SET X=$X+9
WRITE ?X
End DoDot:4
QUIT
End DoDot:3
+26 ;find/act as % total
WRITE ?AQAOIOMX-12,$JUSTIFY(AQAOFAT/AQAOIT*100,8,2),"%"
End DoDot:2
End DoDot:1
+27 ;
+28 ;
+29 ;print monthly totals for this indicator
+30 IF $Y>(IOSL-4)
DO NEWPG^AQAOUTIL
IF AQAOSTOP=U
QUIT
DO HDG2
+31 WRITE !?9,AQAOLIN3,!,"Monthly:"
SET AQAOMON=0
+32 FOR
SET AQAOMON=$ORDER(AQAOARM(AQAOMON))
IF AQAOMON=""
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:1
+33 ;# of occ by month
WRITE ?($X+1),$JUSTIFY(AQAOARM(AQAOMON),8)
End DoDot:1
+34 WRITE ?AQAOIOMX-11,$JUSTIFY(+AQAOIT,8)
+35 ; ;print % for each month for ind
+36 SET AQAOMON=0
WRITE !?8
+37 FOR
SET AQAOMON=$ORDER(AQAOARM(AQAOMON))
IF AQAOMON=""
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:1
+38 ;% of occ
IF AQAOIT>0
WRITE $JUSTIFY(AQAOARM(AQAOMON)/AQAOIT*100,8,2),"%"
End DoDot:1
+39 WRITE !
+40 QUIT
+41 ;
+42 ;
MONTHS ; >> SUBRTN to create array for months in report&init their counts
+1 SET X=AQAOBD
SET Y=0
FOR
IF X>AQAOED
QUIT
Begin DoDot:1
+2 IF $EXTRACT(X,4,5)=13
SET X=($EXTRACT(X,1,3)+1)_"0100"
+3 SET AQAOARM($EXTRACT(X,1,5))=0
+4 SET X=X+100
SET Y=Y+1
End DoDot:1
+5 QUIT
+6 ;
+7 ;
HDG2 ; >> SUBRTN to print 2nd half of heading
+1 WRITE ?AQAOIOMX-$LENGTH(AQAORNG)/2,AQAORNG,!
+2 IF AQAOTYP=1
WRITE ?AQAOIOMX-$LENGTH(AQAOM)/2,AQAOM
+3 IF '$TEST
WRITE ?AQAOIOMX-$LENGTH(AQAOF)/2,AQAOF
+4 WRITE !,AQAOLIN2,!,"Find/Act"
+5 SET X=0
+6 FOR
SET X=$ORDER(AQAOARM(X))
IF X=""
QUIT
WRITE ?($X+2),1700+$EXTRACT(X,1,3),"/",$EXTRACT(X,4,5)
+7 WRITE ?AQAOIOMX-9," Totals"
+8 WRITE !,AQAOLINE
+9 QUIT
+10 ;
+11 ;
INDNAME() ;ENTRY POINT EXTR VAR - sets the indicator heading variable
+1 SET AQAOT=^AQAO(2,AQAOIND,0)
SET AQAOM=$PIECE(AQAOT,U)_"-"_$PIECE(AQAOT,U,2)
+2 SET Y=$PIECE(AQAOT,U,3)
SET C=$PIECE(^DD(9002168.2,.03,0),U,2)
DO Y^DIQ
+3 ;add on process vs. outcome
SET AQAOZ=" ("_Y
+4 SET Y=$PIECE(AQAOT,U,4)
SET C=$PIECE(^DD(9002168.2,.04,0),U,2)
DO Y^DIQ
+5 ;add on sentinel vs. rate-based
SET AQAOZ=AQAOZ_"/"_Y
+6 SET Y=$PIECE(AQAOT,U,5)
IF Y]""
SET C=$PIECE(^DD(9002168.2,.05,0),U,2)
DO Y^DIQ
+7 SET AQAOZ=$SELECT(Y="":AQAOZ_")",1:AQAOZ_"/"_Y_")")
SET AQAOM=AQAOM_AQAOZ
+8 SET AQAOM="*** "_AQAOM_" ***"
+9 QUIT AQAOM
