- AQAOPC13 ; IHS/ORDC/LJF - PRINT OCC BY INDICATOR W/ CRIT ;
- ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
- ;
- ;This rtn contians the entry point called by ^AQAOPC12 to print the
- ;summary page for the trending report by review criteria.
- ;
- SUMMARY ;ENTRY POINT called by ^AQAOPC12 >>> print summary page(s)
- I $D(AQAODLM) D SUMDLM Q
- D NEWPG^AQAOUTIL Q:AQAOSTOP=U D HDG2
- W !,"TOTAL OCCURRENCES FOR DATE RANGE:",?65,$J(AQAOCNT,3)
- W !?15,"THRESHOLD/TRIGGER: "
- I $P(^AQAO(2,AQAOIND,0),U,5)]"" W ?70,$J($P(^(0),U,5),6,2),"%"
- ;
- S AQAOSUB=0 I '$D(AQAOXSN) D SUM2 Q
- F S AQAOSUB=$O(^TMP("AQAOPC11",$J,AQAOSUB)) Q:AQAOSUB="" Q:AQAOSTOP=U D SUM2
- Q
- ;
- ;
- SUM2 ; >> SUBRTN for each AQAOSUB, print totals
- I AQAOSUB'=0 W !!,AQAOSUB,":"
- S AQAOC=0
- F S AQAOC=$O(^TMP("AQAOPC11",$J,AQAOSUB,AQAOC)) Q:AQAOC="" Q:AQAOSTOP=U D
- .I $Y>(IOSL-4) D NEWPG^AQAOUTIL Q:AQAOSTOP=U D HDG2
- .W !!,"CR",AQAOC,?8,AQAOCR(AQAOC) ;criteria number and name
- .S X=$O(^AQAO1(6,AQAOC,"IND","B",AQAOIND,0)) I X]"" D
- ..S X=$P(^AQAO1(6,AQAOC,"IND",X,0),U,2) I X]"" W ?70,$J(X,6,2),"%"
- .S (AQAOV,AQAOCT,AQAOCTP)=0
- .F S AQAOV=$O(^TMP("AQAOPC11",$J,AQAOSUB,AQAOC,AQAOV)) Q:AQAOV="" Q:AQAOSTOP=U D
- ..S AQAOARR(AQAOV)=^TMP("AQAOPC11",$J,AQAOSUB,AQAOC,AQAOV)
- ..S AQAOCT=AQAOCT+^TMP("AQAOPC11",$J,AQAOSUB,AQAOC,AQAOV) ;subtotal
- ..I AQAOV'="N/A" S AQAOCTP=AQAOCTP+AQAOARR(AQAOV) ;subtotl 4 percentage
- .S AQAOV=0 F S AQAOV=$O(AQAOARR(AQAOV)) Q:AQAOV="" Q:AQAOSTOP=U D
- ..I $Y>(IOSL-4) D NEWPG^AQAOUTIL Q:AQAOSTOP=U D HDG2
- ..; ;print totals for each value for each criteria
- ..W !?9,"TOTAL '",$E(AQAOV,1,40),"':",?65,$J(AQAOARR(AQAOV),3)
- ..Q:(AQAOV="N/A")
- ..W ?70,$J((AQAOARR(AQAOV)/AQAOCTP)*100,6,2),"%" ;compare threshold/trigger
- .Q:AQAOSTOP=U W !?64,"____"
- .W !?10,"SUBTOTAL FOR CR",AQAOC,":",?64,$J(AQAOCT,4) ;prnt subtotal
- .K AQAOARR
- Q
- ;
- ;
- SUMDLM ; >>> SUBRTN to print summary page(s) in ASCII format
- W !!!,"**SUMMARY DATA**"
- S X=^AQAO(2,AQAOIND,0) W !!,$P(X,U),AQAODLM,$P(X,U,2) ;ind # and name
- I $P(X,U,5)]"" W AQAODLM,"THRESHOLD/TRIGGER: ",$P(X,U,5),"%"
- W !,"TOTAL OCCURRENCES FOR DATE RANGE:",AQAODLM,$J(AQAOCNT,3)
- ;
- S AQAOSUB=0 I '$D(AQAOXSN) D SUMDLM2 Q
- F S AQAOSUB=$O(^TMP("AQAOPC11",$J,AQAOSUB)) Q:AQAOSUB="" Q:AQAOSTOP=U D SUMDLM2
- Q
- ;
- ;
- SUMDLM2 ; >> SUBRTN for each AQAOSUB, print totals
- I AQAOSUB'=0 W !!,AQAOSUB,":"
- S AQAOC=0
- F S AQAOC=$O(^TMP("AQAOPC11",$J,AQAOSUB,AQAOC)) Q:AQAOC="" D
- .W !!,"CR",AQAOC,AQAODLM,AQAOCR(AQAOC) ;criteria number and name
- .S (AQAOV,AQAOF)=0 ;AQAOF is flag for line feed
- .F S AQAOV=$O(^TMP("AQAOPC11",$J,AQAOSUB,AQAOC,AQAOV)) Q:AQAOV="" D
- ..; ;print totals for each value for each criteria
- ..W:AQAOF=1 !,AQAODLM
- ..W AQAODLM,"TOTAL '",AQAOV,"':"
- ..W AQAODLM,$J(^TMP("AQAOPC11",$J,AQAOSUB,AQAOC,AQAOV),3),AQAODLM
- ..W $J((^TMP("AQAOPC11",$J,AQAOSUB,AQAOC,AQAOV)/AQAOCNT)*100,2,2),"%"
- ..S AQAOF=1 Q
- Q
- ;
- ;
- HDG1 ; >> SUBRTN to print second half of heading
- S X=$P(^AQAO(2,AQAOIND,0),U)_": "_$P(^(0),U,2) ;indicatr
- W ?AQAOIOMX-$L(X)/2,X,!?AQAOIOMX-$L(AQAORG)/2,AQAORG
- W !,AQAOLINE,!,"Case #",?11,"Occ Date "
- S X=0 F S X=$O(AQAOCR(X)) Q:X="" S Y=" CR"_X_" ",Y=$E(Y,1,8) W Y
- Q
- ;
- ;
- DLMHDG ; >> SUBRTN to print second half of heading for ASCII format
- W !!!!,"***OCCURRENCE LISTINGS***",!,AQAORG,!
- W !,"Printed by ",AQAODUZ," Printed on " S %H=$H D YX^%DTC W Y
- W !,"Case #",AQAODLM,"Occ Date "
- S X=0 F S X=$O(AQAOCR(X)) Q:X="" W AQAODLM,"CR",X
- Q
- ;
- ;
- HDG2 ; >> SUBRTN to print second half of heading2
- S X=$P(^AQAO(2,AQAOIND,0),U)_": "_$P(^(0),U,2)_" (SUMMARY PAGE)"
- W ?AQAOIOMX-$L(X)/2,X,!?AQAOIOMX-$L(AQAORG)/2,AQAORG,!,AQAOLINE,!
- Q
- AQAOPC13 ; IHS/ORDC/LJF - PRINT OCC BY INDICATOR W/ CRIT ;
- +1 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
- +2 ;
- +3 ;This rtn contians the entry point called by ^AQAOPC12 to print the
- +4 ;summary page for the trending report by review criteria.
- +5 ;
- SUMMARY ;ENTRY POINT called by ^AQAOPC12 >>> print summary page(s)
- +1 IF $DATA(AQAODLM)
- DO SUMDLM
- QUIT
- +2 DO NEWPG^AQAOUTIL
- IF AQAOSTOP=U
- QUIT
- DO HDG2
- +3 WRITE !,"TOTAL OCCURRENCES FOR DATE RANGE:",?65,$JUSTIFY(AQAOCNT,3)
- +4 WRITE !?15,"THRESHOLD/TRIGGER: "
- +5 IF $PIECE(^AQAO(2,AQAOIND,0),U,5)]""
- WRITE ?70,$JUSTIFY($PIECE(^(0),U,5),6,2),"%"
- +6 ;
- +7 SET AQAOSUB=0
- IF '$DATA(AQAOXSN)
- DO SUM2
- QUIT
- +8 FOR
- SET AQAOSUB=$ORDER(^TMP("AQAOPC11",$JOB,AQAOSUB))
- IF AQAOSUB=""
- QUIT
- IF AQAOSTOP=U
- QUIT
- DO SUM2
- +9 QUIT
- +10 ;
- +11 ;
- SUM2 ; >> SUBRTN for each AQAOSUB, print totals
- +1 IF AQAOSUB'=0
- WRITE !!,AQAOSUB,":"
- +2 SET AQAOC=0
- +3 FOR
- SET AQAOC=$ORDER(^TMP("AQAOPC11",$JOB,AQAOSUB,AQAOC))
- IF AQAOC=""
- QUIT
- IF AQAOSTOP=U
- QUIT
- Begin DoDot:1
- +4 IF $Y>(IOSL-4)
- DO NEWPG^AQAOUTIL
- IF AQAOSTOP=U
- QUIT
- DO HDG2
- +5 ;criteria number and name
- WRITE !!,"CR",AQAOC,?8,AQAOCR(AQAOC)
- +6 SET X=$ORDER(^AQAO1(6,AQAOC,"IND","B",AQAOIND,0))
- IF X]""
- Begin DoDot:2
- +7 SET X=$PIECE(^AQAO1(6,AQAOC,"IND",X,0),U,2)
- IF X]""
- WRITE ?70,$JUSTIFY(X,6,2),"%"
- End DoDot:2
- +8 SET (AQAOV,AQAOCT,AQAOCTP)=0
- +9 FOR
- SET AQAOV=$ORDER(^TMP("AQAOPC11",$JOB,AQAOSUB,AQAOC,AQAOV))
- IF AQAOV=""
- QUIT
- IF AQAOSTOP=U
- QUIT
- Begin DoDot:2
- +10 SET AQAOARR(AQAOV)=^TMP("AQAOPC11",$JOB,AQAOSUB,AQAOC,AQAOV)
- +11 ;subtotal
- SET AQAOCT=AQAOCT+^TMP("AQAOPC11",$JOB,AQAOSUB,AQAOC,AQAOV)
- +12 ;subtotl 4 percentage
- IF AQAOV'="N/A"
- SET AQAOCTP=AQAOCTP+AQAOARR(AQAOV)
- End DoDot:2
- +13 SET AQAOV=0
- FOR
- SET AQAOV=$ORDER(AQAOARR(AQAOV))
- IF AQAOV=""
- QUIT
- IF AQAOSTOP=U
- QUIT
- Begin DoDot:2
- +14 IF $Y>(IOSL-4)
- DO NEWPG^AQAOUTIL
- IF AQAOSTOP=U
- QUIT
- DO HDG2
- +15 ; ;print totals for each value for each criteria
- +16 WRITE !?9,"TOTAL '",$EXTRACT(AQAOV,1,40),"':",?65,$JUSTIFY(AQAOARR(AQAOV),3)
- +17 IF (AQAOV="N/A")
- QUIT
- +18 ;compare threshold/trigger
- WRITE ?70,$JUSTIFY((AQAOARR(AQAOV)/AQAOCTP)*100,6,2),"%"
- End DoDot:2
- +19 IF AQAOSTOP=U
- QUIT
- WRITE !?64,"____"
- +20 ;prnt subtotal
- WRITE !?10,"SUBTOTAL FOR CR",AQAOC,":",?64,$JUSTIFY(AQAOCT,4)
- +21 KILL AQAOARR
- End DoDot:1
- +22 QUIT
- +23 ;
- +24 ;
- SUMDLM ; >>> SUBRTN to print summary page(s) in ASCII format
- +1 WRITE !!!,"**SUMMARY DATA**"
- +2 ;ind # and name
- SET X=^AQAO(2,AQAOIND,0)
- WRITE !!,$PIECE(X,U),AQAODLM,$PIECE(X,U,2)
- +3 IF $PIECE(X,U,5)]""
- WRITE AQAODLM,"THRESHOLD/TRIGGER: ",$PIECE(X,U,5),"%"
- +4 WRITE !,"TOTAL OCCURRENCES FOR DATE RANGE:",AQAODLM,$JUSTIFY(AQAOCNT,3)
- +5 ;
- +6 SET AQAOSUB=0
- IF '$DATA(AQAOXSN)
- DO SUMDLM2
- QUIT
- +7 FOR
- SET AQAOSUB=$ORDER(^TMP("AQAOPC11",$JOB,AQAOSUB))
- IF AQAOSUB=""
- QUIT
- IF AQAOSTOP=U
- QUIT
- DO SUMDLM2
- +8 QUIT
- +9 ;
- +10 ;
- SUMDLM2 ; >> SUBRTN for each AQAOSUB, print totals
- +1 IF AQAOSUB'=0
- WRITE !!,AQAOSUB,":"
- +2 SET AQAOC=0
- +3 FOR
- SET AQAOC=$ORDER(^TMP("AQAOPC11",$JOB,AQAOSUB,AQAOC))
- IF AQAOC=""
- QUIT
- Begin DoDot:1
- +4 ;criteria number and name
- WRITE !!,"CR",AQAOC,AQAODLM,AQAOCR(AQAOC)
- +5 ;AQAOF is flag for line feed
- SET (AQAOV,AQAOF)=0
- +6 FOR
- SET AQAOV=$ORDER(^TMP("AQAOPC11",$JOB,AQAOSUB,AQAOC,AQAOV))
- IF AQAOV=""
- QUIT
- Begin DoDot:2
- +7 ; ;print totals for each value for each criteria
- +8 IF AQAOF=1
- WRITE !,AQAODLM
- +9 WRITE AQAODLM,"TOTAL '",AQAOV,"':"
- +10 WRITE AQAODLM,$JUSTIFY(^TMP("AQAOPC11",$JOB,AQAOSUB,AQAOC,AQAOV),3),AQAODLM
- +11 WRITE $JUSTIFY((^TMP("AQAOPC11",$JOB,AQAOSUB,AQAOC,AQAOV)/AQAOCNT)*100,2,2),"%"
- +12 SET AQAOF=1
- QUIT
- End DoDot:2
- End DoDot:1
- +13 QUIT
- +14 ;
- +15 ;
- HDG1 ; >> SUBRTN to print second half of heading
- +1 ;indicatr
- SET X=$PIECE(^AQAO(2,AQAOIND,0),U)_": "_$PIECE(^(0),U,2)
- +2 WRITE ?AQAOIOMX-$LENGTH(X)/2,X,!?AQAOIOMX-$LENGTH(AQAORG)/2,AQAORG
- +3 WRITE !,AQAOLINE,!,"Case #",?11,"Occ Date "
- +4 SET X=0
- FOR
- SET X=$ORDER(AQAOCR(X))
- IF X=""
- QUIT
- SET Y=" CR"_X_" "
- SET Y=$EXTRACT(Y,1,8)
- WRITE Y
- +5 QUIT
- +6 ;
- +7 ;
- DLMHDG ; >> SUBRTN to print second half of heading for ASCII format
- +1 WRITE !!!!,"***OCCURRENCE LISTINGS***",!,AQAORG,!
- +2 WRITE !,"Printed by ",AQAODUZ," Printed on "
- SET %H=$HOROLOG
- DO YX^%DTC
- WRITE Y
- +3 WRITE !,"Case #",AQAODLM,"Occ Date "
- +4 SET X=0
- FOR
- SET X=$ORDER(AQAOCR(X))
- IF X=""
- QUIT
- WRITE AQAODLM,"CR",X
- +5 QUIT
- +6 ;
- +7 ;
- HDG2 ; >> SUBRTN to print second half of heading2
- +1 SET X=$PIECE(^AQAO(2,AQAOIND,0),U)_": "_$PIECE(^(0),U,2)_" (SUMMARY PAGE)"
- +2 WRITE ?AQAOIOMX-$LENGTH(X)/2,X,!?AQAOIOMX-$LENGTH(AQAORG)/2,AQAORG,!,AQAOLINE,!
- +3 QUIT