- 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
