source: WorldVistAEHR/trunk/r/CLINICAL_MONITORING_SYSTEM-QAM/QAMEDT5A.m@ 1261

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

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1QAMEDT5A ;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
5EXIT ;
6 Q
7LOOP1 ; *** 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
20DIR D ^DIR S:(Y'>0)&($P(DIR(0),"^")["P") DIRUT=1
21DIRCHK 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
22DONE 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
26DELETE ; *** DELETE DATA FOR DATA ELEMENT
27 N DIC,DIR
28DEL 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
32DEFAULT ; *** 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
40FIN ;
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
43LOOP2 ;
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
48AUDIT ;GENERATE THE AUDIT RECORD FOR THIS EDIT
49 S QAUDIT("FILE")="743.1^100",QAUDIT("DA")=QAMREC D ^QAQAUDIT
50 Q
Note: See TracBrowser for help on using the repository browser.