QAMAUTO2.m

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 ---QAMAUTO2   1708     printed  Apr 09, 2024@20:47:13                                                                                                                                                                                                    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