- 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
