- 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 Apr 23, 2025@17:56:17 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
