QAMAUTO7 ;HISC/DAD-AUTO ENROLL PROCESS FALLOUTS ;8/26/93 13:21
;;1.0;Clinical Monitoring System;;09/13/1993
S DUPLICAT(0)=0,^UTILITY($J,"QAM FALL OUT",QAMD0,QAMDFN,QAMEVENT)=""
I $D(^QA(743.1,"AA",QAMD0,QAMEVENT,QAMDFN)) S DUPLICAT(0)=1
I 'DUPLICAT F QAMDT=(QAMSTART-.0000001):0 S QAMDT=$O(^QA(743.1,"AB",QAMD0,QAMDFN,QAMDT)) Q:QAMDT'>0!(QAMDT>(QAMEND+.9999999)) S DUPLICAT(0)=1 Q
I 'DUPLICAT S X=$O(^UTILITY($J,"QAM FALL OUT",QAMD0,QAMDFN,0)) I X,X-QAMEVENT S DUPLICAT(0)=1
S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAMDFN,QAMEVENT)=$S(DUPLICAT(0):"*",1:"")
I 'DUPLICAT(0) S QAMFALL=QAMFALL+1 D DATAELEM
EXIT ;
Q
DATAELEM ; *** PROCESS OTHER DATA TO CAPTURE
F QAME1=0:0 S QAME1=$O(^QA(743,QAMD0,"DAT",QAME1)) Q:QAME1'>0 F QAME0=0:0 S QAME0=$O(^QA(743,QAMD0,"COND",QAME0)) Q:QAME0'>0 D DE1
Q
DE1 S COND=$S($D(^QA(743,QAMD0,"COND",QAME0,0))#2:+^(0),1:0),ELEM=$S($D(^QA(743,QAMD0,"DAT",QAME1,0))#2:+^(0),1:0)
Q:(COND'>0)!(ELEM'>0)!($O(^QA(743.3,COND,"ELEM","B",ELEM,0))'>0)
F QAMWHEN=0:0 S QAMWHEN=$O(^UTILITY($J,"QAM CONDITION",QAME0,QAMDFN,QAMWHEN)) Q:QAMWHEN'>0 D DE2
Q
DE2 I QAMCND=QAME0,QAMWHEN'=QAMEVENT Q
K DA,DIC,DIQ,DR,QAM,QAMELEM S DIC=$S($D(^QA(743.4,ELEM,0))#2:+$P(^(0),"^",3),1:0) Q:DIC'>0 S DIQ(0)="E",DIQ="QAMELEM"
S QA(0)=^UTILITY($J,"QAM CONDITION",QAME0,QAMDFN,QAMWHEN) F QA=1:1 S X=$P(QA(0),"^",QA) Q:X'>0 S QAM(QA)=X
Q:$D(QAM)<10 S MAX=0
F QAME2=0:0 S QAME2=$O(^QA(743.4,ELEM,"DD",QAME2)) Q:QAME2'>0 S X=^QA(743.4,ELEM,"DD",QAME2,0),QAMDD=+X,QAMFLD=+$P(X,"^",2),QAMLEVL=+$P(X,"^",3) D DE3
D EN^DIQ1 ; *** S QAMELEM(file#,DA,field#,"E") = EXTERNAL DATA FORMAT
S X=$S($D(QAMELEM(QAMDD("MAX"),QAMDA("MAX"),QAMFLD("MAX"),"E"))#2:QAMELEM(QAMDD("MAX"),QAMDA("MAX"),QAMFLD("MAX"),"E"),1:"")
I X]"",$S($D(^DD(QAMDD("MAX"),QAMFLD("MAX"),0))#2:$P(^(0),"^",2),1:"")["D" K %DT S %DT="ST" D ^%DT X ^DD("DD") S X=Y ; *** REFORMAT DATE
; NEW STUFF :X]""
I $D(^UTILITY($J,"QAM FALL OUT",QAMD0,QAMDFN,QAMEVENT,ELEM))[0 S ^(ELEM)=X
E S:X]"" ^UTILITY($J,"QAM FALL OUT",QAMD0,QAMDFN,QAMEVENT,ELEM)=X
Q
DE3 I QAMLEVL=1 S (DA,QADA)=$S($D(QAM(QAMLEVL))#2:QAM(QAMLEVL),1:0),DR=QAMFLD
E S (DA(QAMDD),QADA)=$S($D(QAM(QAMLEVL))#2:QAM(QAMLEVL),1:0),DR(QAMDD)=QAMFLD
I QAMLEVL>MAX S QAMFLD("MAX")=QAMFLD,QAMDA("MAX")=QADA,QAMDD("MAX")=QAMDD,MAX=QAMLEVL
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAMAUTO7 2309 printed Dec 13, 2024@01:41:50 Page 2
QAMAUTO7 ;HISC/DAD-AUTO ENROLL PROCESS FALLOUTS ;8/26/93 13:21
+1 ;;1.0;Clinical Monitoring System;;09/13/1993
+2 SET DUPLICAT(0)=0
SET ^UTILITY($JOB,"QAM FALL OUT",QAMD0,QAMDFN,QAMEVENT)=""
+3 IF $DATA(^QA(743.1,"AA",QAMD0,QAMEVENT,QAMDFN))
SET DUPLICAT(0)=1
+4 IF 'DUPLICAT
FOR QAMDT=(QAMSTART-.0000001):0
SET QAMDT=$ORDER(^QA(743.1,"AB",QAMD0,QAMDFN,QAMDT))
if QAMDT'>0!(QAMDT>(QAMEND+.9999999))
QUIT
SET DUPLICAT(0)=1
QUIT
+5 IF 'DUPLICAT
SET X=$ORDER(^UTILITY($JOB,"QAM FALL OUT",QAMD0,QAMDFN,0))
IF X
IF X-QAMEVENT
SET DUPLICAT(0)=1
+6 SET ^UTILITY($JOB,"QAM FALL OUT",QAMD0,QAMDFN,QAMEVENT)=$SELECT(DUPLICAT(0):"*",1:"")
+7 IF 'DUPLICAT(0)
SET QAMFALL=QAMFALL+1
DO DATAELEM
EXIT ;
+1 QUIT
DATAELEM ; *** PROCESS OTHER DATA TO CAPTURE
+1 FOR QAME1=0:0
SET QAME1=$ORDER(^QA(743,QAMD0,"DAT",QAME1))
if QAME1'>0
QUIT
FOR QAME0=0:0
SET QAME0=$ORDER(^QA(743,QAMD0,"COND",QAME0))
if QAME0'>0
QUIT
DO DE1
+2 QUIT
DE1 SET COND=$SELECT($DATA(^QA(743,QAMD0,"COND",QAME0,0))#2:+^(0),1:0)
SET ELEM=$SELECT($DATA(^QA(743,QAMD0,"DAT",QAME1,0))#2:+^(0),1:0)
+1 if (COND'>0)!(ELEM'>0)!($ORDER(^QA(743.3,COND,"ELEM","B",ELEM,0))'>0)
QUIT
+2 FOR QAMWHEN=0:0
SET QAMWHEN=$ORDER(^UTILITY($JOB,"QAM CONDITION",QAME0,QAMDFN,QAMWHEN))
if QAMWHEN'>0
QUIT
DO DE2
+3 QUIT
DE2 IF QAMCND=QAME0
IF QAMWHEN'=QAMEVENT
QUIT
+1 KILL DA,DIC,DIQ,DR,QAM,QAMELEM
SET DIC=$SELECT($DATA(^QA(743.4,ELEM,0))#2:+$PIECE(^(0),"^",3),1:0)
if DIC'>0
QUIT
SET DIQ(0)="E"
SET DIQ="QAMELEM"
+2 SET QA(0)=^UTILITY($JOB,"QAM CONDITION",QAME0,QAMDFN,QAMWHEN)
FOR QA=1:1
SET X=$PIECE(QA(0),"^",QA)
if X'>0
QUIT
SET QAM(QA)=X
+3 if $DATA(QAM)<10
QUIT
SET MAX=0
+4 FOR QAME2=0:0
SET QAME2=$ORDER(^QA(743.4,ELEM,"DD",QAME2))
if QAME2'>0
QUIT
SET X=^QA(743.4,ELEM,"DD",QAME2,0)
SET QAMDD=+X
SET QAMFLD=+$PIECE(X,"^",2)
SET QAMLEVL=+$PIECE(X,"^",3)
DO DE3
+5 ; *** S QAMELEM(file#,DA,field#,"E") = EXTERNAL DATA FORMAT
DO EN^DIQ1
+6 SET X=$SELECT($DATA(QAMELEM(QAMDD("MAX"),QAMDA("MAX"),QAMFLD("MAX"),"E"))#2:QAMELEM(QAMDD("MAX"),QAMDA("MAX"),QAMFLD("MAX"),"E"),1:"")
+7 ; *** REFORMAT DATE
IF X]""
IF $SELECT($DATA(^DD(QAMDD("MAX"),QAMFLD("MAX"),0))#2:$PIECE(^(0),"^",2),1:"")["D"
KILL %DT
SET %DT="ST"
DO ^%DT
XECUTE ^DD("DD")
SET X=Y
+8 ; NEW STUFF :X]""
+9 IF $DATA(^UTILITY($JOB,"QAM FALL OUT",QAMD0,QAMDFN,QAMEVENT,ELEM))[0
SET ^(ELEM)=X
+10 IF '$TEST
if X]""
SET ^UTILITY($JOB,"QAM FALL OUT",QAMD0,QAMDFN,QAMEVENT,ELEM)=X
+11 QUIT
DE3 IF QAMLEVL=1
SET (DA,QADA)=$SELECT($DATA(QAM(QAMLEVL))#2:QAM(QAMLEVL),1:0)
SET DR=QAMFLD
+1 IF '$TEST
SET (DA(QAMDD),QADA)=$SELECT($DATA(QAM(QAMLEVL))#2:QAM(QAMLEVL),1:0)
SET DR(QAMDD)=QAMFLD
+2 IF QAMLEVL>MAX
SET QAMFLD("MAX")=QAMFLD
SET QAMDA("MAX")=QADA
SET QAMDD("MAX")=QAMDD
SET MAX=QAMLEVL
+3 QUIT
