AQAOPR2.m

AQAOPR2 ; IHS/ORDC/LJF - PRINT REVIEW WORKSHEETS ;

 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995

 ;

 ;This rtn contians the user interface to set up the printing of occ

 ;review worksheets.  THe user also gets the choice to include occ

 ;summaries and occ worksheets as well.

 ;

LEVEL ; >>> ask for review level for occurrences

 K DIR S DIR(0)="PO^9002168.7:EMZ"

 S DIR("A")="Select REVIEW STAGE for the worksheets" D ^DIR

 G END:$D(DIRUT),END:Y=-1 S AQAORLEV=Y

 ;

ASK ; >>> ask for occ id or patient name or indicator

 S AQAORVW="" ;flag to allow referred to reviewer to see occ

 K AQAOARR S (X,Y)=0 F  Q:X=""  Q:X=U  Q:Y=-1  D

 .W !! K DIC S DIC="^AQAOC(",DIC(0)="AEMQZ"

 .S DIC("A")="Select OCCURRENCE (ID #, Patient, or Indicator):  "

 .S DIC("S")="D OCCCHK^AQAOSEC I $D(AQAOCHK(""OK""))"

 .D ^DIC Q:X=""  Q:X="^"  Q:Y=-1

 .S AQAOARR($P(Y,U,2))=+Y

 G LEVEL:'$D(AQAOARR)

 ;

SUMM ; >>> print summaries also?

 K DIR S DIR(0)="Y",DIR("B")="NO"

 S DIR("?")="Answer YES to print occurrence summaries as well as worksheets"

 S DIR("A")="Do you wish to also print OCCURRENCE SUMMARIES"

 D ^DIR G END:$D(DIRUT) S AQAOSUM=Y

 ;

WRKS ; >>> print occ worksheets also?

 K DIR S DIR(0)="Y",DIR("B")="NO"

 S DIR("?")="Answer YES to print occurrence worksheets as well as review worksheets"

 S DIR("A")="Do you wish to also print OCCURRENCE WORKSHEETS"

 D ^DIR G END:$D(DIRUT) S AQAOWKS=Y

 ;

DEV ; >>> get print device

 W !! S %ZIS="NQP" D ^%ZIS G END:POP S AQAODEV=ION

 S:$D(IO("S")) AQAOSLV="" I '$D(IO("Q")) G ^AQAOPR21

 K IO("Q") S ZTRTN="^AQAOPR21",ZTDESC="OCC WORKSHEETS"

 F I="AQAORLEV","AQAOARR(","AQAOSUM","AQAODEV","AQAOWKS" S ZTSAVE(I)=""

 D ^%ZTLOAD K ZTSK D ^%ZISC

 ;

END D KILL^AQAOUTIL Q

AQAOPR2   ; IHS/ORDC/LJF - PRINT REVIEW WORKSHEETS ;

 +1       ;;1.01;QAI MANAGEMENT;;OCT 05, 1995

 +2       ;

 +3       ;This rtn contians the user interface to set up the printing of occ

 +4       ;review worksheets.  THe user also gets the choice to include occ

 +5       ;summaries and occ worksheets as well.

 +6       ;

LEVEL     ; >>> ask for review level for occurrences

 +1        KILL DIR

           SET DIR(0)="PO^9002168.7:EMZ"

 +2        SET DIR("A")="Select REVIEW STAGE for the worksheets"

           DO ^DIR

 +3        IF $DATA(DIRUT)

               GOTO END

           IF Y=-1

               GOTO END

           SET AQAORLEV=Y

 +4       ;

ASK       ; >>> ask for occ id or patient name or indicator

 +1       ;flag to allow referred to reviewer to see occ

           SET AQAORVW=""

 +2        KILL AQAOARR

           SET (X,Y)=0

           FOR 

               IF X=""

                   QUIT 

               IF X=U

                   QUIT 

               IF Y=-1

                   QUIT 

               Begin DoDot:1

 +3                WRITE !!

                   KILL DIC

                   SET DIC="^AQAOC("

                   SET DIC(0)="AEMQZ"

 +4                SET DIC("A")="Select OCCURRENCE (ID #, Patient, or Indicator):  "

 +5                SET DIC("S")="D OCCCHK^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 LEVEL

 +9       ;

SUMM      ; >>> print summaries also?

 +1        KILL DIR

           SET DIR(0)="Y"

           SET DIR("B")="NO"

 +2        SET DIR("?")="Answer YES to print occurrence summaries as well as worksheets"

 +3        SET DIR("A")="Do you wish to also print OCCURRENCE SUMMARIES"

 +4        DO ^DIR

           IF $DATA(DIRUT)

               GOTO END

           SET AQAOSUM=Y

 +5       ;

WRKS      ; >>> print occ worksheets also?

 +1        KILL DIR

           SET DIR(0)="Y"

           SET DIR("B")="NO"

 +2        SET DIR("?")="Answer YES to print occurrence worksheets as well as review worksheets"

 +3        SET DIR("A")="Do you wish to also print OCCURRENCE WORKSHEETS"

 +4        DO ^DIR

           IF $DATA(DIRUT)

               GOTO END

           SET AQAOWKS=Y

 +5       ;

DEV       ; >>> get print device

 +1        WRITE !!

           SET %ZIS="NQP"

           DO ^%ZIS

           IF POP

               GOTO END

           SET AQAODEV=ION

 +2        IF $DATA(IO("S"))

               SET AQAOSLV=""

           IF '$DATA(IO("Q"))

               GOTO ^AQAOPR21

 +3        KILL IO("Q")

           SET ZTRTN="^AQAOPR21"

           SET ZTDESC="OCC WORKSHEETS"

 +4        FOR I="AQAORLEV","AQAOARR(","AQAOSUM","AQAODEV","AQAOWKS"

               SET ZTSAVE(I)=""

 +5        DO ^%ZTLOAD

           KILL ZTSK

           DO ^%ZISC

 +6       ;

END        DO KILL^AQAOUTIL

           QUIT