source: FOIAVistA/trunk/r/CLINICAL_MONITORING_SYSTEM-QAM/QAMAUTO1.m@ 1288

Last change on this file since 1288 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 3.5 KB
Line 
1QAMAUTO1 ;HISC/DAD-AUTO ENROLL UTILITIES ;10/22/93 08:39
2 ;;1.0;Clinical Monitoring System;**2**;09/13/1993
3EN1 ; *** CHECK HISTORY FILE
4 S QAMFRAME=+$P(QAMONE,"^") D EN^QAMTIME0 Q:(QAMSTART'>0)!(QAMEND'>0)
5 S QAMHISD0=$O(^QA(743.2,"AA",QAMD0,QAMSTART,QAMEND,0)) Q:QAMHISD0
6 ; *** CREATE NEW ENTRY IN HISTORY FILE (#743.2) IF NOT FOUND
7 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
8 Q
9EN2 ; *** UPDATE STATS IN THE HISTORY FILE (#743.2)
10 S QAMHIST=$S($D(^QA(743.2,+$G(QAMHISD0),0))#2:^(0),1:"") Q:QAMHIST'>0
11 S QAMNUMER=+$P(QAMHIST,"^",4)+$S($D(^UTILITY($J,"QAM FALL OUT",QAMD0))#2:^(QAMD0),1:0)
12 S QAMDENOM=+$P(QAMHIST,"^",5)+$S($D(^UTILITY($J,"QAM SAMPLE",QAMD0))#2:^(QAMD0),1:0)
13 S QAMTHRES=$P(QAMONE,"^",3),QAMHILO=$P(QAMONE,"^",4),QAMMET=0
14 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)
15 E S QAMMET=$S(QAMNUMER'<QAMTHRES:1,1:0)
16 S DR="1///^S X=QAMNUMER;2///^S X=QAMDENOM;8///^S X=QAMTODAY"
17 S X=$S($P(QAMHIST,"^",6)'>0:";3///^S X=QAMMET",1:"")_$S($P(QAMHIST,"^",7)'>0&QAMMET:";4///^S X=QAMTODAY",1:"")
18 I QAMTHRES'["%" S DR=DR_X
19 E I QAMDENOM'<$P(QAMONE,"^",2) S DR=DR_X
20 S DIE="^QA(743.2,",DA=QAMHISD0 D ^DIE
21 Q
22EN3 ; *** BULLETIN
23 S QAMFRAME=+$P(QAMONE,"^"),QAMFRAME=$S($D(^QA(743.92,QAMFRAME,0))#2:^(0),1:"") D EN^QAMTIME0 Q:(QAMSTART'>0)!(QAMEND'>0)
24 S QAMHISD0=$O(^QA(743.2,"AA",QAMD0,QAMSTART,QAMEND,0)) Q:QAMHISD0'>0
25 S QAMHIST=$S($D(^QA(743.2,QAMHISD0,0))#2:^(0),1:"") Q:QAMHIST'>0
26 S QAMMET=$P(QAMHIST,"^",6),QAMDENOM=$P(QAMHIST,"^",5),QAMNUMER=$P(QAMHIST,"^",4)
27 I QAMMET S QAMBULL=1 D 3
28 I QAMEND=QAMTODAY S QAMBULL=2 D 3
29 I $P(QAMONE,"^",2) D
30 . I $P(QAMONE,"^",3)'["%",QAMNUMER'<$P(QAMONE,"^",2) S QAMBULL=3 D 3
31 . I $P(QAMONE,"^",3)["%",QAMDENOM'<$P(QAMONE,"^",2) S QAMBULL=3 D 3
32 . Q
33 D KILL^XM
34 Q
353 Q:$P(QAMONE,"^",QAMBULL+9)'>0 Q:$P(QAMHIST,"^",QAMBULL+7)>0
36 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"
37 S QAM=$P($T(MESSAGE+$S((QAMBULL=3)&(XMB(6)'["%"):QAMBULL+1,1:QAMBULL)),";;",2),XMB(1)=$P(QAM,"^"),XMB(3)=$P(QAM,"^",2)
38 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)
39 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")
40 S (Y,QAMGROUP)=+$P(QAMONE,"^",13),C=$P(^DD(743,62,0),"^",2) D Y^DIQ
41 S QAMGROUP=$S(QAMGROUP'=Y:Y,1:""),QAMDOM=$G(^XMB("NETNAME"))
42 Q:(QAMGROUP="")!(QAMDOM="") S XMY("G."_QAMGROUP_"@"_QAMDOM)=""
43 D ^XMB K DA,DIC,DR S DIE="^QA(743.2,",DR=(QAMBULL+4)_"///1",DA=QAMHISD0 D ^DIE
44 Q
45MESSAGE ;;*** SUBJECT ^ FIRST LINE
46 ;;THRESHOLD MET^The THRESHOLD has been met/exceeded for the following monitor.
47 ;;TIME FRAME EXPIRED^The TIME FRAME has expired for the following monitor.
48 ;;MINIMUM SAMPLE MET^The MINIMUM SAMPLE SIZE has been met/exceeded for the following monitor.
49 ;;ALERT LEVEL MET^The PRE-THRESHOLD ALERT LEVEL has been met/exceeded for the following monitor.
50 ;
51EN4 ; *** AUTO RUN DATES FILE, DATE
52 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
53 Q
54EN5 ; *** AUTO RUN DATES FILE, MONITOR
55 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
56 S:$D(^QA(743.6,QAMARUN,1,0))[0 ^(0)="^743.61PA^^" D FILE^DICN K DIC
57 Q
Note: See TracBrowser for help on using the repository browser.