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

AQAOPC7.m

Go to the documentation of this file.
  1. AQAOPC7 ; IHS/ORDC/LJF - OCC BY SINGLE CRITERIA ;
  1. ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
  1. ;
  1. ;This routine contains the code for the user interface for printing
  1. ;a trending report on a single criterion over time.
  1. ;
  1. D SCRIT^AQAOHOP3 ;intro text
  1. TYPE ; >>> ask user what type of report to print
  1. K DIR S DIR(0)="SO^L:LISTING PLUS STATISTICS;S:STATISTICS ONLY"
  1. S DIR("A")="Choose TYPE of report to print"
  1. S DIR("?",1)="Which report style do you want?"
  1. S DIR("?",2)=" Enter L to list occurrences PLUS subtotals"
  1. S DIR("?",3)=" Enter S to print the subtotals ONLY"
  1. S DIR("?")="For more information on these styles, see the User Manual."
  1. D ^DIR G END:$D(DIRUT) S AQAOTYPE=Y
  1. ;
  1. IND ; >>> occurrences for which indicator?
  1. S AQAOIND=$$IND^AQAOLKP G TYPE:AQAOIND=U,TYPE:AQAOIND=-1
  1. S AQAOIND=+AQAOIND
  1. ;
  1. CRIT ; >>> check criteria defined for this indicator
  1. I '$D(^AQAO1(6,"C",AQAOIND)) D G END
  1. .W !!,*7,"NO Criteria for this Indicator",!
  1. S (X,AQAOCNT)=0 K AQAOCR,AQAOIOMX ;init count; kill array & iom var
  1. F S X=$O(^AQAO1(6,"C",AQAOIND,X)) Q:X="" D
  1. .Q:'$D(^AQAO1(6,X,0)) S AQAOCR(X)=$P(^(0),U) ;set array w/crit name
  1. .S AQAOCNT=AQAOCNT+1 ;increment count
  1. ;
  1. W !!,"There are ",AQAOCNT," criteria defined for this indicator."
  1. W !,"Please choose one from the list for this report."
  1. W !! K DIR S DIR(0)="N^1:"_AQAOCNT,(Y,X)=0
  1. F S X=$O(AQAOCR(X)) Q:X="" D
  1. .S Y=Y+1,DIR("A",Y)=Y_". "_AQAOCR(X),AQAOAR(X)=Y
  1. S DIR("A")="Choose the CRITERION for this report" D ^DIR
  1. G END:$D(DIRUT)
  1. ; >> kill off items not selected
  1. F I=1:1 S X=$P(Y,",",I) Q:X="" S Y(X)=""
  1. S X=0 F S X=$O(AQAOCR(X)) Q:X="" I '$D(Y(AQAOAR(X))) K AQAOCR(X)
  1. K Y,AQAOAR
  1. ;
  1. BDATE ; >>> ask for beginning date
  1. W !! K DIR S DIR(0)="DO^::E",DIR("A")="Select FIRST MONTH/YEAR"
  1. D ^DIR I Y>DT W *7," NO FUTURE DATES" G BDATE
  1. G IND:X="",END:$D(DIRUT),BDATE:Y=-1
  1. I $E(Y,6,7)'="00" W *7," MUST BE MONTH AND YEAR ONLY!!" G BDATE
  1. I $E(Y,4,5)="00" W *7," MUST INCLUDE MONTH!!" G BDATE
  1. S AQAOBD=Y
  1. ;
  1. EDATE ; >>> choose ending occurrence date for report
  1. W ! K DIR S DIR(0)="DO^::E",DIR("A")="Select LAST MONTH/YEAR"
  1. D ^DIR I Y>DT W *7," NO FUTURE DATES" G EDATE
  1. I Y<AQAOBD W *7," ENDING DATE MUST BE AFTER BEGINNING DATE" G BDATE
  1. G BDATE:X="",END:$D(DIRUT),EDATE:Y=-1
  1. I $E(Y,6,7)'="00" W *7," MUST BE MONTH AND YEAR ONLY!!" G BDATE
  1. I $E(Y,4,5)="00" W *7," MUST INCLUDE MONTH!!" G EDATE
  1. S AQAOED=Y+31,X2=AQAOBD+1,X1=AQAOED D ^%DTC
  1. I X>366 D G BDATE
  1. .W *7,!," CANNOT PRINT REPORT FOR MORE THAN 1 YEAR!",! K AQAOBD,AQAOED
  1. S Y=AQAOBD+700 I $E(Y,4,5)>12 S Y=Y-1200+10000
  1. I AQAOED'<Y D
  1. .W !!,*7,"You've selected more than 7 months;"
  1. .W " use CONDENSED print OR WIDE paper!"
  1. ;
  1. ;
  1. DEV ; >>> get print device
  1. I $P(AQAOUA("USER"),U,7)=1 D EXPORT^AQAOUTIL G BDATE:Y=U
  1. W !!
  1. I $D(AQAOIOMX) W *7,"REMEMBER to use CONDENSED PRINT or WIDE PAPER!",!!
  1. S %ZIS="QP" D ^%ZIS G END:POP
  1. I '$D(IO("Q")) U IO G ^AQAOPC71
  1. K IO("Q") S ZTRTN="^AQAOPC71",ZTDESC="OCC BY IND & CRIT"
  1. F I="AQAOTYPE","AQAOIND","AQAOCR(","AQAOBD","AQAOED" S ZTSAVE(I)=""
  1. S:$D(AQAODLM) ZTSAVE("AQAODLM")=""
  1. S:$D(AQAOIOMX) ZTSAVE("AQAOIOMX")=""
  1. S:$D(AQAOXSN) ZTSAVE("AQAOXSN")="",ZTSAVE("AQAOXSM")=""
  1. S:$D(AQAOXS) ZTSAVE("AQAOXS(")=""
  1. D ^%ZTLOAD K ZTSK D ^%ZISC
  1. ;
  1. END ; >>> eoj
  1. D HOME^%ZIS D KILL^AQAOUTIL Q