Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AQAOPC13

AQAOPC13.m

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