source: WorldVistAEHR/trunk/r/OCCURRENCE_SCREEN-QAO/QAOEDT0P.m@ 623

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

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1QAOEDT0P ;HISC/DAD-PEER REVIEW LEVEL EDIT ;2/3/93 15:57
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;.03"
9 S (D0,DA(1))=QAOSD0,(D1,DA)=QAOSD1 D ^DIE G:$D(Y) EXIT
10FINDING ;
11 S QAOSFIND(1)=$P($G(^QA(741,QAOSD0,"REVR",QAOSD1,0)),"^",5)
12 K DR S DIE="^QA(741,"_QAOSD0_",""REVR"",",DR="4"
13 S (D0,DA(1))=QAOSD0,(D1,DA)=QAOSD1 D ^DIE G:$D(Y) EXIT
14 S QAOSFIND(2)=$P($G(^QA(741,QAOSD0,"REVR",QAOSD1,0)),"^",5)
15 S QAOSNEWF=0 I QAOSFIND(1),QAOSFIND(2)'=QAOSFIND(1) S QAOSNEWF=1
16 S QAOS=+$G(^QA(741.6,+QAOSFIND(2),0))
17 I QAOSFDSP("F")[("^"_QAOS_"^") S (QAOSQUIT,QAOSFDSP)=1
18ACTION ;
19 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."
20 S:$D(^QA(741,QAOSD0,"REVR",QAOSD1,2,0))[0 ^(0)="^741.15PA^^"
21 K DR S DIE="^QA(741,"_QAOSD0_",""REVR"","
22 S DR="5"_$S(QAOSQUIT:"//^S X=1",1:""),(D0,DA(1))=QAOSD0,(D1,DA)=QAOSD1
23 D ^DIE G:$D(Y) EXIT
24 D CHKACT^QAOEDT0
25 K DR S DIE="^QA(741,"_QAOSD0_",""REVR"",",DR="10;1;9//NO"
26 S (D0,DA(1))=QAOSD0,(D1,DA)=QAOSD1 D ^DIE G:$D(Y) EXIT
27ATTRIB ;
28 W !!?5,"Do you wish to enter peer attributions"
29 S %=2 D YN^DICN G:(%=-1)!(%=2) EXIT
30 I '% D G ATTRIB
31 . W !!?10,"Enter Y(es) to edit the individual, medical team, and"
32 . W !?10,"hospital location attribution data."
33 . W !?10,"Enter N(o) to skip the attribution edit."
34 . Q
35 ;
36 S QAOSSERV=$P($G(^QA(741,QAOSD0,"REVR",QAOSD1,0)),"^",10)
37 F QAOFIELD=24:1:26 W ! D Q:QAOSQUIT
38 . S QAOSUBDD="741.0"_QAOFIELD
39 . S QAOSNODE="ATR"_$S(QAOFIELD=24:"I",QAOFIELD=25:"T",QAOFIELD=26:"L")
40 . S:'$D(^QA(741,QAOSD0,QAOSNODE,0)) ^(0)="^"_QAOSUBDD_"PA^^"
41AGAIN . K DA,DIC,DIE,DR
42 . S DIC="^QA(741,"_QAOSD0_","""_QAOSNODE_""",",DIC(0)="AELMNQ"
43 . S DIC("S")="S QA=$P($G(^(0)),""^"",2) I QA=""""!(QA=QAOSSERV)"
44 . S DA(1)=QAOSD0,DLAYGO=QAOSUBDD
45 . D ^DIC S QAOSD1=+Y
46 . I Y'>0 S QAOSQUIT=$S($D(DUOUT):1,$D(DTOUT):1,1:0) Q
47 . S DIE=DIC,(D0,DA(1))=QAOSD0,(D1,DA)=QAOSD1
48 . S DR=".01" S:QAOSSERV DR=DR_";.02///`"_QAOSSERV
49 . D ^DIE
50 . G AGAIN
51EXIT ;
52 Q
Note: See TracBrowser for help on using the repository browser.