source: FOIAVistA/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCHL7U.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 5.6 KB
Line 
1GMRCHL7U ;SLC/DCM,MA - Utilities assoc. with HL7 messages ;11/8/02 17:18
2 ;;3.0;CONSULT/REQUEST TRACKING;**1,5,12,21,22,29**;DEC 27, 1997
3 ; Patch #21 added more variables to in line tage EXIT.
4 ;
5 ; This routine invokes IA #872
6 ;
7INIT(MSH) ;break out MSH segment separators and set other needed variables
8 ;MSH = MSH segment of the HL-7 message
9 N X
10 S (SEP1,SEP2,SEP3,SEP4,SEP5)=""
11 S SEP1=$E(MSH,4),X=$P(MSH,SEP1,2)
12 S SEP2=$E(X,1),SEP3=$E(X,2),SEP4=$E(X,3),SEP5=$E(X,4)
13 Q
14PID(GMRCPID) ;Get fields from PID segment and set into GMRC variables.
15 S DFN=$P(GMRCPID,SEP1,4),GMRCPNM=$P(GMRCPID,SEP1,6)
16 Q
17NTE(MSG,GMRCNTE,GMRCNODE,CTRLCODE) ;set NTE segments of HL-7 message into variables and globals
18 ;MSG = whole HL-7 array.
19 ;GMRCNTE = Node in array where NTE message begins
20 ;CTRLCODE = segment 1 of the ORC segment of HL-7 message
21 ;GMRCNODE = IEN of entry int file ^GMR(123,
22 N GMRCACT ;not sure why this is newed here
23 S GMRCAD=$G(GMRCAD),GMRCORNP=$G(GMRCORNP),GMRCFF=$G(GMRCFF),GMRCPA=$G(GMRCPA),GMRCDEV=$G(GMRCDEV)
24 S GMRCACT=$S(CTRLCODE="CA":19,CTRLCODE="DC":6,CTRLCODE="NW":1,1:$O(^GMR(123.1,"D",CTRLCODE,0)))
25 S GMRCNTC(1)=$P(MSG(GMRCNTE),SEP1,4)
26 S LN=0,LN1=2 F S LN=$O(MSG(GMRCNTE,LN)) Q:LN="" S GMRCNTC(LN1)=MSG(GMRCNTE,LN),LN1=LN1+1
27 K LN,LN1
28 Q
29PV1(GMRCPV1) ;Get fields from PV1 segment of HL-7 message and set into GMRC variables
30 ;GMRCRB = patients room/bed GMRCWARD=patients ward
31 ;GMRCSBR = service basis to be rendered (Inpatient or Outpatient)
32 N X
33 S X=$P(GMRCPV1,SEP1,3),GMRCSBR=$S(X]"":X,1:"")
34 S X=$P(GMRCPV1,SEP1,4),GMRCWARD=$S($P(X,SEP2,1)]"":$P(X,SEP2,1),1:""),VISIT=$S($P(GMRCPV1,SEP1,20)]"":$P(GMRCPV1,SEP1,20),1:"")
35 S GMRCRB=$S($P(X,SEP2,2)]"":$P(X,SEP2,2),1:"")
36 S:VISIT]"" GMRCVSIT=$$FMDATE^GMRCHL7(VISIT)
37 Q
38 ;
39REJECT(GMRCMSG,REAS) ;action can't be filed send reject message
40 N MSH,ORC,I ;GMRCMESS
41 S I=0 F S I=$O(GMRCMSG(I)) Q:'I D
42 . I $P(GMRCMSG(I),"|")="PID" S PID=GMRCMSG(I)
43 . I $P(GMRCMSG(I),"|")="ORC" D
44 .. N ORFN,GMRCFN,P17,CTRLCD
45 .. S ORFN=$P(GMRCMSG(I),"|",3),GMRCFN=$P(GMRCMSG(I),"|",4)
46 .. S CTRLCD=$P(GMRCMSG(I),"|",2)
47 .. S ORC="ORC|"_$S(CTRLCD="NW":"UA",1:"UD")_"|"_ORFN_"|"_GMRCFN
48 .. S P17=$S($D(REAS):REAS,1:"UNABLE TO FILE ACTION")
49 .. S $P(ORC,"|",17)="X^REJECTED^99ORN^^"_P17
50 S MSH=$$MSH^GMRCHL7
51 S $P(MSH,SEP1,9)="ORR"
52 S GMRCMESS(1)=MSH
53 S GMRCMESS(2)=PID
54 S GMRCMESS(3)=ORC
55 D MSG^XQOR("GMRC EVSEND OR",.GMRCMESS)
56 Q
57 ;
58RETURN(GMRCIEN,GMRCTRLC) ;return IEN of record in ^GMR(123,IEN, to OERR
59 ;GMRCIEN = internal record number of record in ^GMR(123,
60 ;GMRCTRLC=Control code from HL-7 Table 119
61 N MSH,PID,ORC,GMRCORCC
62 S SEP1="|",GMRCORCC=$S(GMRCTRLC="NW":"OK",GMRCTRLC="DC":"DR",1:"OK")
63 S MSH=$$MSH^GMRCHL7($G(X)) S $P(MSH,SEP1,9)="ORR"
64 S PID=$$PID^GMRCHL7(GMRCIEN)
65 D ORC^GMRCHL7(GMRCIEN,GMRCORCC,"") S ORC=$P(ORC,"|",1,4)
66 D BLD^GMRCHL7(MSH,PID,"",ORC,"","",,"",GMRCTRLC)
67 D MSG^XQOR("GMRC EVSEND OR",.GMRCMSG)
68 Q
69FILE(GMRCO,DR) ;File data into ^GMR(123,IEN,40 using ^DIE
70 N DIE,DA,GMRCACTI
71 ;GMRCO = IEN of record from file ^GMR(123,
72 ;DR = DR string required by ^DIE
73 Q:'$G(GMRCO)
74 L +^GMR(123,+GMRCO,40) S:'$D(^GMR(123,+GMRCO,40,0)) ^(0)="^123.02DA^^"
75 S (DA,GMRCACTI)=$S($P(^GMR(123,+GMRCO,40,0),"^",3):$P(^(0),"^",3)+1,1:1),DA(1)=+GMRCO
76 S DIE="^GMR(123,"_GMRCO_",40,"
77 S $P(^GMR(123,+GMRCO,40,0),"^",3,4)=DA_"^"_DA
78 D ^DIE
79 I $D(GMRCNTC) D COMMENT^GMRCHL7B(.GMRCNTC)
80 I $D(GMRCCMT) D COMMENT^GMRCHL7B(.GMRCCMT)
81 D ; if record is an IFC build and send update
82 . I '$D(^GMR(123,GMRCO,12)) Q
83 . D TRIGR^GMRCIEVT(GMRCO,GMRCACTI)
84 L -^GMR(123,+GMRCO,40)
85 Q
86EXIT ;Kill variables and exit
87 K HLQ,J,LN,ND,ND1,ND2,SEP1,SEP2,SEP3,SEP4,SEP5
88 K GMRCA,GMRCACT,GMRCAD,GMRCAP,GMRCAPP,GMRCATN,GMRCDA,GMRCDEV,GMRCFAC,GMRCFF,GMRCINTR,GMRCMTP,GMRCMSG,GMRCMSH,GMRCNOD,GMRCNTC,GMRCODT,GMRCOID,GMRCORFN,GMRCPA,GMRCPLCR,GMRCPLI,GMRCPNM,GMRCPR,GMRCPRI,GMRCFQ
89 K GMRCPRDG,GMRCSEND,GMRCSTDT,GMRCSTS,GMRCURGI,GMRCVAL,GMRCVTYP,GMRCWARD,GMRCPRV,GMRCTYPE,GMRCND,GMRCND1,VISIT
90 K GMRCRB,GMRCPRA,GMRCRFQ,MSH,OBXND,PID,GMRCORPV,GMRCOTXT,GMRCNATO
91 K GMRCOFN,GMRCS123,GMRCS38,GMRCCMT
92 K GMRCTRLC,GMRCSS,GMRCO,GMRCORNP
93 Q
94AUDIT0 ;place activity audit tracking info into global ^GMR(123,IEN,40,
95 ;GMRCACT=processing activity (from ^GMR(123.1,
96 ;GMRCDA=date/time file entered GMRCAD=date/time activity took place
97 ;GMRCORNP=name of provider GMRCFF=forwared from (if forwarded)
98 ;GMRCPA=provider previously assigned
99 ;GMRCDEV=device printed to GMRCCMT=comment array from OBX segment
100 N GMRCDA
101 S GMRCDA=$$NOW^XLFDT
102 L +^GMR(123,+GMRCO,40) S:'$D(^GMR(123,+GMRCO,40,0)) ^GMR(123,+GMRCO,40,0)="^123.02DA^^"
103 S GMRCAD=$S($D(GMRCAD):GMRCAD,1:GMRCDA),GMRCORNP=$G(GMRCORNP),GMRCFF=$G(GMRCFF),GMRCPA=$G(GMRCPA),GMRCDEV=$G(GMRCDEV),GMRCPLCR=$G(GMRCPLCR)
104 ;Use the Control code from CPRS in 123.1 to determine the action.
105 ;If action undefined, then use "ADDED COMMENT", entry 20.
106 S GMRCACT=$O(^GMR(123.1,"D",GMRCTRLC,0))
107 S:'GMRCACT GMRCACT=20
108 S DR=".01////^S X=GMRCDA;1////^S X=GMRCACT;2////^S X=GMRCAD;3////^S X=GMRCORNP;4////^S X=GMRCPLCR;6////^S X=GMRCFF;7////^S X=GMRCPA;8////^S X=GMRCDEV"
109 D FILE(GMRCO,DR)
110 L -^GMR(123,+GMRCO,40)
111 Q
112ALERT(GMRCDFN,GMRCSS,GMRCPR,GMRCFN,GMRCURG,GMRCORA) ;generate an alert when receiving a consult
113 ;GMRCDFN=patient DFN from file 2
114 ;GMRCSS=Service
115 ;GMRCPR=procedure being ordered
116 ;GMRCFN=File 123 IEN
117 ;GMRCURG=urgency of request from protocol file
118 ;GMRCADUZ=array of those who receive alerts
119 ;GMRCORA=action to take on alert: 27 is for new alert
120 N GMRCORTX
121 S GMRCORTX="New consult "_$$ORTX^GMRCAU(+GMRCO)_$S(+GMRCURG:" ("_$P(^ORD(101,+GMRCURG,0),"^",2)_")",1:"")
122 S:'$D(GMRCORA) GMRCORA=27 S:GMRCORA="" GMRCORA=27
123 D MSG^GMRCP(GMRCDFN,GMRCORTX,GMRCFN,GMRCORA,.GMRCADUZ,1)
124 K GMRCADUZ
125 Q
Note: See TracBrowser for help on using the repository browser.