- 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 Feb 18, 2025@23:08:09 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