- 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
