- AQAOPC5 ; IHS/ORDC/LJF - QTR PROGRESS REPORT ;
- ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
- ;
- ;This rtn contains user interface code for setting up Quarterly
- ;Progress Report. User is asked for type of report, date range,
- ;and device. Type of report question calls extrinsic functions in
- ;rtns ^AQAOPU*.
- ;
- TYPE ; >> ask user what type of report to print
- K ^TMP("AQAOPC5",$J) W !! K DIR
- S DIR(0)="SO^1:ONE INDICATOR;2:BY KEY FUNCTION;3:FACILITY REPORT"
- S DIR("A")="Select TYPE OF REPORT to print"
- S DIR("?")="Choose ONE from the list by number"
- D ^DIR G EXIT:$D(DIRUT),TYPE:Y=-1
- S X="AQAOPC5"
- S AQAOTYP=$S(Y=1:$$IND^AQAOPU(X),Y=2:$$KF^AQAOPU(X),1:$$FACR^AQAOPU1(X))
- K ^TMP("AQAOPC5",$J,2) ;ind you don't have access to
- G TYPE:AQAOTYP=U
- ;
- ;
- 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 TYPE:X="",EXIT:$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="",EXIT:$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 EDATE:Y=U
- W !! S %ZIS="QP" D ^%ZIS G EXIT:POP
- I '$D(IO("Q")) U IO G ^AQAOPC51
- K IO("Q") S ZTRTN="^AQAOPC51",ZTDESC="CLOSED OCC REPORT"
- F I="AQAOTYP","^TMP(""AQAOPC5"",$J,","AQAOBD","AQAOED" S ZTSAVE(I)=""
- S:$D(AQAORPTT) ZTSAVE("AQAORPTT")=""
- I $D(AQAODLM) S ZTSAVE("AQAODLM")=""
- D ^%ZTLOAD D HOME^%ZIS D KILL^AQAOUTIL Q
- ;
- ;
- EXIT ; >>> early eoj
- D KILL^AQAOUTIL K ^TMP("AQAOPC5",$J) Q
- AQAOPC5 ; IHS/ORDC/LJF - QTR PROGRESS REPORT ;
- +1 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
- +2 ;
- +3 ;This rtn contains user interface code for setting up Quarterly
- +4 ;Progress Report. User is asked for type of report, date range,
- +5 ;and device. Type of report question calls extrinsic functions in
- +6 ;rtns ^AQAOPU*.
- +7 ;
- TYPE ; >> ask user what type of report to print
- +1 KILL ^TMP("AQAOPC5",$JOB)
- WRITE !!
- KILL DIR
- +2 SET DIR(0)="SO^1:ONE INDICATOR;2:BY KEY FUNCTION;3:FACILITY REPORT"
- +3 SET DIR("A")="Select TYPE OF REPORT to print"
- +4 SET DIR("?")="Choose ONE from the list by number"
- +5 DO ^DIR
- IF $DATA(DIRUT)
- GOTO EXIT
- IF Y=-1
- GOTO TYPE
- +6 SET X="AQAOPC5"
- +7 SET AQAOTYP=$SELECT(Y=1:$$IND^AQAOPU(X),Y=2:$$KF^AQAOPU(X),1:$$FACR^AQAOPU1(X))
- +8 ;ind you don't have access to
- KILL ^TMP("AQAOPC5",$JOB,2)
- +9 IF AQAOTYP=U
- GOTO TYPE
- +10 ;
- +11 ;
- 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 TYPE
- IF $DATA(DIRUT)
- GOTO EXIT
- 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 EXIT
- 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 EDATE
- +2 WRITE !!
- SET %ZIS="QP"
- DO ^%ZIS
- IF POP
- GOTO EXIT
- +3 IF '$DATA(IO("Q"))
- USE IO
- GOTO ^AQAOPC51
- +4 KILL IO("Q")
- SET ZTRTN="^AQAOPC51"
- SET ZTDESC="CLOSED OCC REPORT"
- +5 FOR I="AQAOTYP","^TMP(""AQAOPC5"",$J,","AQAOBD","AQAOED"
- SET ZTSAVE(I)=""
- +6 IF $DATA(AQAORPTT)
- SET ZTSAVE("AQAORPTT")=""
- +7 IF $DATA(AQAODLM)
- SET ZTSAVE("AQAODLM")=""
- +8 DO ^%ZTLOAD
- DO HOME^%ZIS
- DO KILL^AQAOUTIL
- QUIT
- +9 ;
- +10 ;
- EXIT ; >>> early eoj
- +1 DO KILL^AQAOUTIL
- KILL ^TMP("AQAOPC5",$JOB)
- QUIT