QAOEDT0C ;HISC/DAD-CLINICAL REVIEW LEVEL EDIT ;2/3/93  16:00
 ;;3.0;Occurrence Screen;;09/14/1993
REVLEV S (QAOSQUIT,QAOSNEWF)=0,QAOSREVR(0)=+^QA(741,QAOSD0,"REVR",QAOSD1,0)
 K DR S DIE="^QA(741,"_QAOSD0_",""REVR"",",DR=".01"
 S (D0,DA(1))=QAOSD0,(D1,DA)=QAOSD1 D ^DIE G:('$D(DA))!($D(Y)) EXIT
 S QAOSREVR(1)=+^QA(741,QAOSD0,"REVR",QAOSD1,0)
 I QAOSREVR(0)'=QAOSREVR(1) D RESET^QAOEDT0 G REVLEV
 K DR S DIE="^QA(741,"_QAOSD0_",""REVR"",",DR=".02T"
 S (D0,DA(1))=QAOSD0,(D1,DA)=QAOSD1 D ^DIE G:$D(Y) EXIT
 I $O(^QA(741.5,"C",+$G(^QA(741,QAOSD0,"SCRN")),0))'>0 G FINDING
 S:$D(^QA(741,QAOSD0,"REVR",QAOSD1,1,0))[0 ^(0)="^741.12PA^^"
 K DR S DIE="^QA(741,"_QAOSD0_",""REVR"",",DR="2"
 S (D0,DA(1))=QAOSD0,(D1,DA)=QAOSD1 D ^DIE G:$D(Y) EXIT
 I $O(^QA(741,QAOSD0,"REVR",QAOSD1,1,"B",0)) S QAOSQUIT=1 D EXCEPT G ACTION
FINDING ;
 S QAOSFIND(1)=$P($G(^QA(741,QAOSD0,"REVR",QAOSD1,0)),"^",5)
 K DR S DIE="^QA(741,"_QAOSD0_",""REVR"",",DR="4"
 S (D0,DA(1))=QAOSD0,(D1,DA)=QAOSD1 D ^DIE G:$D(Y) EXIT
 S QAOSFIND(2)=$P($G(^QA(741,QAOSD0,"REVR",QAOSD1,0)),"^",5)
 S QAOSNEWF=0 I QAOSFIND(1),QAOSFIND(2)'=QAOSFIND(1) S QAOSNEWF=1
 S QAOS=+$G(^QA(741.6,+QAOSFIND(2),0))
 I QAOSFDSP("F")[("^"_QAOS_"^") S (QAOSQUIT,QAOSFDSP)=1 G ACTION
 K DR S DIE="^QA(741,"_QAOSD0_",""REVR"",",DR="3"
 S (D0,DA(1))=QAOSD0,(D1,DA)=QAOSD1 D ^DIE G:$D(Y) EXIT
ACTION ;
 I QAOSNEWF W !!?5,"Since the findings have been changed, you must review the actions.",!?5,"Delete any old actions that no longer apply, and add new actions that",!?5,"are now appropriate."
 S:$D(^QA(741,QAOSD0,"REVR",QAOSD1,2,0))[0 ^(0)="^741.15PA^^"
 K DR S DIE="^QA(741,"_QAOSD0_",""REVR"","
 S DR="5"_$S(QAOSQUIT:"//^S X=1",1:""),(D0,DA(1))=QAOSD0,(D1,DA)=QAOSD1
 D ^DIE G:$D(Y) EXIT
 D CHKACT^QAOEDT0
 K DR S DIE="^QA(741,"_QAOSD0_",""REVR"",",DR="10;1"
 S (D0,DA(1))=QAOSD0,(D1,DA)=QAOSD1 D ^DIE G:$D(Y) EXIT
EXIT ;
 Q
EXCEPT ;
 S QAOS=+$O(^QA(741.6,"B",3,0)) Q:QAOS'>0
 S QAOS=$P($G(^QA(741.6,+QAOS,0)),"^",2) Q:QAOS=""
 W !!,"A finding of ",QAOS," is automatically being entered.",!
 K DR S DIE="^QA(741,"_QAOSD0_",""REVR"",",DR="4///^S X=3"
 S (D0,DA(1))=QAOSD0,(D1,DA)=QAOSD1 D ^DIE S QAOSFDSP=1
 Q