AQAOPC53 ; IHS/ORDC/LJF - PRINT QRT PROGRESS RPT-ASCII ;
;;1.01;QAI MANAGEMENT;;OCT 05, 1995
;
;This rtn prints the qtr progress report in ASCII format for use
;in PC-based applications. Basic format is the same as in ^AQAOPC52.
;
INIT ; >> initialize variables
D MONTHS ;set array for all months included in report
;use wide margin if date range has more than 7 months
I Y>7 S AQAOIOM=IOM,(AQAOIOMX,X)=132 X:IOT'="HFS" ^%ZOSF("RM")
D INIT^AQAOUTIL S AQAOHCON="Patient"
S AQAOTY=$S($D(AQAORPTT):AQAORPTT,1:"CLOSED OCCURRENCES REPORT")
S Y=AQAOBD X ^DD("DD") S AQAORNG="("_Y,Y=AQAOED-31 X ^DD("DD")
S AQAORNG=AQAORNG_" - "_Y_")" ;date range
S AQAOLIN3="",$P(AQAOLIN3,"-",70)=""
;
LOOP ; >> loop thru ^tmp to get data then print it
D DLMHDG^AQAOUTIL,HDG2
S AQAOF=0
F S AQAOF=$O(^TMP("AQAOPC5",$J,1,AQAOF)) Q:AQAOF="" Q:AQAOSTOP=U D
.S AQAOIND=0
.F S AQAOIND=$O(^TMP("AQAOPC5",$J,1,AQAOF,AQAOIND)) Q:AQAOIND="" Q:AQAOSTOP=U D
..S AQAOM=$$INDNAME^AQAOPC52 ;set indicator heading
..W !!,AQAOF,!,AQAOM,!
..S AQAOIT=$G(^TMP("AQAOPC5A",$J,AQAOF,AQAOIND))
..I AQAOIT=0 W !,">>> NO OCCURRENCES FOUND FOR THIS INDICATOR <<<" Q
..E D COUNTP ;prnt counts by month
..D ACTDLM^AQAOPC54 ;include action plans
;
;
EXIT ; >>> eoj
W !!,*7,"*** STOP CAPTURE NOW ***"
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)
Q
;
;
;
COUNTP ; >> SUBRTN to print line for all find/act combos with counts by month
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
..W !,AQAOFA,"/",AQAOAC,AQAODLM
..;
..; ;fill in counts for all months
..S AQAOMON=0
..F S AQAOMON=$O(AQAOARM(AQAOMON)) Q:AQAOMON="" Q:AQAOSTOP=U D
...S X=$G(^TMP("AQAOPC5A",$J,AQAOF,AQAOIND,AQAOFA,AQAOAC,AQAOMON))
...I X=0 W "0",AQAODLM Q
...W X,AQAODLM S AQAOARM(AQAOMON)=AQAOARM(AQAOMON)+X ;print count
..W AQAOFAT
..;
..;fill in percentages for all months for this find/act combo
..W !,AQAODLM S AQAOMON=0
..F S AQAOMON=$O(AQAOARM(AQAOMON)) Q:AQAOMON="" Q:AQAOSTOP=U D
...S X=$G(^TMP("AQAOPC5A",$J,AQAOF,AQAOIND,AQAOFA,AQAOAC,AQAOMON))
...I X=0 W "0.00%",AQAODLM Q
...W $J(X/AQAOIT*100,8,2),"%",AQAODLM ;month as %
..W $J(AQAOFAT/AQAOIT*100,8,2),"%" ;find/act as % of totl
;
;
;print monthly totals for this indicator
W !,"Monthly:",AQAODLM S AQAOMON=0
F S AQAOMON=$O(AQAOARM(AQAOMON)) Q:AQAOMON="" Q:AQAOSTOP=U D
.W AQAOARM(AQAOMON),AQAODLM ;# of occ by month
W AQAOIT
; ;print % for each month for this indicator
S AQAOMON=0 W !,AQAODLM
F S AQAOMON=$O(AQAOARM(AQAOMON)) Q:AQAOMON="" Q:AQAOSTOP=U D
.W:(AQAOIT>0) $J(AQAOARM(AQAOMON)/AQAOIT*100,8,2),"%",AQAODLM ;% 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 " ",AQAORNG,!
W !!,"Find/Act",AQAODLM
S X=0
F S X=$O(AQAOARM(X)) Q:X="" W 1700+$E(X,1,3),"/",$E(X,4,5),AQAODLM
W " Totals"
W !
Q
AQAOPC53 ; IHS/ORDC/LJF - PRINT QRT PROGRESS RPT-ASCII ;
+1 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
+2 ;
+3 ;This rtn prints the qtr progress report in ASCII format for use
+4 ;in PC-based applications. Basic format is the same as in ^AQAOPC52.
+5 ;
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 IF Y>7
SET AQAOIOM=IOM
SET (AQAOIOMX,X)=132
IF IOT'="HFS"
XECUTE ^%ZOSF("RM")
+4 DO INIT^AQAOUTIL
SET AQAOHCON="Patient"
+5 SET AQAOTY=$SELECT($DATA(AQAORPTT):AQAORPTT,1:"CLOSED OCCURRENCES REPORT")
+6 SET Y=AQAOBD
XECUTE ^DD("DD")
SET AQAORNG="("_Y
SET Y=AQAOED-31
XECUTE ^DD("DD")
+7 ;date range
SET AQAORNG=AQAORNG_" - "_Y_")"
+8 SET AQAOLIN3=""
SET $PIECE(AQAOLIN3,"-",70)=""
+9 ;
LOOP ; >> loop thru ^tmp to get data then print it
+1 DO DLMHDG^AQAOUTIL
DO HDG2
+2 SET AQAOF=0
+3 FOR
SET AQAOF=$ORDER(^TMP("AQAOPC5",$JOB,1,AQAOF))
IF AQAOF=""
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:1
+4 SET AQAOIND=0
+5 FOR
SET AQAOIND=$ORDER(^TMP("AQAOPC5",$JOB,1,AQAOF,AQAOIND))
IF AQAOIND=""
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:2
+6 ;set indicator heading
SET AQAOM=$$INDNAME^AQAOPC52
+7 WRITE !!,AQAOF,!,AQAOM,!
+8 SET AQAOIT=$GET(^TMP("AQAOPC5A",$JOB,AQAOF,AQAOIND))
+9 IF AQAOIT=0
WRITE !,">>> NO OCCURRENCES FOUND FOR THIS INDICATOR <<<"
QUIT
+10 ;prnt counts by month
IF '$TEST
DO COUNTP
+11 ;include action plans
DO ACTDLM^AQAOPC54
End DoDot:2
End DoDot:1
+12 ;
+13 ;
EXIT ; >>> eoj
+1 WRITE !!,*7,"*** STOP CAPTURE NOW ***"
+2 IF IOST["C-"
DO PRTOPT^AQAOVAR
+3 IF $DATA(AQAOIOM)
IF IOT'="HFS"
SET X=AQAOIOM
XECUTE ^%ZOSF("RM")
+4 DO ^%ZISC
DO KILL^AQAOUTIL
+5 KILL ^TMP("AQAOPC5",$JOB),^TMP("AQAOPC5A",$JOB)
+6 QUIT
+7 ;
+8 ;
+9 ;
COUNTP ; >> SUBRTN to print line for all find/act combos with counts by month
+1 ;get next finding
SET AQAOFA=0
+2 FOR
SET AQAOFA=$ORDER(^TMP("AQAOPC5A",$JOB,AQAOF,AQAOIND,AQAOFA))
IF AQAOFA=""
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:1
+3 ;get next action for this finding
SET AQAOAC=0
+4 FOR
SET AQAOAC=$ORDER(^TMP("AQAOPC5A",$JOB,AQAOF,AQAOIND,AQAOFA,AQAOAC))
IF AQAOAC=""
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:2
+5 ;f/a subtl
SET AQAOFAT=^TMP("AQAOPC5A",$JOB,AQAOF,AQAOIND,AQAOFA,AQAOAC)
+6 WRITE !,AQAOFA,"/",AQAOAC,AQAODLM
+7 ;
+8 ; ;fill in counts for all months
+9 SET AQAOMON=0
+10 FOR
SET AQAOMON=$ORDER(AQAOARM(AQAOMON))
IF AQAOMON=""
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:3
+11 SET X=$GET(^TMP("AQAOPC5A",$JOB,AQAOF,AQAOIND,AQAOFA,AQAOAC,AQAOMON))
+12 IF X=0
WRITE "0",AQAODLM
QUIT
+13 ;print count
WRITE X,AQAODLM
SET AQAOARM(AQAOMON)=AQAOARM(AQAOMON)+X
End DoDot:3
+14 WRITE AQAOFAT
+15 ;
+16 ;fill in percentages for all months for this find/act combo
+17 WRITE !,AQAODLM
SET AQAOMON=0
+18 FOR
SET AQAOMON=$ORDER(AQAOARM(AQAOMON))
IF AQAOMON=""
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:3
+19 SET X=$GET(^TMP("AQAOPC5A",$JOB,AQAOF,AQAOIND,AQAOFA,AQAOAC,AQAOMON))
+20 IF X=0
WRITE "0.00%",AQAODLM
QUIT
+21 ;month as %
WRITE $JUSTIFY(X/AQAOIT*100,8,2),"%",AQAODLM
End DoDot:3
+22 ;find/act as % of totl
WRITE $JUSTIFY(AQAOFAT/AQAOIT*100,8,2),"%"
End DoDot:2
End DoDot:1
+23 ;
+24 ;
+25 ;print monthly totals for this indicator
+26 WRITE !,"Monthly:",AQAODLM
SET AQAOMON=0
+27 FOR
SET AQAOMON=$ORDER(AQAOARM(AQAOMON))
IF AQAOMON=""
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:1
+28 ;# of occ by month
WRITE AQAOARM(AQAOMON),AQAODLM
End DoDot:1
+29 WRITE AQAOIT
+30 ; ;print % for each month for this indicator
+31 SET AQAOMON=0
WRITE !,AQAODLM
+32 FOR
SET AQAOMON=$ORDER(AQAOARM(AQAOMON))
IF AQAOMON=""
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:1
+33 ;% of occ
IF (AQAOIT>0)
WRITE $JUSTIFY(AQAOARM(AQAOMON)/AQAOIT*100,8,2),"%",AQAODLM
End DoDot:1
+34 WRITE !
+35 QUIT
+36 ;
+37 ;
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 " ",AQAORNG,!
+2 WRITE !!,"Find/Act",AQAODLM
+3 SET X=0
+4 FOR
SET X=$ORDER(AQAOARM(X))
IF X=""
QUIT
WRITE 1700+$EXTRACT(X,1,3),"/",$EXTRACT(X,4,5),AQAODLM
+5 WRITE " Totals"
+6 WRITE !
+7 QUIT
