- QAMAUTO1 ;HISC/DAD-AUTO ENROLL UTILITIES ;10/22/93 08:39
- ;;1.0;Clinical Monitoring System;**2**;09/13/1993
- EN1 ; *** CHECK HISTORY FILE
- S QAMFRAME=+$P(QAMONE,"^") D EN^QAMTIME0 Q:(QAMSTART'>0)!(QAMEND'>0)
- S QAMHISD0=$O(^QA(743.2,"AA",QAMD0,QAMSTART,QAMEND,0)) Q:QAMHISD0
- ; *** CREATE NEW ENTRY IN HISTORY FILE (#743.2) IF NOT FOUND
- K DD,DIC,DINUM,DO S DIC="^QA(743.2,",DIC(0)="LM",DIC("DR")=".02///^S X=QAMSTART;.03///^S X=QAMEND",DLAYGO=743.2,X=QAMD0 D FILE^DICN S QAMHISD0=+Y
- Q
- EN2 ; *** UPDATE STATS IN THE HISTORY FILE (#743.2)
- S QAMHIST=$S($D(^QA(743.2,+$G(QAMHISD0),0))#2:^(0),1:"") Q:QAMHIST'>0
- S QAMNUMER=+$P(QAMHIST,"^",4)+$S($D(^UTILITY($J,"QAM FALL OUT",QAMD0))#2:^(QAMD0),1:0)
- S QAMDENOM=+$P(QAMHIST,"^",5)+$S($D(^UTILITY($J,"QAM SAMPLE",QAMD0))#2:^(QAMD0),1:0)
- S QAMTHRES=$P(QAMONE,"^",3),QAMHILO=$P(QAMONE,"^",4),QAMMET=0
- I QAMTHRES["%" S PERCENT=$S(QAMDENOM:QAMNUMER/QAMDENOM,1:0)*100,QAMMET=$S(QAMHILO="H"&(PERCENT'<+QAMTHRES):1,QAMHILO="L"&(PERCENT'>+QAMTHRES):1,1:0)
- E S QAMMET=$S(QAMNUMER'<QAMTHRES:1,1:0)
- S DR="1///^S X=QAMNUMER;2///^S X=QAMDENOM;8///^S X=QAMTODAY"
- S X=$S($P(QAMHIST,"^",6)'>0:";3///^S X=QAMMET",1:"")_$S($P(QAMHIST,"^",7)'>0&QAMMET:";4///^S X=QAMTODAY",1:"")
- I QAMTHRES'["%" S DR=DR_X
- E I QAMDENOM'<$P(QAMONE,"^",2) S DR=DR_X
- S DIE="^QA(743.2,",DA=QAMHISD0 D ^DIE
- Q
- EN3 ; *** BULLETIN
- S QAMFRAME=+$P(QAMONE,"^"),QAMFRAME=$S($D(^QA(743.92,QAMFRAME,0))#2:^(0),1:"") D EN^QAMTIME0 Q:(QAMSTART'>0)!(QAMEND'>0)
- S QAMHISD0=$O(^QA(743.2,"AA",QAMD0,QAMSTART,QAMEND,0)) Q:QAMHISD0'>0
- S QAMHIST=$S($D(^QA(743.2,QAMHISD0,0))#2:^(0),1:"") Q:QAMHIST'>0
- S QAMMET=$P(QAMHIST,"^",6),QAMDENOM=$P(QAMHIST,"^",5),QAMNUMER=$P(QAMHIST,"^",4)
- I QAMMET S QAMBULL=1 D 3
- I QAMEND=QAMTODAY S QAMBULL=2 D 3
- I $P(QAMONE,"^",2) D
- . I $P(QAMONE,"^",3)'["%",QAMNUMER'<$P(QAMONE,"^",2) S QAMBULL=3 D 3
- . I $P(QAMONE,"^",3)["%",QAMDENOM'<$P(QAMONE,"^",2) S QAMBULL=3 D 3
- . Q
- D KILL^XM
- Q
- 3 Q:$P(QAMONE,"^",QAMBULL+9)'>0 Q:$P(QAMHIST,"^",QAMBULL+7)>0
- D KILL^XM S XMB(6)=$P(QAMONE,"^",3),XMB=$S(XMB(6)["%":"QAM MONITOR TOOL 1",1:"QAM MONITOR TOOL 2"),XMDUZ="CLINICAL MONITORING SYSTEM"
- S QAM=$P($T(MESSAGE+$S((QAMBULL=3)&(XMB(6)'["%"):QAMBULL+1,1:QAMBULL)),";;",2),XMB(1)=$P(QAM,"^"),XMB(3)=$P(QAM,"^",2)
- S XMB(2)=$P(QAMZERO,"^")_$S($P(QAMZERO,"^",4):" (a)",1:" (m)"),XMB(4)=$P(QAMZERO,"^",2),XMB(5)=$P(QAMFRAME,"^"),XMB(7)=$P(QAMONE,"^",2)
- S XMB(8)=$P(QAMHIST,"^",4),XMB(9)=$P(QAMHIST,"^",5),XMB(10)=$S(XMB(9):$J(XMB(8)/XMB(9)*100,7,3)_"%",1:"Division by zero!"),Y=$P(QAMHIST,"^",7) X ^DD("DD") S XMB(11)=$S(Y]"":Y,1:"N/A")
- S (Y,QAMGROUP)=+$P(QAMONE,"^",13),C=$P(^DD(743,62,0),"^",2) D Y^DIQ
- S QAMGROUP=$S(QAMGROUP'=Y:Y,1:""),QAMDOM=$G(^XMB("NETNAME"))
- Q:(QAMGROUP="")!(QAMDOM="") S XMY("G."_QAMGROUP_"@"_QAMDOM)=""
- D ^XMB K DA,DIC,DR S DIE="^QA(743.2,",DR=(QAMBULL+4)_"///1",DA=QAMHISD0 D ^DIE
- Q
- MESSAGE ;;*** SUBJECT ^ FIRST LINE
- ;;THRESHOLD MET^The THRESHOLD has been met/exceeded for the following monitor.
- ;;TIME FRAME EXPIRED^The TIME FRAME has expired for the following monitor.
- ;;MINIMUM SAMPLE MET^The MINIMUM SAMPLE SIZE has been met/exceeded for the following monitor.
- ;;ALERT LEVEL MET^The PRE-THRESHOLD ALERT LEVEL has been met/exceeded for the following monitor.
- ;
- EN4 ; *** AUTO RUN DATES FILE, DATE
- K DD,DIC,DINUM,DO S DIC="^QA(743.6,",DIC(0)="LMN",DLAYGO=743.6,X=QAMTODAY D ^DIC K DIC S QAMARUN=+Y
- Q
- EN5 ; *** AUTO RUN DATES FILE, MONITOR
- K DA,DD,DIC,DINUM,DO S DIC="^QA(743.6,"_QAMARUN_",1,",DIC(0)="LMN",DIC("DR")="1///T",DLAYGO=743.6,(D0,DA(1))=QAMARUN,X=QAMD0
- S:$D(^QA(743.6,QAMARUN,1,0))[0 ^(0)="^743.61PA^^" D FILE^DICN K DIC
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAMAUTO1 3665 printed Feb 18, 2025@23:08:08 Page 2
- QAMAUTO1 ;HISC/DAD-AUTO ENROLL UTILITIES ;10/22/93 08:39
- +1 ;;1.0;Clinical Monitoring System;**2**;09/13/1993
- EN1 ; *** CHECK HISTORY FILE
- +1 SET QAMFRAME=+$PIECE(QAMONE,"^")
- DO EN^QAMTIME0
- if (QAMSTART'>0)!(QAMEND'>0)
- QUIT
- +2 SET QAMHISD0=$ORDER(^QA(743.2,"AA",QAMD0,QAMSTART,QAMEND,0))
- if QAMHISD0
- QUIT
- +3 ; *** CREATE NEW ENTRY IN HISTORY FILE (#743.2) IF NOT FOUND
- +4 KILL DD,DIC,DINUM,DO
- SET DIC="^QA(743.2,"
- SET DIC(0)="LM"
- SET DIC("DR")=".02///^S X=QAMSTART;.03///^S X=QAMEND"
- SET DLAYGO=743.2
- SET X=QAMD0
- DO FILE^DICN
- SET QAMHISD0=+Y
- +5 QUIT
- EN2 ; *** UPDATE STATS IN THE HISTORY FILE (#743.2)
- +1 SET QAMHIST=$SELECT($DATA(^QA(743.2,+$GET(QAMHISD0),0))#2:^(0),1:"")
- if QAMHIST'>0
- QUIT
- +2 SET QAMNUMER=+$PIECE(QAMHIST,"^",4)+$SELECT($DATA(^UTILITY($JOB,"QAM FALL OUT",QAMD0))#2:^(QAMD0),1:0)
- +3 SET QAMDENOM=+$PIECE(QAMHIST,"^",5)+$SELECT($DATA(^UTILITY($JOB,"QAM SAMPLE",QAMD0))#2:^(QAMD0),1:0)
- +4 SET QAMTHRES=$PIECE(QAMONE,"^",3)
- SET QAMHILO=$PIECE(QAMONE,"^",4)
- SET QAMMET=0
- +5 IF QAMTHRES["%"
- SET PERCENT=$SELECT(QAMDENOM:QAMNUMER/QAMDENOM,1:0)*100
- SET QAMMET=$SELECT(QAMHILO="H"&(PERCENT'<+QAMTHRES):1,QAMHILO="L"&(PERCENT'>+QAMTHRES):1,1:0)
- +6 IF '$TEST
- SET QAMMET=$SELECT(QAMNUMER'<QAMTHRES:1,1:0)
- +7 SET DR="1///^S X=QAMNUMER;2///^S X=QAMDENOM;8///^S X=QAMTODAY"
- +8 SET X=$SELECT($PIECE(QAMHIST,"^",6)'>0:";3///^S X=QAMMET",1:"")_$SELECT($PIECE(QAMHIST,"^",7)'>0&QAMMET:";4///^S X=QAMTODAY",1:"")
- +9 IF QAMTHRES'["%"
- SET DR=DR_X
- +10 IF '$TEST
- IF QAMDENOM'<$PIECE(QAMONE,"^",2)
- SET DR=DR_X
- +11 SET DIE="^QA(743.2,"
- SET DA=QAMHISD0
- DO ^DIE
- +12 QUIT
- EN3 ; *** BULLETIN
- +1 SET QAMFRAME=+$PIECE(QAMONE,"^")
- SET QAMFRAME=$SELECT($DATA(^QA(743.92,QAMFRAME,0))#2:^(0),1:"")
- DO EN^QAMTIME0
- if (QAMSTART'>0)!(QAMEND'>0)
- QUIT
- +2 SET QAMHISD0=$ORDER(^QA(743.2,"AA",QAMD0,QAMSTART,QAMEND,0))
- if QAMHISD0'>0
- QUIT
- +3 SET QAMHIST=$SELECT($DATA(^QA(743.2,QAMHISD0,0))#2:^(0),1:"")
- if QAMHIST'>0
- QUIT
- +4 SET QAMMET=$PIECE(QAMHIST,"^",6)
- SET QAMDENOM=$PIECE(QAMHIST,"^",5)
- SET QAMNUMER=$PIECE(QAMHIST,"^",4)
- +5 IF QAMMET
- SET QAMBULL=1
- DO 3
- +6 IF QAMEND=QAMTODAY
- SET QAMBULL=2
- DO 3
- +7 IF $PIECE(QAMONE,"^",2)
- Begin DoDot:1
- +8 IF $PIECE(QAMONE,"^",3)'["%"
- IF QAMNUMER'<$PIECE(QAMONE,"^",2)
- SET QAMBULL=3
- DO 3
- +9 IF $PIECE(QAMONE,"^",3)["%"
- IF QAMDENOM'<$PIECE(QAMONE,"^",2)
- SET QAMBULL=3
- DO 3
- +10 QUIT
- End DoDot:1
- +11 DO KILL^XM
- +12 QUIT
- 3 if $PIECE(QAMONE,"^",QAMBULL+9)'>0
- QUIT
- if $PIECE(QAMHIST,"^",QAMBULL+7)>0
- QUIT
- +1 DO KILL^XM
- SET XMB(6)=$PIECE(QAMONE,"^",3)
- SET XMB=$SELECT(XMB(6)["%":"QAM MONITOR TOOL 1",1:"QAM MONITOR TOOL 2")
- SET XMDUZ="CLINICAL MONITORING SYSTEM"
- +2 SET QAM=$PIECE($TEXT(MESSAGE+$SELECT((QAMBULL=3)&(XMB(6)'["%"):QAMBULL+1,1:QAMBULL)),";;",2)
- SET XMB(1)=$PIECE(QAM,"^")
- SET XMB(3)=$PIECE(QAM,"^",2)
- +3 SET XMB(2)=$PIECE(QAMZERO,"^")_$SELECT($PIECE(QAMZERO,"^",4):" (a)",1:" (m)")
- SET XMB(4)=$PIECE(QAMZERO,"^",2)
- SET XMB(5)=$PIECE(QAMFRAME,"^")
- SET XMB(7)=$PIECE(QAMONE,"^",2)
- +4 SET XMB(8)=$PIECE(QAMHIST,"^",4)
- SET XMB(9)=$PIECE(QAMHIST,"^",5)
- SET XMB(10)=$SELECT(XMB(9):$JUSTIFY(XMB(8)/XMB(9)*100,7,3)_"%",1:"Division by zero!")
- SET Y=$PIECE(QAMHIST,"^",7)
- XECUTE ^DD("DD")
- SET XMB(11)=$SELECT(Y]"":Y,1:"N/A")
- +5 SET (Y,QAMGROUP)=+$PIECE(QAMONE,"^",13)
- SET C=$PIECE(^DD(743,62,0),"^",2)
- DO Y^DIQ
- +6 SET QAMGROUP=$SELECT(QAMGROUP'=Y:Y,1:"")
- SET QAMDOM=$GET(^XMB("NETNAME"))
- +7 if (QAMGROUP="")!(QAMDOM="")
- QUIT
- SET XMY("G."_QAMGROUP_"@"_QAMDOM)=""
- +8 DO ^XMB
- KILL DA,DIC,DR
- SET DIE="^QA(743.2,"
- SET DR=(QAMBULL+4)_"///1"
- SET DA=QAMHISD0
- DO ^DIE
- +9 QUIT
- MESSAGE ;;*** SUBJECT ^ FIRST LINE
- +1 ;;THRESHOLD MET^The THRESHOLD has been met/exceeded for the following monitor.
- +2 ;;TIME FRAME EXPIRED^The TIME FRAME has expired for the following monitor.
- +3 ;;MINIMUM SAMPLE MET^The MINIMUM SAMPLE SIZE has been met/exceeded for the following monitor.
- +4 ;;ALERT LEVEL MET^The PRE-THRESHOLD ALERT LEVEL has been met/exceeded for the following monitor.
- +5 ;
- EN4 ; *** AUTO RUN DATES FILE, DATE
- +1 KILL DD,DIC,DINUM,DO
- SET DIC="^QA(743.6,"
- SET DIC(0)="LMN"
- SET DLAYGO=743.6
- SET X=QAMTODAY
- DO ^DIC
- KILL DIC
- SET QAMARUN=+Y
- +2 QUIT
- EN5 ; *** AUTO RUN DATES FILE, MONITOR
- +1 KILL DA,DD,DIC,DINUM,DO
- SET DIC="^QA(743.6,"_QAMARUN_",1,"
- SET DIC(0)="LMN"
- SET DIC("DR")="1///T"
- SET DLAYGO=743.6
- SET (D0,DA(1))=QAMARUN
- SET X=QAMD0
- +2 if $DATA(^QA(743.6,QAMARUN,1,0))[0
- SET ^(0)="^743.61PA^^"
- DO FILE^DICN
- KILL DIC
- +3 QUIT