| [613] | 1 | QAMEDT5A ;HISC/DAD-EDIT MANUALLY ENROLL A FALL OUT ;12/14/92 09:05
|
|---|
| 2 | ;;1.0;Clinical Monitoring System;;09/13/1993
|
|---|
| 3 | S QAUDIT("ACTION")="e",QAUDIT("COMMENT")="MANUAL EDIT OF FALL OUT DATA" D AUDIT S DIE="^QA(743.1,",DR=".01;.02;.03",DA=QAMREC W ! D ^DIE G:($D(DA)[0)!$D(Y) EXIT
|
|---|
| 4 | S QAMQUIT=0 F QAMD1=0:0 S QAMD1=$O(^QA(743,QAMD0,"DAT",QAMD1)) Q:QAMD1'>0!QAMQUIT D LOOP1
|
|---|
| 5 | EXIT ;
|
|---|
| 6 | Q
|
|---|
| 7 | LOOP1 ; *** LOOP THRU DATA ELEMENTS
|
|---|
| 8 | K DIR,DIRUT S QAMFLD=+^QA(743,QAMD0,"DAT",QAMD1,0)
|
|---|
| 9 | S QAMIEN=$O(^QA(743.1,QAMREC,1,"B",QAMFLD,0))
|
|---|
| 10 | I QAMIEN'>0 S:$D(^QA(743.1,QAMREC,1,0))[0 ^QA(743.1,QAMREC,1,0)="^743.11PA^^" K DD,DIC,DINUM,DO S DIC="^QA(743.1,"_QAMREC_",1,",DIC(0)="LM",DLAYGO=743.1,(DA(1),D0)=QAMREC,X=QAMFLD D FILE^DICN S QAMIEN=+Y
|
|---|
| 11 | S QAMELEM=QAMFLD D EN1^QAMUTL2 Q:$D(DIR(0))[0 Q:$D(DIR("A"))[0
|
|---|
| 12 | S QAMDIR("B")=$S($D(^QA(743.1,QAMREC,1,QAMIEN,"E"))#2:^("E"),1:"")
|
|---|
| 13 | I QAMDIR("B")="" K QAMELEM S QAMELEM=+^QA(743,QAMD0,"DAT",QAMD1,0),QAM=$S($D(^QA(743.1,QAMREC,0))#2:^(0),1:""),QAMDFN=+QAM,QAMEVENT=$P(QAM,"^",3) D DEFAULT S QAMDIR("B")=X
|
|---|
| 14 | S DIR("B")=$S(QAMDIR("B")]"":QAMDIR("B"),$D(DIR("B"))#2:DIR("B"),1:"") K:DIR("B")="" DIR("B")
|
|---|
| 15 | I $E(DIR(0))="P",'$$EXIST^QAMUTL1(+$P(DIR(0),"^",2)) D G DIRCHK
|
|---|
| 16 | . W !,$P($G(^QA(743.4,QAMFLD,0)),"^"),":"
|
|---|
| 17 | . W !!?5,"*** File not found !! ***",*7,!
|
|---|
| 18 | . S X="",DIRUT=1 K DTOUT,QADIROUT
|
|---|
| 19 | . Q
|
|---|
| 20 | DIR D ^DIR S:(Y'>0)&($P(DIR(0),"^")["P") DIRUT=1
|
|---|
| 21 | DIRCHK I $D(DIRUT),'$D(DTOUT) S Y="" K:X="" DIRUT G DONE:($E(X)="^")!(X=""),DIR:(X]"")&(X'="@") I X="@" D DELETE K:QAMPCENT=1 DIRUT G:QAMPCENT=2 DIR Q:QAMPCENT=1
|
|---|
| 22 | DONE I $D(DIRUT) S QAMQUIT=1 Q
|
|---|
| 23 | I $D(QADIROUT)#2,QADIROUT]"" X QADIROUT
|
|---|
| 24 | I Y]"" K DIC,DIE,DIR,DR S DIE="^QA(743.1,"_QAMREC_",1,",(D0,DA(1))=QAMREC,(D1,DA)=QAMIEN,DR=".02///"_Y D ^DIE
|
|---|
| 25 | Q
|
|---|
| 26 | DELETE ; *** DELETE DATA FOR DATA ELEMENT
|
|---|
| 27 | N DIC,DIR
|
|---|
| 28 | DEL S (QAMPCENT,%)=2 I $S($D(^QA(743.1,QAMREC,1,QAMIEN,"E"))[0:1,^("E")="":1,1:0) W " ??",*7 Q
|
|---|
| 29 | W !?5,*7,"SURE YOU WANT TO DELETE" D YN^DICN S QAMPCENT=% W " ",$S(%=1:"<DELETED>",%=2:"<NOTHING DELETED>",1:"") I '% W !!?10,"Please answer Y(es) or N(o)",! G DEL
|
|---|
| 30 | I %=1 K DIE,DR S DIE="^QA(743.1,"_QAMREC_",1,",(D0,DA(1))=QAMREC,(D1,DA)=QAMIEN,DR=".02///@" D ^DIE
|
|---|
| 31 | Q
|
|---|
| 32 | DEFAULT ; *** COMPUTE DEFAULT VALUE FOR DATA ELEMENT
|
|---|
| 33 | ; *** REQUIRES: QAMDFN, QAMELEM, QAMEVENT
|
|---|
| 34 | K DA,DIC,DIQ,DR,QAMDTPT
|
|---|
| 35 | S DIQ="QAMELEM",DIQ(0)="E",DIC=$S($D(^QA(743.4,QAMELEM,0))#2:$P(^(0),"^",3),1:0) G:DIC'>0 FIN
|
|---|
| 36 | I $D(QADIRPNT)#2,QADIRPNT]"" X QADIRPNT ; S QAMDTPT(1,2,3,...,n) = D0,D1,D2,...,Dn
|
|---|
| 37 | G:'$D(QAMDTPT) FIN S (MAX,QAMDD("MAX"),QAMDA("MAX"),QAMFIELD("MAX"))=0
|
|---|
| 38 | F QAME1=0:0 S QAME1=$O(^QA(743.4,QAMELEM,"DD",QAME1)) Q:QAME1'>0 S X=^QA(743.4,QAMELEM,"DD",QAME1,0),QAMDD=+X,QAMFIELD=+$P(X,"^",2),QAMLEVL=+$P(X,"^",3) D LOOP2
|
|---|
| 39 | D EN^DIQ1 ; *** S QAMELEM(file#,DA,field#,"E") = EXTERNAL DATA FORMAT
|
|---|
| 40 | FIN ;
|
|---|
| 41 | S X=$S($D(QAMELEM(QAMDD("MAX"),QAMDA("MAX"),QAMFIELD("MAX"),"E"))#2:QAMELEM(QAMDD("MAX"),QAMDA("MAX"),QAMFIELD("MAX"),"E"),1:"")
|
|---|
| 42 | Q
|
|---|
| 43 | LOOP2 ;
|
|---|
| 44 | I QAMLEVL=1 S (DA,QADA)=$S($D(QAMDTPT(QAMLEVL))#2:QAMDTPT(QAMLEVL),1:0),DR=QAMFIELD
|
|---|
| 45 | E S (DA(QAMDD),QADA)=$S($D(QAMDTPT(QAMLEVL))#2:QAMDTPT(QAMLEVL),1:0),DR(QAMDD)=QAMFIELD
|
|---|
| 46 | I QAMLEVL>MAX S QAMFIELD("MAX")=QAMFIELD,QAMDA("MAX")=QADA,QAMDD("MAX")=QAMDD,MAX=QAMLEVL
|
|---|
| 47 | Q
|
|---|
| 48 | AUDIT ;GENERATE THE AUDIT RECORD FOR THIS EDIT
|
|---|
| 49 | S QAUDIT("FILE")="743.1^100",QAUDIT("DA")=QAMREC D ^QAQAUDIT
|
|---|
| 50 | Q
|
|---|
