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
