source: WorldVistAEHR/trunk/r/OCCURRENCE_SCREEN-QAO/QAOEDT0C.m@ 975

Last change on this file since 975 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1QAOEDT0C ;HISC/DAD-CLINICAL REVIEW LEVEL EDIT ;2/3/93 16:00
2 ;;3.0;Occurrence Screen;;09/14/1993
3REVLEV S (QAOSQUIT,QAOSNEWF)=0,QAOSREVR(0)=+^QA(741,QAOSD0,"REVR",QAOSD1,0)
4 K DR S DIE="^QA(741,"_QAOSD0_",""REVR"",",DR=".01"
5 S (D0,DA(1))=QAOSD0,(D1,DA)=QAOSD1 D ^DIE G:('$D(DA))!($D(Y)) EXIT
6 S QAOSREVR(1)=+^QA(741,QAOSD0,"REVR",QAOSD1,0)
7 I QAOSREVR(0)'=QAOSREVR(1) D RESET^QAOEDT0 G REVLEV
8 K DR S DIE="^QA(741,"_QAOSD0_",""REVR"",",DR=".02T"
9 S (D0,DA(1))=QAOSD0,(D1,DA)=QAOSD1 D ^DIE G:$D(Y) EXIT
10 I $O(^QA(741.5,"C",+$G(^QA(741,QAOSD0,"SCRN")),0))'>0 G FINDING
11 S:$D(^QA(741,QAOSD0,"REVR",QAOSD1,1,0))[0 ^(0)="^741.12PA^^"
12 K DR S DIE="^QA(741,"_QAOSD0_",""REVR"",",DR="2"
13 S (D0,DA(1))=QAOSD0,(D1,DA)=QAOSD1 D ^DIE G:$D(Y) EXIT
14 I $O(^QA(741,QAOSD0,"REVR",QAOSD1,1,"B",0)) S QAOSQUIT=1 D EXCEPT G ACTION
15FINDING ;
16 S QAOSFIND(1)=$P($G(^QA(741,QAOSD0,"REVR",QAOSD1,0)),"^",5)
17 K DR S DIE="^QA(741,"_QAOSD0_",""REVR"",",DR="4"
18 S (D0,DA(1))=QAOSD0,(D1,DA)=QAOSD1 D ^DIE G:$D(Y) EXIT
19 S QAOSFIND(2)=$P($G(^QA(741,QAOSD0,"REVR",QAOSD1,0)),"^",5)
20 S QAOSNEWF=0 I QAOSFIND(1),QAOSFIND(2)'=QAOSFIND(1) S QAOSNEWF=1
21 S QAOS=+$G(^QA(741.6,+QAOSFIND(2),0))
22 I QAOSFDSP("F")[("^"_QAOS_"^") S (QAOSQUIT,QAOSFDSP)=1 G ACTION
23 K DR S DIE="^QA(741,"_QAOSD0_",""REVR"",",DR="3"
24 S (D0,DA(1))=QAOSD0,(D1,DA)=QAOSD1 D ^DIE G:$D(Y) EXIT
25ACTION ;
26 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."
27 S:$D(^QA(741,QAOSD0,"REVR",QAOSD1,2,0))[0 ^(0)="^741.15PA^^"
28 K DR S DIE="^QA(741,"_QAOSD0_",""REVR"","
29 S DR="5"_$S(QAOSQUIT:"//^S X=1",1:""),(D0,DA(1))=QAOSD0,(D1,DA)=QAOSD1
30 D ^DIE G:$D(Y) EXIT
31 D CHKACT^QAOEDT0
32 K DR S DIE="^QA(741,"_QAOSD0_",""REVR"",",DR="10;1"
33 S (D0,DA(1))=QAOSD0,(D1,DA)=QAOSD1 D ^DIE G:$D(Y) EXIT
34EXIT ;
35 Q
36EXCEPT ;
37 S QAOS=+$O(^QA(741.6,"B",3,0)) Q:QAOS'>0
38 S QAOS=$P($G(^QA(741.6,+QAOS,0)),"^",2) Q:QAOS=""
39 W !!,"A finding of ",QAOS," is automatically being entered.",!
40 K DR S DIE="^QA(741,"_QAOSD0_",""REVR"",",DR="4///^S X=3"
41 S (D0,DA(1))=QAOSD0,(D1,DA)=QAOSD1 D ^DIE S QAOSFDSP=1
42 Q
Note: See TracBrowser for help on using the repository browser.