QAMAUTO2 ;HISC/DAD-AUTO ENROLL POPULATE FALL OUT FILE ;6/18/93 14:57
;;1.0;Clinical Monitoring System;;09/13/1993
S QAMZERO=$S($D(^QA(743,QAMD0,0))#2:^(0),1:""),QAMONE=$S($D(^QA(743,QAMD0,1))#2:^(1),1:"")
F QAMDFN=0:0 S QAMDFN=$O(^UTILITY($J,"QAM FALL OUT",QAMD0,QAMDFN)) Q:QAMDFN'>0 F QAMDATE=0:0 S QAMDATE=$O(^UTILITY($J,"QAM FALL OUT",QAMD0,QAMDFN,QAMDATE)) Q:QAMDATE'>0 D LOOP1
D EN1^QAMAUTO1,EN2^QAMAUTO1 ; *** CHECK/UPDATE HISTORY FILE
D EN3^QAMAUTO1 ; *** BULLETIN
I $D(^UTILITY($J,"QAM",QAMD0,"LST"))#2,+^("LST") D ^QAMAUTO3 ; *** GENERIC LIST OF FALL OUTS
I $D(^UTILITY($J,"QAM",QAMD0,"WSR"))#2 S QAM=^("WSR") I +QAM S X=$P(QAM,"^",2,99) I X]"" S X=$P(X,"^",$L(X,"^")) X ^%ZOSF("TEST") I X $P(QAM,"^",2,99) ; *** FALL OUT WORKSHEET
I $D(^UTILITY($J,"QAM",QAMD0,"SFR"))#2 S QAM=^("SFR") I +QAM S X=$P(QAM,"^",2,99) I X]"" S X=$P(X,"^",$L(X,"^")) X ^%ZOSF("TEST") I X $P(QAM,"^",2,99) ; *** FALL OUT SPECIAL FUNCTION ROUTINE
Q
LOOP1 ;
Q:^UTILITY($J,"QAM FALL OUT",QAMD0,QAMDFN,QAMDATE)="*" ; *** DUPLICATE
K DD,DIC,DINUM,DO S DIC="^QA(743.1,",DIC(0)="LM",X=QAMDFN,DIC("DR")=".02///`"_QAMD0_";.03///"_QAMDATE_";.04///"_QAMTODAY,DLAYGO=743.1 D FILE^DICN S QAMFALL0=+Y
S QAUDIT("FILE")="743.1^100",QAUDIT("DA")=QAMFALL0,QAUDIT("ACTION")="o",QAUDIT("COMMENT")="AUTO ENROLLED FALL OUT" D ^QAQAUDIT
S:$D(^QA(743.1,QAMFALL0,1,0))[0 ^QA(743.1,QAMFALL0,1,0)="^743.11PA^^"
F QAMDATA=0:0 S QAMDATA=$O(^UTILITY($J,"QAM FALL OUT",QAMD0,QAMDFN,QAMDATE,QAMDATA)) Q:QAMDATA'>0 D LOOP2
S DIK="^QA(743.1,",DA=QAMFALL0 D IX1^DIK
Q
LOOP2 ;
S ^QA(743.1,QAMFALL0,1,QAMDATA,0)=QAMDATA,^QA(743.1,QAMFALL0,1,QAMDATA,"E")=^UTILITY($J,"QAM FALL OUT",QAMD0,QAMDFN,QAMDATE,QAMDATA)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAMAUTO2 1708 printed Nov 22, 2024@16:51:58 Page 2
QAMAUTO2 ;HISC/DAD-AUTO ENROLL POPULATE FALL OUT FILE ;6/18/93 14:57
+1 ;;1.0;Clinical Monitoring System;;09/13/1993
+2 SET QAMZERO=$SELECT($DATA(^QA(743,QAMD0,0))#2:^(0),1:"")
SET QAMONE=$SELECT($DATA(^QA(743,QAMD0,1))#2:^(1),1:"")
+3 FOR QAMDFN=0:0
SET QAMDFN=$ORDER(^UTILITY($JOB,"QAM FALL OUT",QAMD0,QAMDFN))
if QAMDFN'>0
QUIT
FOR QAMDATE=0:0
SET QAMDATE=$ORDER(^UTILITY($JOB,"QAM FALL OUT",QAMD0,QAMDFN,QAMDATE))
if QAMDATE'>0
QUIT
DO LOOP1
+4 ; *** CHECK/UPDATE HISTORY FILE
DO EN1^QAMAUTO1
DO EN2^QAMAUTO1
+5 ; *** BULLETIN
DO EN3^QAMAUTO1
+6 ; *** GENERIC LIST OF FALL OUTS
IF $DATA(^UTILITY($JOB,"QAM",QAMD0,"LST"))#2
IF +^("LST")
DO ^QAMAUTO3
+7 ; *** FALL OUT WORKSHEET
IF $DATA(^UTILITY($JOB,"QAM",QAMD0,"WSR"))#2
SET QAM=^("WSR")
IF +QAM
SET X=$PIECE(QAM,"^",2,99)
IF X]""
SET X=$PIECE(X,"^",$LENGTH(X,"^"))
XECUTE ^%ZOSF("TEST")
IF $TEST
XECUTE $PIECE(QAM,"^",2,99)
+8 ; *** FALL OUT SPECIAL FUNCTION ROUTINE
IF $DATA(^UTILITY($JOB,"QAM",QAMD0,"SFR"))#2
SET QAM=^("SFR")
IF +QAM
SET X=$PIECE(QAM,"^",2,99)
IF X]""
SET X=$PIECE(X,"^",$LENGTH(X,"^"))
XECUTE ^%ZOSF("TEST")
IF $TEST
XECUTE $PIECE(QAM,"^",2,99)
+9 QUIT
LOOP1 ;
+1 ; *** DUPLICATE
if ^UTILITY($JOB,"QAM FALL OUT",QAMD0,QAMDFN,QAMDATE)="*"
QUIT
+2 KILL DD,DIC,DINUM,DO
SET DIC="^QA(743.1,"
SET DIC(0)="LM"
SET X=QAMDFN
SET DIC("DR")=".02///`"_QAMD0_";.03///"_QAMDATE_";.04///"_QAMTODAY
SET DLAYGO=743.1
DO FILE^DICN
SET QAMFALL0=+Y
+3 SET QAUDIT("FILE")="743.1^100"
SET QAUDIT("DA")=QAMFALL0
SET QAUDIT("ACTION")="o"
SET QAUDIT("COMMENT")="AUTO ENROLLED FALL OUT"
DO ^QAQAUDIT
+4 if $DATA(^QA(743.1,QAMFALL0,1,0))[0
SET ^QA(743.1,QAMFALL0,1,0)="^743.11PA^^"
+5 FOR QAMDATA=0:0
SET QAMDATA=$ORDER(^UTILITY($JOB,"QAM FALL OUT",QAMD0,QAMDFN,QAMDATE,QAMDATA))
if QAMDATA'>0
QUIT
DO LOOP2
+6 SET DIK="^QA(743.1,"
SET DA=QAMFALL0
DO IX1^DIK
+7 QUIT
LOOP2 ;
+1 SET ^QA(743.1,QAMFALL0,1,QAMDATA,0)=QAMDATA
SET ^QA(743.1,QAMFALL0,1,QAMDATA,"E")=^UTILITY($JOB,"QAM FALL OUT",QAMD0,QAMDFN,QAMDATE,QAMDATA)
+2 QUIT
