AQAOPR3.m

AQAOPR3 ; IHS/ORDC/LJF - PRINT SUMMARIES ;

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

 ;

 ;This is the main driver for printing occ summaries.  It contains the

 ;user interface and the DIP calls.  This report occurs on 2 menus.

 ;

CLOSED ; >>> ask if user wants to select closed or deleted occ

 W !! K DIR S DIR(0)="YO",DIR("B")="NO"

 S DIR("A")="Would you like to see any CLOSED or DELETED Occurrences"

 D ^DIR G END:$D(DIRUT) I Y=1 S AQAOINAC=""

 ;

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")="OCCURRENCE (ID #, Patient, or Indicator):  "

 .S DIC("A")=$S('$D(AQAOARR):"Select ",1:"Select Another ")_DIC("A")

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

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

 .S AQAONAM=$P($G(^DPT($P(^AQAOC(+Y,0),U,2),0)),U)

 .S AQAOARR(+Y)=AQAONAM

 G END:'$D(AQAOARR)

 ;

 ;

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 PRINT

 K IO("Q") S ZTRTN="PRINT^AQAOPR3",ZTDESC="OCC SUMMARIES"

 S ZTSAVE("AQAOARR(")="",ZTSAVE("AQAODEV")=""

 D ^%ZTLOAD K ZTSK D ^%ZISC G END

 ;

 ;

PRINT ;ENTRY POINT >>> print each summary by looping through occurrences

 ;called by AQAOREV to print summary during review process

 S AQAOIFN=0,Y=""

 F  S AQAOIFN=$O(AQAOARR(AQAOIFN)) Q:AQAOIFN=""  Q:$G(Y)=0  D

 .S AQAONAM=AQAOARR(AQAOIFN) Q:AQAONAM=""

 .S L=0,DIC="^AQAOC(",FLDS="[AQAO LONG DISPLAY-E1]"

 .S BY="@NUMBER",(TO,FR)=AQAOIFN,IOP=AQAODEV

 .I $D(ZTQUEUED) S IOP="Q;"_AQAODEV,DQTIME="NOW"

 .D EN1^DIP K IOP ;display occurrence

 .I '$D(ZTQUEUED),'$D(AQAOSLV) D PRTOPT^AQAOVAR

 ;

 ;

END ; >>> eoj

 D KILL^AQAOUTIL K AQAOINAC Q

AQAOPR3   ; IHS/ORDC/LJF - PRINT SUMMARIES ;

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

 +2       ;

 +3       ;This is the main driver for printing occ summaries.  It contains the

 +4       ;user interface and the DIP calls.  This report occurs on 2 menus.

 +5       ;

CLOSED    ; >>> ask if user wants to select closed or deleted occ

 +1        WRITE !!

           KILL DIR

           SET DIR(0)="YO"

           SET DIR("B")="NO"

 +2        SET DIR("A")="Would you like to see any CLOSED or DELETED Occurrences"

 +3        DO ^DIR

           IF $DATA(DIRUT)

               GOTO END

           IF Y=1

               SET AQAOINAC=""

 +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")="OCCURRENCE (ID #, Patient, or Indicator):  "

 +5                SET DIC("A")=$SELECT('$DATA(AQAOARR):"Select ",1:"Select Another ")_DIC("A")

 +6                SET DIC("S")="D OCCCHK^AQAOSEC I $D(AQAOCHK(""OK""))"

 +7                DO ^DIC

                   IF X=""

                       QUIT 

                   IF X="^"

                       QUIT 

                   IF Y=-1

                       QUIT 

 +8                SET AQAONAM=$PIECE($GET(^DPT($PIECE(^AQAOC(+Y,0),U,2),0)),U)

 +9                SET AQAOARR(+Y)=AQAONAM

               End DoDot:1

 +10       IF '$DATA(AQAOARR)

               GOTO END

 +11      ;

 +12      ;

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 PRINT

 +3        KILL IO("Q")

           SET ZTRTN="PRINT^AQAOPR3"

           SET ZTDESC="OCC SUMMARIES"

 +4        SET ZTSAVE("AQAOARR(")=""

           SET ZTSAVE("AQAODEV")=""

 +5        DO ^%ZTLOAD

           KILL ZTSK

           DO ^%ZISC

           GOTO END

 +6       ;

 +7       ;

PRINT     ;ENTRY POINT >>> print each summary by looping through occurrences

 +1       ;called by AQAOREV to print summary during review process

 +2        SET AQAOIFN=0

           SET Y=""

 +3        FOR 

               SET AQAOIFN=$ORDER(AQAOARR(AQAOIFN))

               IF AQAOIFN=""

                   QUIT 

               IF $GET(Y)=0

                   QUIT 

               Begin DoDot:1

 +4                SET AQAONAM=AQAOARR(AQAOIFN)

                   IF AQAONAM=""

                       QUIT 

 +5                SET L=0

                   SET DIC="^AQAOC("

                   SET FLDS="[AQAO LONG DISPLAY-E1]"

 +6                SET BY="@NUMBER"

                   SET (TO,FR)=AQAOIFN

                   SET IOP=AQAODEV

 +7                IF $DATA(ZTQUEUED)

                       SET IOP="Q;"_AQAODEV

                       SET DQTIME="NOW"

 +8       ;display occurrence

                   DO EN1^DIP

                   KILL IOP

 +9                IF '$DATA(ZTQUEUED)

                       IF '$DATA(AQAOSLV)

                           DO PRTOPT^AQAOVAR

               End DoDot:1

 +10      ;

 +11      ;

END       ; >>> eoj

 +1        DO KILL^AQAOUTIL

           KILL AQAOINAC

           QUIT