- AQAOPA3 ; IHS/ORDC/LJF - PRINT ACTION EVAL WORKSHEETS ;
- ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
- ;
- ;This rtn includes the user interface and call to DIP to print
- ;evaluation worksheets for actions due for review.
- ;
- ASK ; >>> ask for action plans by number or category
- K AQAOARR S (X,Y)=0 F Q:X="" Q:X=U Q:Y=-1 D
- .W !! K DIC S DIC="^AQAO(5,",DIC(0)="AEMQZ"
- .S DIC("A")="ACTION PLAN (ID # or Category): "
- .S DIC("A")=$S('$D(AQAOARR):"Select ",1:"Select Another ")_DIC("A")
- .S DIC("S")="I $P(^AQAO(5,Y,0),U,6)="""" D ACTCHK^AQAOSEC I $D(AQAOCHK(""OK""))"
- .D ^DIC Q:X="" Q:X="^" Q:Y=-1
- .S AQAOARR($P(Y,U,2))=+Y
- G END:'$D(AQAOARR)
- ;
- ;
- DEV ; >>> get print device
- W !! S %ZIS="QP" D ^%ZIS G END:POP S AQAODEV=ION
- I '$D(IO("Q")) G PRINT
- K IO("Q") S ZTRTN="PRINT^AQAOPA3",ZTDESC="ACTION EVAL SHEETS"
- S ZTSAVE("AQAOARR(")="",ZTSAVE("AQAODEV")=""
- D ^%ZTLOAD K ZTSK D ^%ZISC G END
- ;
- ;
- PRINT ; >>> print each worksheet on separate page
- S AQAONUM=0
- F S AQAONUM=$O(AQAOARR(AQAONUM)) Q:AQAONUM="" D
- .S AQAOPN=AQAOARR(AQAONUM) Q:AQAOPN=""
- .W !,AQAONUM,?20,AQAOPN
- .S L="",DIC="^AQAO(5,",FLDS="[AQAO EVAL WORKSHEET]"
- .S BY="@NUMBER",(TO,FR)=AQAOPN,IOP=AQAODEV
- .I $D(ZTQUEUED) S IOP="Q;"_AQAODEV,DQTIME="NOW"
- .D EN1^DIP K IOP ;display action plan
- .I '$D(ZTQUEUED),(IOST["C-") D
- ..K DIR S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR
- ;
- ;
- END ; >>> eoj
- D ^%ZISC D KILL^AQAOUTIL Q
- AQAOPA3 ; IHS/ORDC/LJF - PRINT ACTION EVAL WORKSHEETS ;
- +1 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
- +2 ;
- +3 ;This rtn includes the user interface and call to DIP to print
- +4 ;evaluation worksheets for actions due for review.
- +5 ;
- ASK ; >>> ask for action plans by number or category
- +1 KILL AQAOARR
- SET (X,Y)=0
- FOR
- IF X=""
- QUIT
- IF X=U
- QUIT
- IF Y=-1
- QUIT
- Begin DoDot:1
- +2 WRITE !!
- KILL DIC
- SET DIC="^AQAO(5,"
- SET DIC(0)="AEMQZ"
- +3 SET DIC("A")="ACTION PLAN (ID # or Category): "
- +4 SET DIC("A")=$SELECT('$DATA(AQAOARR):"Select ",1:"Select Another ")_DIC("A")
- +5 SET DIC("S")="I $P(^AQAO(5,Y,0),U,6)="""" D ACTCHK^AQAOSEC I $D(AQAOCHK(""OK""))"
- +6 DO ^DIC
- IF X=""
- QUIT
- IF X="^"
- QUIT
- IF Y=-1
- QUIT
- +7 SET AQAOARR($PIECE(Y,U,2))=+Y
- End DoDot:1
- +8 IF '$DATA(AQAOARR)
- GOTO END
- +9 ;
- +10 ;
- DEV ; >>> get print device
- +1 WRITE !!
- SET %ZIS="QP"
- DO ^%ZIS
- IF POP
- GOTO END
- SET AQAODEV=ION
- +2 IF '$DATA(IO("Q"))
- GOTO PRINT
- +3 KILL IO("Q")
- SET ZTRTN="PRINT^AQAOPA3"
- SET ZTDESC="ACTION EVAL SHEETS"
- +4 SET ZTSAVE("AQAOARR(")=""
- SET ZTSAVE("AQAODEV")=""
- +5 DO ^%ZTLOAD
- KILL ZTSK
- DO ^%ZISC
- GOTO END
- +6 ;
- +7 ;
- PRINT ; >>> print each worksheet on separate page
- +1 SET AQAONUM=0
- +2 FOR
- SET AQAONUM=$ORDER(AQAOARR(AQAONUM))
- IF AQAONUM=""
- QUIT
- Begin DoDot:1
- +3 SET AQAOPN=AQAOARR(AQAONUM)
- IF AQAOPN=""
- QUIT
- +4 WRITE !,AQAONUM,?20,AQAOPN
- +5 SET L=""
- SET DIC="^AQAO(5,"
- SET FLDS="[AQAO EVAL WORKSHEET]"
- +6 SET BY="@NUMBER"
- SET (TO,FR)=AQAOPN
- SET IOP=AQAODEV
- +7 IF $DATA(ZTQUEUED)
- SET IOP="Q;"_AQAODEV
- SET DQTIME="NOW"
- +8 ;display action plan
- DO EN1^DIP
- KILL IOP
- +9 IF '$DATA(ZTQUEUED)
- IF (IOST["C-")
- Begin DoDot:2
- +10 KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press RETURN to continue"
- DO ^DIR
- End DoDot:2
- End DoDot:1
- +11 ;
- +12 ;
- END ; >>> eoj
- +1 DO ^%ZISC
- DO KILL^AQAOUTIL
- QUIT
