- 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
