source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLEMDD.m@ 1005

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

initial load of WorldVistAEHR

File size: 5.3 KB
Line 
1HLEMDD ;ALB/CJM-HL7 - M CODE FOUND IN THE DD'S ;02/04/2004
2 ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
3 ;
4 ;
5KILLAH(IEN) ;kills the AH x~ref on file 776.4 or a particular event=ien
6 Q:'$G(IEN)
7 N NEXT,LOCATION
8 S NEXT=""
9 F S NEXT=$O(^HLEV(776.4,"AH KILL",IEN,NEXT)) Q:'$L(NEXT) D
10 .S LOCATION="^HLEV(776.4,""AH"","_NEXT
11 .K @LOCATION
12 K ^HLEV(776.4,"AH KILL",IEN)
13 Q
14 ;
15SETID(IEN) ;sets the value of the ID field in the EVENT
16 ;Input: IEN is the ien of the Monitor Event
17 ;Output: none
18 ;
19 Q:'$G(IEN)
20 Q:'$D(^HLEV(776.4,IEN,0))
21 S $P(^HLEV(776.4,IEN,0),"^",4)=$$STATNUM^HLEMU_"-"_IEN
22 Q
23 ;
24STATUS(IEN,STATUS) ;
25 ;if the REVIEW STATUS is REQUIRED ONLY IF ACTION FAILS then when the ACTION STATUS field changes the REVIEW STATUS is updated appropriately
26 ;
27 ;
28 Q:'$G(IEN)
29 Q:($G(STATUS)<3)
30 N NODE,REVIEW
31 S NODE=$G(^HLEV(776.4,IEN,0))
32 S REVIEW=$P(NODE,"^",6)
33 I REVIEW=2 D
34 .I STATUS=3 S $P(^HLEV(776.4,IEN,0),"^",6)=0
35 .I STATUS=4 S $P(^HLEV(776.4,IEN,0),"^",6)=1
36 Q
37 ;
38ADDSTAT(NEWTIME,OLDSITE,SITE,TYPE,STATUS,COUNT) ;
39 ;Description - add logic for the AF x~ref on the Monitor Event file.
40 ;Maintains statistics for events.
41 ;Input:
42 ; NEWTIME - new value of the .01 field (DT/TM)
43 ; OLDSITE - old value of the SITE field
44 ; SITE - new value of the SITE field
45 ; TYPE - new value of the TYPE field
46 ; STATUS - new value of the REVIEW STATUS field
47 ; COUNT - the new value of the COUNT field
48 ;Output: see DD for description of the AF x~ref
49 ;
50 Q:'($G(NEWTIME)&$G(SITE)&$G(TYPE)&$L($G(STATUS)))
51 ;
52 N INDEX
53 S INDEX="^HLEV(776.4,""AF"",SITE,TYPE)"
54 ;
55 ;COUNT must be ast least 1
56 S COUNT=$G(COUNT,1)
57 ;
58 I '$G(OLDSITE) D
59 .N YEAR,MONTH,DAY,HOUR
60 .S YEAR=$$YEAR(NEWTIME),MONTH=$$MONTH(NEWTIME),DAY=$$DAY(NEWTIME),HOUR=$$HOUR(NEWTIME)
61 .I YEAR,$$I^HLEMU($NA(@INDEX@("RECEIVED","YEAR",YEAR)),COUNT) D
62 ..I MONTH,$$I^HLEMU($NA(@INDEX@("RECEIVED","YEAR",YEAR,"MONTH",MONTH)),COUNT) D
63 ...I DAY,$$I^HLEMU($NA(@INDEX@("RECEIVED","YEAR",YEAR,"MONTH",MONTH,"DAY",DAY)),COUNT) D
64 ....I HOUR,$$I^HLEMU($NA(@INDEX@("RECEIVED","YEAR",YEAR,"MONTH",MONTH,"DAY",DAY,"HOUR",HOUR)),COUNT)
65 I $$I^HLEMU($NA(@INDEX@(STATUS)),COUNT)
66 Q
67 ;
68DELSTAT(SITE,TYPE,STATUS,COUNT) ;
69 ;Description - delete logic for the AF x~ref on the Monitor Event file.
70 ;Maintains statistics for events.
71 ;Input:
72 ; SITE - old value of the SITE field
73 ; TYPE - old value of the TYPE field
74 ; STATUS - old value of the REVIEW STATUS field
75 ; COUNT - old value fo the COUNT field
76 ;Output: see DD for description of the AF x~ref
77 ;
78 Q:'($G(SITE)&$G(TYPE)&$L($G(STATUS)))
79 ;
80 ;COUNT must be at least 1
81 S COUNT=$G(COUNT,1)
82 ;
83 N INDEX
84 S INDEX="^HLEV(776.4,""AF"",SITE,TYPE,STATUS)"
85 I $$I^HLEMU($NA(@INDEX),-COUNT)
86 Q
87 ;
88YEAR(FMDATE) ;returns the year (i.e., "2003", not in FM format)
89 Q $S($G(FMDATE):1700+$E(FMDATE,1,3),1:"")
90MONTH(FMDATE) ;returns the month (1-12)
91 Q $S($G(FMDATE):+$E(FMDATE,4,5),1:"")
92DAY(FMDATE) ;returns the day (1 - 31)
93 Q $S($G(FMDATE):+$E(FMDATE,6,7),1:"")
94HOUR(FMDATE) ;returns the hour (1-24
95 Q $S($G(FMDATE):+$E($P(FMDATE,".",2),1,2),1:"")
96 ;
97URGENCY(EVENT,URGENT,ACTION,REVIEW) ;
98 ;Description- changes the urgency as the action status and review status change.
99 ;
100 Q:'$G(EVENT)
101 I $G(URGENT)=2,$G(ACTION)=4 S $P(^HLEV(776.4,EVENT,0),"^",12)=1
102 I $G(URGENT)=2,$G(ACTION)=3 S $P(^HLEV(776.4,EVENT,0),"^",12)=0
103 I $G(REVIEW)=4 S $P(^HLEV(776.4,EVENT,0),"^",12)=0
104 Q
105 ;
106DEFAULT(PROFILE,DUZ,DEFAULT) ;
107 ;Description - maintains the "AC" x~ref on file 776.5, Event Log Prfofiles, insuring that each use has only one profile marked his default
108 ;
109 Q:'$G(PROFILE)
110 Q:'$G(DUZ)
111 Q:'$D(DEFAULT)
112 I $G(DEFAULT) D
113 .N PROF
114 .S PROF=""
115 .F S PROF=$O(^HLEV(776.5,"AC",DUZ,PROF)) Q:'PROF D
116 ..S $P(^HLEV(776.5,PROF,0),"^",3)=0
117 ..K ^HLEV(776.5,"AC",DUZ,PROF)
118 .S ^HLEV(776.5,"AC",DUZ,PROFILE)=""
119 E D
120 .K ^HLEV(776.5,"AC",DUZ,PROFILE)
121 Q
122 ;
123CSTATUS(EVENT,STATUS) ;
124 ;This is the trigger logic of the AI index for file 776.4. If the event
125 ;status changes to COMPLETED, the DT/TM REVIEWED field is set to NOW
126 ;and the REVIEWER field is set to DUZ, if defined.
127 ;
128 Q:'$G(EVENT)
129 Q:$G(STATUS)'=4
130 S $P(^HLEV(776.4,EVENT,0),"^",7)=$$NOW^XLFDT
131 S $P(^HLEV(776.4,EVENT,0),"^",8)=$G(DUZ)
132 Q
133 ;
134SETPURGE(EVENT,WHEN,TYPE) ;
135 ;Sets the earliest purge date into the AJ index on file 776.4
136 ;Input:
137 ; EVENT - IEN of the event
138 ; WHEN - .01 FIELD (DT/TM)
139 ; TYPE - .02 field - event type
140 ;
141 Q:'$G(EVENT)
142 Q:'$G(WHEN)
143 Q:'$G(TYPE)
144 ;
145 N WAIT,PWHEN
146 S WAIT=$P($G(^HLEV(776.3,TYPE,0)),"^",9)
147 Q:'WAIT
148 S PDATE=$$FMADD^XLFDT(WHEN,WAIT\1)
149 S ^HLEV(776.4,"AJ",PDATE,EVENT)=""
150 Q
151 ;
152DELPURGE(EVENT,WHEN,TYPE) ;
153 ;kill logic fo the AJ index of file 776.4
154 ;Input:
155 ; EVENT - IEN of the event
156 ; WHEN - .01 FIELD (DT/TM)
157 ; TYPE - .02 field - event type
158 ;
159 Q:'$G(EVENT)
160 Q:'$G(WHEN)
161 Q:'$G(TYPE)
162 ;
163 N WAIT,PWHEN
164 S WAIT=$P($G(^HLEV(776.3,TYPE,0)),"^",9)
165 Q:'WAIT
166 S PDATE=$$FMADD^XLFDT(WHEN,WAIT\1)
167 K ^HLEV(776.4,"AJ",PDATE,EVENT)
168 Q
169 ;
170SETPKG(ETYPE,PACKAGE,OLDNAME) ;
171 ;Given a ptr to the event type and package, it sets the PACKAGE NAME
172 ;field to the name of the package. Also maintains the index that
173 ;PACKAGE NAME is part of
174 ;
175 Q:'$G(ETYPE)
176 Q:'$G(PACKAGE)
177 N NAME,NODE
178 S NAME=$P($G(^DIC(9.4,PACKAGE,0)),"^")
179 S $P(^HLEV(776.3,ETYPE,0),"^",8)=NAME
180 S NODE=$G(^HLEV(776.3,ETYPE,0))
181 I $L($G(OLDNAME)),$L($P(NODE,"^")) K ^HLEV("AC",$P(NODE,"^"),OLDNAME)
182 I $L(NAME),$L($P(NODE,"^")) S ^HLEV("AC",$P(NODE,"^"),NAME)=ETYPE
183 Q
Note: See TracBrowser for help on using the repository browser.