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
