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
