Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: QAMAUTO2

QAMAUTO2.m

Go to the documentation of this file.
  1. QAMAUTO2 ;HISC/DAD-AUTO ENROLL POPULATE FALL OUT FILE ;6/18/93 14:57
  1. ;;1.0;Clinical Monitoring System;;09/13/1993
  1. S QAMZERO=$S($D(^QA(743,QAMD0,0))#2:^(0),1:""),QAMONE=$S($D(^QA(743,QAMD0,1))#2:^(1),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
  1. D EN1^QAMAUTO1,EN2^QAMAUTO1 ; *** CHECK/UPDATE HISTORY FILE
  1. D EN3^QAMAUTO1 ; *** BULLETIN
  1. I $D(^UTILITY($J,"QAM",QAMD0,"LST"))#2,+^("LST") D ^QAMAUTO3 ; *** GENERIC LIST OF FALL OUTS
  1. 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
  1. 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
  1. Q
  1. LOOP1 ;
  1. Q:^UTILITY($J,"QAM FALL OUT",QAMD0,QAMDFN,QAMDATE)="*" ; *** DUPLICATE
  1. 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
  1. S QAUDIT("FILE")="743.1^100",QAUDIT("DA")=QAMFALL0,QAUDIT("ACTION")="o",QAUDIT("COMMENT")="AUTO ENROLLED FALL OUT" D ^QAQAUDIT
  1. S:$D(^QA(743.1,QAMFALL0,1,0))[0 ^QA(743.1,QAMFALL0,1,0)="^743.11PA^^"
  1. F QAMDATA=0:0 S QAMDATA=$O(^UTILITY($J,"QAM FALL OUT",QAMD0,QAMDFN,QAMDATE,QAMDATA)) Q:QAMDATA'>0 D LOOP2
  1. S DIK="^QA(743.1,",DA=QAMFALL0 D IX1^DIK
  1. Q
  1. LOOP2 ;
  1. 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)
  1. Q