QAMEDT5A ;HISC/DAD-EDIT MANUALLY ENROLL A FALL OUT ;12/14/92  09:05
 ;;1.0;Clinical Monitoring System;;09/13/1993
 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
 S QAMQUIT=0 F QAMD1=0:0 S QAMD1=$O(^QA(743,QAMD0,"DAT",QAMD1)) Q:QAMD1'>0!QAMQUIT  D LOOP1
EXIT ;
 Q
LOOP1 ; *** LOOP THRU DATA ELEMENTS
 K DIR,DIRUT S QAMFLD=+^QA(743,QAMD0,"DAT",QAMD1,0)
 S QAMIEN=$O(^QA(743.1,QAMREC,1,"B",QAMFLD,0))
 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
 S QAMELEM=QAMFLD D EN1^QAMUTL2 Q:$D(DIR(0))[0  Q:$D(DIR("A"))[0
 S QAMDIR("B")=$S($D(^QA(743.1,QAMREC,1,QAMIEN,"E"))#2:^("E"),1:"")
 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
 S DIR("B")=$S(QAMDIR("B")]"":QAMDIR("B"),$D(DIR("B"))#2:DIR("B"),1:"") K:DIR("B")="" DIR("B")
 I $E(DIR(0))="P",'$$EXIST^QAMUTL1(+$P(DIR(0),"^",2)) D  G DIRCHK
 . W !,$P($G(^QA(743.4,QAMFLD,0)),"^"),":"
 . W !!?5,"*** File not found !! ***",*7,!
 . S X="",DIRUT=1 K DTOUT,QADIROUT
 . Q
DIR D ^DIR S:(Y'>0)&($P(DIR(0),"^")["P") DIRUT=1
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
DONE I $D(DIRUT) S QAMQUIT=1 Q
 I $D(QADIROUT)#2,QADIROUT]"" X QADIROUT
 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
 Q
DELETE ; *** DELETE DATA FOR DATA ELEMENT
 N DIC,DIR
DEL S (QAMPCENT,%)=2 I $S($D(^QA(743.1,QAMREC,1,QAMIEN,"E"))[0:1,^("E")="":1,1:0) W " ??",*7 Q
 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
 I %=1 K DIE,DR S DIE="^QA(743.1,"_QAMREC_",1,",(D0,DA(1))=QAMREC,(D1,DA)=QAMIEN,DR=".02///@" D ^DIE
 Q
DEFAULT ; *** COMPUTE DEFAULT VALUE FOR DATA ELEMENT
 ; *** REQUIRES: QAMDFN, QAMELEM, QAMEVENT
 K DA,DIC,DIQ,DR,QAMDTPT
 S DIQ="QAMELEM",DIQ(0)="E",DIC=$S($D(^QA(743.4,QAMELEM,0))#2:$P(^(0),"^",3),1:0) G:DIC'>0 FIN
 I $D(QADIRPNT)#2,QADIRPNT]"" X QADIRPNT ; S QAMDTPT(1,2,3,...,n) = D0,D1,D2,...,Dn
 G:'$D(QAMDTPT) FIN S (MAX,QAMDD("MAX"),QAMDA("MAX"),QAMFIELD("MAX"))=0
 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
 D EN^DIQ1 ; *** S QAMELEM(file#,DA,field#,"E") = EXTERNAL DATA FORMAT
FIN ;
 S X=$S($D(QAMELEM(QAMDD("MAX"),QAMDA("MAX"),QAMFIELD("MAX"),"E"))#2:QAMELEM(QAMDD("MAX"),QAMDA("MAX"),QAMFIELD("MAX"),"E"),1:"")
 Q
LOOP2 ;
 I QAMLEVL=1 S (DA,QADA)=$S($D(QAMDTPT(QAMLEVL))#2:QAMDTPT(QAMLEVL),1:0),DR=QAMFIELD
 E  S (DA(QAMDD),QADA)=$S($D(QAMDTPT(QAMLEVL))#2:QAMDTPT(QAMLEVL),1:0),DR(QAMDD)=QAMFIELD
 I QAMLEVL>MAX S QAMFIELD("MAX")=QAMFIELD,QAMDA("MAX")=QADA,QAMDD("MAX")=QAMDD,MAX=QAMLEVL
 Q
AUDIT ;GENERATE THE AUDIT RECORD FOR THIS EDIT
 S QAUDIT("FILE")="743.1^100",QAUDIT("DA")=QAMREC D ^QAQAUDIT
 Q