AQAOVAL.m

AQAOVAL ; IHS/ORDC/LJF - CLOSE OUT OCCURRENCES ;

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

 ;

 ;This rtn contains the user interface to close out an occurrence

 ;after all reviews have been performed.  This can be called from

 ;the review process if the user has access and the action was not

 ;a referral.

 ;

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

 G EXIT:$D(AQAOENTR) ;called by ^AQAOENTR

 D ASK^AQAOLKP G EXIT:'$D(AQAOIFN),EXIT:$D(DUOUT),EXIT:$D(DTOUT)

 ;

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

 S DIR("A")="Do you wish to see this occurrence's SUMMARY" D ^DIR

 I Y=1 S X=AQAOIFN D SUM

 ;

FIND ; >> find all reviews for this occurrence

 D FIND^AQAOREV1

 ;

 ;

CLOSE ;ENTRY POINT >>> close out occurrence

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

 S DIR("?",1)="Enter YES if the review process has been completed and"

 S DIR("?",2)="validated for this occurrence.",DIR("?")=" "

 S DIR("A")="Do you wish to CLOSE OUT this Occurrence" D ^DIR

 G EXIT:$D(DIRUT),ASK:Y'=1

 ;

 I '$$ALLREV^AQAOREV D  G EXIT:$D(DIRUT),ASK:Y'=1 ;PATCH 3

 . W !!,*7,"There appears to be some outstanding referrals" ;PATCH 3

 . W ! K DIR S DIR(0)="Y",DIR("B")="NO" ;PATCH 3

 . S DIR("A")="Are you SURE you want to close out this occurrence" ;PATCH 3

 . D ^DIR ;PATCH 3

 L +^AQAGU(0):1

 I '$T W !!,"CANNOT CLOSE; AUDIT FILE LOCKED. TRY AGAIN!",! G ASK

 L +^AQAOC(AQAOIFN):1

 I '$T W !!,"CANNOT CLOSE; ANOTHER USER EDITING OCCURRENCE.",! G ASK

 W !!!?5,"Closing out Occurrence #",AQAOCID,". . . .",!!

 S AQAOUDIT("DA")=AQAOIFN,AQAOUDIT("ACTION")="C"

 S AQAOUDIT("COMMENT")="CLOSE OUT RECORD" D ^AQAOAUD

 K DIE S DIE="^AQAOC(",DA=AQAOIFN

 I '$O(^AQAOC(AQAOIFN,"REV",0)) D  I 1

 .S X=^AQAOC(AQAOIFN,1) K AQAOCLS

 .S AQAOCLS(2)=$P(X,U,3),AQAOCLS(3)=$P(X,U,11),AQAOCLS(4)=$P(X,U,5)

 .S AQAOCLS(6)=$P(X,U,6),AQAOCLS(7)=$P(X,U,7)

 .S DR="[AQAO INITIAL CLOSE]" D ^DIE L -^AQAOC(AQAOIFN)

 E  I $D(AQAORIFN) D  I 1

 .K DIR S DIR(0)="Y"

 .S DIR("A")="Should I use this review as the final say for this occurrence"

 .S DIR("?",1)="Do you wish to use your answers for this review as the"

 .S DIR("?",2)="final ones for this occurrence?"

 .S DIR("?",3)="If you answer YES, I will automatically stuff your"

 .S DIR("?",4)="answers from this review as the final ones."

 .S DIR("?",5)="If you answer NO, I will ask you to answer each"

 .S DIR("?",6)="question for the final say on this occurrence"

 .S DIR("?")=" " D ^DIR

 .I Y=1 D  I 1 ;stuff answers

 ..S X=^AQAOC(AQAOIFN,"REV",AQAORIFN,0) K AQAOCLS

 ..S AQAOCLS(2)=$P(X,U),AQAOCLS(3)=$P(X,U,11),AQAOCLS(4)=$P(X,U,5)

 ..S AQAOCLS(6)=$P(X,U,7),AQAOCLS(7)=$P(X,U,6)

 ..S DR="[AQAO INITIAL CLOSE]" D ^DIE L -^AQAOC(AQAOIFN)

 .E  S DR="[AQAO CLOSE OUT]" D ^DIE L -^AQAOC(AQAOIFN)

 E  S DR="[AQAO CLOSE OUT]" D ^DIE L -^AQAOC(AQAOIFN)

 I '$D(Y) D

 .S AQAOACT=$P(^AQAOC(AQAOIFN,"FINAL"),U,6) ;action

 .I AQAOACT]"",$P(^AQAO(6,AQAOACT,0),U,4)=2 D  ;practitioner action

 ..S AQAOPT=$O(^AQAQX("B","AQAO PROV ACTION",0)) Q:AQAOPT=""

 ..K AQAOP D ^AQAOEDTS ;calls data entry driver

 .I $P(^AQAOC(AQAOIFN,"FINAL"),U,2)>1 D  ;not for non-clin prelim

 ..S AQAOPT=$O(^AQAQX("B","AQAO PROV LEVEL",0)) Q:AQAOPT=""

 ..K AQAOP D ^AQAOEDTS

 .W !! K DIR S DIR(0)="E"

 .S DIR("A")="Occurrence Closed.  Press RETURN to continue" D ^DIR

 ;

 ;

EXIT ; >> eoj

 D KILL^AQAOUTIL G EXIT1:$D(AQAOENTR)

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

 S DIR("A")="Do you wish to CLOSE OUT another occurrence" D ^DIR

 G EXIT1:$D(DIRUT),ASK:Y=1

EXIT1 K DIR,DIC Q

 ;

 ;

SUM ; >> SUBRTN to print occurrence summary

 N AQAOIFN,AQAORVW,AQAOARR,AQAOCID,AQAOPAT,AQAOIND,AQAODATE

 S AQAOIFN=X

 S X=$P(^AQAOC(AQAOIFN,0),U,2),AQAOARR(AQAOIFN)=$P(^DPT(X,0),U)

 S AQAODEV="HOME" D PRINT^AQAOPR3

 Q

AQAOVAL   ; IHS/ORDC/LJF - CLOSE OUT OCCURRENCES ;

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

 +2       ;

 +3       ;This rtn contains the user interface to close out an occurrence

 +4       ;after all reviews have been performed.  This can be called from

 +5       ;the review process if the user has access and the action was not

 +6       ;a referral.

 +7       ;

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

 +1       ;called by ^AQAOENTR

           IF $DATA(AQAOENTR)

               GOTO EXIT

 +2        DO ASK^AQAOLKP

           IF '$DATA(AQAOIFN)

               GOTO EXIT

           IF $DATA(DUOUT)

               GOTO EXIT

           IF $DATA(DTOUT)

               GOTO EXIT

 +3       ;

 +4        WRITE !!

           KILL DIR

           SET DIR(0)="Y"

           SET DIR("B")="NO"

 +5        SET DIR("A")="Do you wish to see this occurrence's SUMMARY"

           DO ^DIR

 +6        IF Y=1

               SET X=AQAOIFN

               DO SUM

 +7       ;

FIND      ; >> find all reviews for this occurrence

 +1        DO FIND^AQAOREV1

 +2       ;

 +3       ;

CLOSE     ;ENTRY POINT >>> close out occurrence

 +1        WRITE !

           KILL DIR

           SET DIR(0)="Y"

           SET DIR("B")="NO"

 +2        SET DIR("?",1)="Enter YES if the review process has been completed and"

 +3        SET DIR("?",2)="validated for this occurrence."

           SET DIR("?")=" "

 +4        SET DIR("A")="Do you wish to CLOSE OUT this Occurrence"

           DO ^DIR

 +5        IF $DATA(DIRUT)

               GOTO EXIT

           IF Y'=1

               GOTO ASK

 +6       ;

 +7       ;PATCH 3

           IF '$$ALLREV^AQAOREV

               Begin DoDot:1

 +8       ;PATCH 3

                   WRITE !!,*7,"There appears to be some outstanding referrals"

 +9       ;PATCH 3

                   WRITE !

                   KILL DIR

                   SET DIR(0)="Y"

                   SET DIR("B")="NO"

 +10      ;PATCH 3

                   SET DIR("A")="Are you SURE you want to close out this occurrence"

 +11      ;PATCH 3

                   DO ^DIR

               End DoDot:1

               IF $DATA(DIRUT)

                   GOTO EXIT

               IF Y'=1

                   GOTO ASK

 +12       LOCK +^AQAGU(0):1

 +13       IF '$TEST

               WRITE !!,"CANNOT CLOSE; AUDIT FILE LOCKED. TRY AGAIN!",!

               GOTO ASK

 +14       LOCK +^AQAOC(AQAOIFN):1

 +15       IF '$TEST

               WRITE !!,"CANNOT CLOSE; ANOTHER USER EDITING OCCURRENCE.",!

               GOTO ASK

 +16       WRITE !!!?5,"Closing out Occurrence #",AQAOCID,". . . .",!!

 +17       SET AQAOUDIT("DA")=AQAOIFN

           SET AQAOUDIT("ACTION")="C"

 +18       SET AQAOUDIT("COMMENT")="CLOSE OUT RECORD"

           DO ^AQAOAUD

 +19       KILL DIE

           SET DIE="^AQAOC("

           SET DA=AQAOIFN

 +20       IF '$ORDER(^AQAOC(AQAOIFN,"REV",0))

               Begin DoDot:1

 +21               SET X=^AQAOC(AQAOIFN,1)

                   KILL AQAOCLS

 +22               SET AQAOCLS(2)=$PIECE(X,U,3)

                   SET AQAOCLS(3)=$PIECE(X,U,11)

                   SET AQAOCLS(4)=$PIECE(X,U,5)

 +23               SET AQAOCLS(6)=$PIECE(X,U,6)

                   SET AQAOCLS(7)=$PIECE(X,U,7)

 +24               SET DR="[AQAO INITIAL CLOSE]"

                   DO ^DIE

                   LOCK -^AQAOC(AQAOIFN)

               End DoDot:1

               IF 1

 +25      IF '$TEST

               IF $DATA(AQAORIFN)

                   Begin DoDot:1

 +26                   KILL DIR

                       SET DIR(0)="Y"

 +27                   SET DIR("A")="Should I use this review as the final say for this occurrence"

 +28                   SET DIR("?",1)="Do you wish to use your answers for this review as the"

 +29                   SET DIR("?",2)="final ones for this occurrence?"

 +30                   SET DIR("?",3)="If you answer YES, I will automatically stuff your"

 +31                   SET DIR("?",4)="answers from this review as the final ones."

 +32                   SET DIR("?",5)="If you answer NO, I will ask you to answer each"

 +33                   SET DIR("?",6)="question for the final say on this occurrence"

 +34                   SET DIR("?")=" "

                       DO ^DIR

 +35      ;stuff answers

                       IF Y=1

                           Begin DoDot:2

 +36                           SET X=^AQAOC(AQAOIFN,"REV",AQAORIFN,0)

                               KILL AQAOCLS

 +37                           SET AQAOCLS(2)=$PIECE(X,U)

                               SET AQAOCLS(3)=$PIECE(X,U,11)

                               SET AQAOCLS(4)=$PIECE(X,U,5)

 +38                           SET AQAOCLS(6)=$PIECE(X,U,7)

                               SET AQAOCLS(7)=$PIECE(X,U,6)

 +39                           SET DR="[AQAO INITIAL CLOSE]"

                               DO ^DIE

                               LOCK -^AQAOC(AQAOIFN)

                           End DoDot:2

                           IF 1

 +40                  IF '$TEST

                           SET DR="[AQAO CLOSE OUT]"

                           DO ^DIE

                           LOCK -^AQAOC(AQAOIFN)

                   End DoDot:1

                   IF 1

 +41      IF '$TEST

               SET DR="[AQAO CLOSE OUT]"

               DO ^DIE

               LOCK -^AQAOC(AQAOIFN)

 +42       IF '$DATA(Y)

               Begin DoDot:1

 +43      ;action

                   SET AQAOACT=$PIECE(^AQAOC(AQAOIFN,"FINAL"),U,6)

 +44      ;practitioner action

                   IF AQAOACT]""

                       IF $PIECE(^AQAO(6,AQAOACT,0),U,4)=2

                           Begin DoDot:2

 +45                           SET AQAOPT=$ORDER(^AQAQX("B","AQAO PROV ACTION",0))

                               IF AQAOPT=""

                                   QUIT 

 +46      ;calls data entry driver

                               KILL AQAOP

                               DO ^AQAOEDTS

                           End DoDot:2

 +47      ;not for non-clin prelim

                   IF $PIECE(^AQAOC(AQAOIFN,"FINAL"),U,2)>1

                       Begin DoDot:2

 +48                       SET AQAOPT=$ORDER(^AQAQX("B","AQAO PROV LEVEL",0))

                           IF AQAOPT=""

                               QUIT 

 +49                       KILL AQAOP

                           DO ^AQAOEDTS

                       End DoDot:2

 +50               WRITE !!

                   KILL DIR

                   SET DIR(0)="E"

 +51               SET DIR("A")="Occurrence Closed.  Press RETURN to continue"

                   DO ^DIR

               End DoDot:1

 +52      ;

 +53      ;

EXIT      ; >> eoj

 +1        DO KILL^AQAOUTIL

           IF $DATA(AQAOENTR)

               GOTO EXIT1

 +2        WRITE !

           KILL DIR

           SET DIR(0)="Y"

           SET DIR("B")="NO"

 +3        SET DIR("A")="Do you wish to CLOSE OUT another occurrence"

           DO ^DIR

 +4        IF $DATA(DIRUT)

               GOTO EXIT1

           IF Y=1

               GOTO ASK

EXIT1      KILL DIR,DIC

           QUIT 

 +1       ;

 +2       ;

SUM       ; >> SUBRTN to print occurrence summary

 +1        NEW AQAOIFN,AQAORVW,AQAOARR,AQAOCID,AQAOPAT,AQAOIND,AQAODATE

 +2        SET AQAOIFN=X

 +3        SET X=$PIECE(^AQAOC(AQAOIFN,0),U,2)

           SET AQAOARR(AQAOIFN)=$PIECE(^DPT(X,0),U)

 +4        SET AQAODEV="HOME"

           DO PRINT^AQAOPR3

 +5        QUIT