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