AQAOPA3.m

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