AQAOPC43 ; IHS/ORDC/LJF - OCC WITH FINDINGS/ACTIONS ;
;;1.01;QAI MANAGEMENT;;OCT 05, 1995
;
;This rtn contains an entry point called by ^AQAOPC42 to print the
;summary page for the trending report with findings and actions.
;
SUMMARY ;ENTRY POINT called by ^AQAOPC42 >>> print summary page(s)
I $D(AQAODLM) D SUMDLM Q
D NEWPG^AQAOUTIL Q:AQAOSTOP=U D HDG2
S X=^AQAO(2,AQAOIND,0) W !!,$P(X,U),?10,$P(X,U,2) ;ind # and name
I $P(X,U,5)]"" W ?55,"THRESHOLD/TRIGGER: ",$P(X,U,5),"%"
W !,"TOTAL OCCURRENCES FOR DATE RANGE: ",AQAOCNT
W !," DENOMINATOR: ______"
W " SOURCE: _____________________________"
;
F I="F","A" D
.W !!,"Subtotals by ",$S(I="F":"FINDING",1:"ACTION"),": "
.S AQAOSUB=0 I '$D(AQAOXSN) D SUM1 Q
.F S AQAOSUB=$O(^TMP("AQAO",$J,I,AQAOSUB)) Q:AQAOSUB="" D
..W !!,AQAOSUB,":",! D SUM1
Q
;
SUM1 ; >> SUBRTN to print counts for each primary sort item
S AQAOX=0 F S AQAOX=$O(^TMP("AQAO",$J,I,AQAOSUB,AQAOX)) Q:AQAOX="" Q:AQAOSTOP=U D
.W ?26,AQAOX,?70,^TMP("AQAO",$J,I,AQAOSUB,AQAOX),! ;print counts
.I $Y>(IOSL-4) D NEWPG^AQAOUTIL Q:AQAOSTOP=U D HDG2
Q
;
;
HDG2 ; >> SUBRTN for second half of heading2
W ?33,"(SUMMARY PAGE)",!?30,AQAORG,!,AQAOLINE,!
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,AQAOCNT
W AQAODLM,"DENOMINATOR: ______",AQAODLM,"SOURCE: ___________________"
;
F I="F","A" D
.W !!,"Subtotals by ",$S(I="F":"FINDING",1:"ACTION")
.S AQAOSUB=0 I '$D(AQAOXSN) D SUMDLM1 Q
.F S AQAOSUB=$O(^TMP("AQAO",$J,I,AQAOSUB)) Q:AQAOSUB="" D
..W !!,AQAOSUB,";" D SUMDLM1
Q
;
SUMDLM1 ; >> SUBRTN to print totals by primary sort (DLM format)
S AQAOX=0 F S AQAOX=$O(^TMP("AQAO",$J,I,AQAOSUB,AQAOX)) Q:AQAOX="" D
.W AQAODLM,AQAOX,AQAODLM,^TMP("AQAO",$J,I,AQAOSUB,AQAOX),! ;prt counts
Q
;
;
DLMHDG ; >> SUBRTN for ASCII heading for listing portion
W !!!!,"***OCCURRENCE LISTINGS WITH FINDINGS & ACTIONS***",!,AQAORG,!
W !,"Printed by ",AQAODUZ," Printed on " S %H=$H D YX^%DTC W Y
F I="Case #","Occ Date","Age","Sex","Status","Stage","Finding","Action" W I,AQAODLM
Q
AQAOPC43 ; IHS/ORDC/LJF - OCC WITH FINDINGS/ACTIONS ;
+1 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
+2 ;
+3 ;This rtn contains an entry point called by ^AQAOPC42 to print the
+4 ;summary page for the trending report with findings and actions.
+5 ;
SUMMARY ;ENTRY POINT called by ^AQAOPC42 >>> print summary page(s)
+1 IF $DATA(AQAODLM)
DO SUMDLM
QUIT
+2 DO NEWPG^AQAOUTIL
IF AQAOSTOP=U
QUIT
DO HDG2
+3 ;ind # and name
SET X=^AQAO(2,AQAOIND,0)
WRITE !!,$PIECE(X,U),?10,$PIECE(X,U,2)
+4 IF $PIECE(X,U,5)]""
WRITE ?55,"THRESHOLD/TRIGGER: ",$PIECE(X,U,5),"%"
+5 WRITE !,"TOTAL OCCURRENCES FOR DATE RANGE: ",AQAOCNT
+6 WRITE !," DENOMINATOR: ______"
+7 WRITE " SOURCE: _____________________________"
+8 ;
+9 FOR I="F","A"
Begin DoDot:1
+10 WRITE !!,"Subtotals by ",$SELECT(I="F":"FINDING",1:"ACTION"),": "
+11 SET AQAOSUB=0
IF '$DATA(AQAOXSN)
DO SUM1
QUIT
+12 FOR
SET AQAOSUB=$ORDER(^TMP("AQAO",$JOB,I,AQAOSUB))
IF AQAOSUB=""
QUIT
Begin DoDot:2
+13 WRITE !!,AQAOSUB,":",!
DO SUM1
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
SUM1 ; >> SUBRTN to print counts for each primary sort item
+1 SET AQAOX=0
FOR
SET AQAOX=$ORDER(^TMP("AQAO",$JOB,I,AQAOSUB,AQAOX))
IF AQAOX=""
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:1
+2 ;print counts
WRITE ?26,AQAOX,?70,^TMP("AQAO",$JOB,I,AQAOSUB,AQAOX),!
+3 IF $Y>(IOSL-4)
DO NEWPG^AQAOUTIL
IF AQAOSTOP=U
QUIT
DO HDG2
End DoDot:1
+4 QUIT
+5 ;
+6 ;
HDG2 ; >> SUBRTN for second half of heading2
+1 WRITE ?33,"(SUMMARY PAGE)",!?30,AQAORG,!,AQAOLINE,!
+2 QUIT
+3 ;
+4 ;
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,AQAOCNT
+5 WRITE AQAODLM,"DENOMINATOR: ______",AQAODLM,"SOURCE: ___________________"
+6 ;
+7 FOR I="F","A"
Begin DoDot:1
+8 WRITE !!,"Subtotals by ",$SELECT(I="F":"FINDING",1:"ACTION")
+9 SET AQAOSUB=0
IF '$DATA(AQAOXSN)
DO SUMDLM1
QUIT
+10 FOR
SET AQAOSUB=$ORDER(^TMP("AQAO",$JOB,I,AQAOSUB))
IF AQAOSUB=""
QUIT
Begin DoDot:2
+11 WRITE !!,AQAOSUB,";"
DO SUMDLM1
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
SUMDLM1 ; >> SUBRTN to print totals by primary sort (DLM format)
+1 SET AQAOX=0
FOR
SET AQAOX=$ORDER(^TMP("AQAO",$JOB,I,AQAOSUB,AQAOX))
IF AQAOX=""
QUIT
Begin DoDot:1
+2 ;prt counts
WRITE AQAODLM,AQAOX,AQAODLM,^TMP("AQAO",$JOB,I,AQAOSUB,AQAOX),!
End DoDot:1
+3 QUIT
+4 ;
+5 ;
DLMHDG ; >> SUBRTN for ASCII heading for listing portion
+1 WRITE !!!!,"***OCCURRENCE LISTINGS WITH FINDINGS & ACTIONS***",!,AQAORG,!
+2 WRITE !,"Printed by ",AQAODUZ," Printed on "
SET %H=$HOROLOG
DO YX^%DTC
WRITE Y
+3 FOR I="Case #","Occ Date","Age","Sex","Status","Stage","Finding","Action"
WRITE I,AQAODLM
+4 QUIT
