AQAOREV ; IHS/ORDC/LJF - ENTER OCCURRENCE REVIEWS ;
;;1.01;QAI MANAGEMENT;;OCT 05, 1995
;
;This rtn contains the user interface to enter occurrence reviews.
;
ASK ; >> ask for occ id
I $D(AQAOIFN) L -^AQAOC(AQAOIFN) ;unlock last occ reviewed
S AQAORVW="" ;flag:allow referred to reviewer to see occ
D INTRO^AQAOHREV ;intro text
K AQAOIFN ;start out clean, no occ variable
;
D ASK^AQAOLKP G EXIT:'$D(AQAOIFN),EXIT:$D(DUOUT),EXIT:$D(DTOUT)
;
START ; >> lock entry, display summary, display reviews
L +^AQAOC(AQAOIFN):1 I '$T D G ASK
.W !!,"CANNOT EDIT; ANOTHER USER IS EDITING THIS OCCURRENCE.",!
;
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^AQAOREV1
;
D FIND^AQAOREV1 G ASK:AQAOSTOP=U ;find and display all reviews
;
CHOOSE ; >> choose review entry to add or edit
I AQAONUM=0 D ADD G:'$D(AQAORIFN) ASK G EDIT ;if none, try add
K DIR S DIR(0)="NO^1:"_(AQAONUM+1),DIR("A")="Choose ONE from list"
S DIR("A",1)=(AQAONUM+1)_". ADD a NEW REVIEW Entry"
D ^DIR G EXIT:$D(DIRUT)
I Y=(AQAONUM+1) D G:'$D(AQAORIFN) ASK I 1 ;chose to add new entry
.K AQAO,AQAORIFN D ADD
E S AQAORIFN=$P(AQAO(+Y),U) ;chose to edit an entry
;
EDIT ; edit review
L +^AQAGU(0):1 I '$T D G EXIT
.W !!,"CANNOT ENTER REVIEW; AUDIT FILE LOCKED. TRY AGAIN.",!
S AQAOUDIT("DA")=AQAOIFN,AQAOUDIT("ACTION")="E"
S AQAOUDIT("REV")=AQAORIFN
S AQAOUDIT("COMMENT")="EDIT OCCURRENCE REVIEW" D ^AQAOAUD
;
K DIE,DIR S DIE="^AQAOC("_AQAOIFN_",""REV"",",DA(1)=AQAOIFN,DA=AQAORIFN
S DR=".01;S AQAORLX=X;.02;.04;I AQAORLX=1 S Y=""@1"";.011;.06;@1;.05;.07;S:$P(^AQAO(6,$P(^AQAOC(AQAOIFN,""REV"",AQAORIFN,0),U,7),0),U,4)'=1 Y=""@2"";.09;2;@2;1"
D ^DIE
;
S AQAOACT=$P($G(^AQAOC(AQAOIFN,"REV",AQAORIFN,0)),U,7) ;action;PATCH 1
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 ;call data entry driver
E D ;update prov list;PATCH 3
.S AQAOPT=$O(^AQAQX("B","AQAO PROV LEVEL",0)) Q:AQAOPT="" ;PATCH 3
.K AQAOP D ^AQAOEDTS ;PATCH 3
;
I $D(^XUSEC("AQAOZVAL",DUZ)),$P($G(^AQAO(6,+AQAOACT,0)),U,4)'=1,'$O(^AQAOC(AQAOIFN,"REV",AQAORIFN)),$$ALLREV D ;PATCH 3
.S AQAOENTR="" D CLOSE^AQAOVAL K AQAOENTR ;close out occ
;
D PRTOPT^AQAOVAR G ASK
;
EXIT ; >> eoj
I $D(AQAOIFN) L -^AQAOC(AQAOIFN)
D KILL^AQAOUTIL Q
;
ADD ; SUBRTN to add new review to occ
L +^AQAGU(0):1 I '$T D Q
.W !!,"CANNOT ADD NEW REVIEW; AUDIT FILE LOCKED. TRY AGAIN.",!
W !!,"(To add a review for a stage already used, enter in quotes, i.e. ""PEER"".)"
I '$D(^AQAOC(AQAOIFN,"REV",0)) S ^AQAOC(AQAOIFN,"REV",0)="^9002167.01P^^"
K DIC S DIC="^AQAOC("_AQAOIFN_",""REV"",",DA(1)=AQAOIFN
S DIC(0)="AEMZQL" D ^DIC I +Y>0 S AQAORIFN=+Y
Q:'$D(AQAORIFN) S AQAOUDIT("DA")=AQAOIFN,AQAOUDIT("ACTION")="E"
S AQAOUDIT("COMMENT")="ADD OCCURRENCE REVIEW",AQAOUDIT("REV")=AQAORIFN
D ^AQAOAUD
Q
;
;
ALLREV() ;EP; -- SUBRTN to return whether referrals covered by reviews;PATCH 3
Q $S($$REFCNT>$$REVCNT:0,1:1)
;
REFCNT() ; -- SUBRTN to return # of referrals;PATCH 3
NEW AQAORF,X,Y S AQAORF=0
;
; -- initial review was referral?
I $P($G(^AQAOC(AQAOIFN,1)),U,9)]"" S AQAORF=AQAORF+1
; -- any additional referrals on initial review?
S X=0
F S X=$O(^AQAOC(AQAOIFN,"IADDRV",X)) Q:X'=+X S AQAORF=AQAORF+1
;
; -- count referrals on other reviews
S X=0 F S X=$O(^AQAOC(AQAOIFN,"REV",X)) Q:X'=+X D
. I $P($G(^AQAOC(AQAOIFN,"REV",X,0)),U,9)]"" S AQAORF=AQAORF+1
. S Y=0
. F S Y=$O(^AQAOC(AQAOIFN,"REV",X,"ADDRV",Y)) Q:Y'=+Y D
.. S AQAORF=AQAORF+1
;
Q AQAORF
;
REVCNT() ; -- SUBRTN to return # of reviews;PATCH 3
NEW AQAORV,X S AQAORV=0
S X=0 F S X=$O(^AQAOC(AQAOIFN,"REV",X)) Q:X'=+X S AQAORV=AQAORV+1
Q AQAORV
AQAOREV ; IHS/ORDC/LJF - ENTER OCCURRENCE REVIEWS ;
+1 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
+2 ;
+3 ;This rtn contains the user interface to enter occurrence reviews.
+4 ;
ASK ; >> ask for occ id
+1 ;unlock last occ reviewed
IF $DATA(AQAOIFN)
LOCK -^AQAOC(AQAOIFN)
+2 ;flag:allow referred to reviewer to see occ
SET AQAORVW=""
+3 ;intro text
DO INTRO^AQAOHREV
+4 ;start out clean, no occ variable
KILL AQAOIFN
+5 ;
+6 DO ASK^AQAOLKP
IF '$DATA(AQAOIFN)
GOTO EXIT
IF $DATA(DUOUT)
GOTO EXIT
IF $DATA(DTOUT)
GOTO EXIT
+7 ;
START ; >> lock entry, display summary, display reviews
+1 LOCK +^AQAOC(AQAOIFN):1
IF '$TEST
Begin DoDot:1
+2 WRITE !!,"CANNOT EDIT; ANOTHER USER IS EDITING THIS OCCURRENCE.",!
End DoDot:1
GOTO ASK
+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^AQAOREV1
+7 ;
+8 ;find and display all reviews
DO FIND^AQAOREV1
IF AQAOSTOP=U
GOTO ASK
+9 ;
CHOOSE ; >> choose review entry to add or edit
+1 ;if none, try add
IF AQAONUM=0
DO ADD
IF '$DATA(AQAORIFN)
GOTO ASK
GOTO EDIT
+2 KILL DIR
SET DIR(0)="NO^1:"_(AQAONUM+1)
SET DIR("A")="Choose ONE from list"
+3 SET DIR("A",1)=(AQAONUM+1)_". ADD a NEW REVIEW Entry"
+4 DO ^DIR
IF $DATA(DIRUT)
GOTO EXIT
+5 ;chose to add new entry
IF Y=(AQAONUM+1)
Begin DoDot:1
+6 KILL AQAO,AQAORIFN
DO ADD
End DoDot:1
IF '$DATA(AQAORIFN)
GOTO ASK
IF 1
+7 ;chose to edit an entry
IF '$TEST
SET AQAORIFN=$PIECE(AQAO(+Y),U)
+8 ;
EDIT ; edit review
+1 LOCK +^AQAGU(0):1
IF '$TEST
Begin DoDot:1
+2 WRITE !!,"CANNOT ENTER REVIEW; AUDIT FILE LOCKED. TRY AGAIN.",!
End DoDot:1
GOTO EXIT
+3 SET AQAOUDIT("DA")=AQAOIFN
SET AQAOUDIT("ACTION")="E"
+4 SET AQAOUDIT("REV")=AQAORIFN
+5 SET AQAOUDIT("COMMENT")="EDIT OCCURRENCE REVIEW"
DO ^AQAOAUD
+6 ;
+7 KILL DIE,DIR
SET DIE="^AQAOC("_AQAOIFN_",""REV"","
SET DA(1)=AQAOIFN
SET DA=AQAORIFN
+8 SET DR=".01;S AQAORLX=X;.02;.04;I AQAORLX=1 S Y=""@1"";.011;.06;@1;.05;.07;S:$P(^AQAO(6,$P(^AQAOC(AQAOIFN,""REV"",AQAORIFN,0),U,7),0),U,4)'=1 Y=""@2"";.09;2;@2;1"
+9 DO ^DIE
+10 ;
+11 ;action;PATCH 1
SET AQAOACT=$PIECE($GET(^AQAOC(AQAOIFN,"REV",AQAORIFN,0)),U,7)
+12 ;practitioner action
IF AQAOACT]""
IF $PIECE(^AQAO(6,AQAOACT,0),U,4)=2
Begin DoDot:1
+13 SET AQAOPT=$ORDER(^AQAQX("B","AQAO PROV ACTION",0))
IF AQAOPT=""
QUIT
+14 ;call data entry driver
KILL AQAOP
DO ^AQAOEDTS
End DoDot:1
+15 ;update prov list;PATCH 3
IF '$TEST
Begin DoDot:1
+16 ;PATCH 3
SET AQAOPT=$ORDER(^AQAQX("B","AQAO PROV LEVEL",0))
IF AQAOPT=""
QUIT
+17 ;PATCH 3
KILL AQAOP
DO ^AQAOEDTS
End DoDot:1
+18 ;
+19 ;PATCH 3
IF $DATA(^XUSEC("AQAOZVAL",DUZ))
IF $PIECE($GET(^AQAO(6,+AQAOACT,0)),U,4)'=1
IF '$ORDER(^AQAOC(AQAOIFN,"REV",AQAORIFN))
IF $$ALLREV
Begin DoDot:1
+20 ;close out occ
SET AQAOENTR=""
DO CLOSE^AQAOVAL
KILL AQAOENTR
End DoDot:1
+21 ;
+22 DO PRTOPT^AQAOVAR
GOTO ASK
+23 ;
EXIT ; >> eoj
+1 IF $DATA(AQAOIFN)
LOCK -^AQAOC(AQAOIFN)
+2 DO KILL^AQAOUTIL
QUIT
+3 ;
ADD ; SUBRTN to add new review to occ
+1 LOCK +^AQAGU(0):1
IF '$TEST
Begin DoDot:1
+2 WRITE !!,"CANNOT ADD NEW REVIEW; AUDIT FILE LOCKED. TRY AGAIN.",!
End DoDot:1
QUIT
+3 WRITE !!,"(To add a review for a stage already used, enter in quotes, i.e. ""PEER"".)"
+4 IF '$DATA(^AQAOC(AQAOIFN,"REV",0))
SET ^AQAOC(AQAOIFN,"REV",0)="^9002167.01P^^"
+5 KILL DIC
SET DIC="^AQAOC("_AQAOIFN_",""REV"","
SET DA(1)=AQAOIFN
+6 SET DIC(0)="AEMZQL"
DO ^DIC
IF +Y>0
SET AQAORIFN=+Y
+7 IF '$DATA(AQAORIFN)
QUIT
SET AQAOUDIT("DA")=AQAOIFN
SET AQAOUDIT("ACTION")="E"
+8 SET AQAOUDIT("COMMENT")="ADD OCCURRENCE REVIEW"
SET AQAOUDIT("REV")=AQAORIFN
+9 DO ^AQAOAUD
+10 QUIT
+11 ;
+12 ;
ALLREV() ;EP; -- SUBRTN to return whether referrals covered by reviews;PATCH 3
+1 QUIT $SELECT($$REFCNT>$$REVCNT:0,1:1)
+2 ;
REFCNT() ; -- SUBRTN to return # of referrals;PATCH 3
+1 NEW AQAORF,X,Y
SET AQAORF=0
+2 ;
+3 ; -- initial review was referral?
+4 IF $PIECE($GET(^AQAOC(AQAOIFN,1)),U,9)]""
SET AQAORF=AQAORF+1
+5 ; -- any additional referrals on initial review?
+6 SET X=0
+7 FOR
SET X=$ORDER(^AQAOC(AQAOIFN,"IADDRV",X))
IF X'=+X
QUIT
SET AQAORF=AQAORF+1
+8 ;
+9 ; -- count referrals on other reviews
+10 SET X=0
FOR
SET X=$ORDER(^AQAOC(AQAOIFN,"REV",X))
IF X'=+X
QUIT
Begin DoDot:1
+11 IF $PIECE($GET(^AQAOC(AQAOIFN,"REV",X,0)),U,9)]""
SET AQAORF=AQAORF+1
+12 SET Y=0
+13 FOR
SET Y=$ORDER(^AQAOC(AQAOIFN,"REV",X,"ADDRV",Y))
IF Y'=+Y
QUIT
Begin DoDot:2
+14 SET AQAORF=AQAORF+1
End DoDot:2
End DoDot:1
+15 ;
+16 QUIT AQAORF
+17 ;
REVCNT() ; -- SUBRTN to return # of reviews;PATCH 3
+1 NEW AQAORV,X
SET AQAORV=0
+2 SET X=0
FOR
SET X=$ORDER(^AQAOC(AQAOIFN,"REV",X))
IF X'=+X
QUIT
SET AQAORV=AQAORV+1
+3 QUIT AQAORV
