| 1 | QAOEDT0P ;HISC/DAD-PEER REVIEW LEVEL EDIT ;2/3/93 15:57
|
|---|
| 2 | ;;3.0;Occurrence Screen;;09/14/1993
|
|---|
| 3 | REVLEV 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
|
|---|
| 10 | FINDING ;
|
|---|
| 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
|
|---|
| 18 | ACTION ;
|
|---|
| 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
|
|---|
| 27 | ATTRIB ;
|
|---|
| 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^^"
|
|---|
| 41 | AGAIN . 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
|
|---|
| 51 | EXIT ;
|
|---|
| 52 | Q
|
|---|
