1 | FHWOR ; HISC/NCA - Main Routine to Decode HL7 ;10/10/00 14:55
|
---|
2 | ;;5.5;DIETETICS;**2,5**;Jan 28, 2005;Build 53
|
---|
3 | EN(MSG) ; Entry Point for OE/RR 3 and pass MSG in FHMSG
|
---|
4 | N ACT,ADM,BID,COM,FHDFN,DFN,EDT,FHPV,FHMSG,FHWF,NOW,SDT,CHK,DA,DATA,DATE,DIET,DUR,FHC,FHD,FHD1,FHD2,FOR,FTYP,IEN,ITVL,LP,MEAL,NAM,PER,PID,SERV,TIM,TIME,TM,TXT,TYPC,WARD,X,XX,YR
|
---|
5 | S TXT="",FHWF=2 ; FHWF=2 - Orders from OE/RR
|
---|
6 | F L=0:0 S L=$O(MSG(L)) Q:L<1 S FHMSG(L)=$G(MSG(L))
|
---|
7 | Q:'$D(FHMSG)
|
---|
8 | ; Decode MSH
|
---|
9 | S X=$G(FHMSG(1)) I $E(X,1,3)'="MSH" S TXT="MSH not first record" D GETOR G ERR
|
---|
10 | ; Check PID
|
---|
11 | S X=$G(FHMSG(2)) I $E(X,1,3)'="PID" S TXT="PID not second record" D GETOR G ERR
|
---|
12 | S NAM=$P(X,"|",6),DFN=$P(X,"|",4)
|
---|
13 | I '$D(^DPT("B",$E(NAM,1,30),DFN)) S TXT="Name/DFN not found" D GETOR G ERR
|
---|
14 | S FHZ115="P"_DFN D ADD^FHOMDPA I FHDFN="" S TXT="Patient not found in File #115" D GETOR G ERR
|
---|
15 | D PID^VADPT6 S PID=$G(VA("PID")),BID=$G(VA("BID")) K VA
|
---|
16 | S X=$G(FHMSG(3)) I $E(X,1,5)="ORC|Z" G PURGE
|
---|
17 | I $E(X,1,6)="ORC|DE" Q ;6/2005 quit processing if "DE" returned
|
---|
18 | ;Check for outpatient orders
|
---|
19 | I $P(X,"|",3)="O" D ^FHOMWOR Q
|
---|
20 | S WARD=$G(^DPT(DFN,.1)) I WARD="" D CHK^FHWORR G:CHK CANCEL S:'CHK TXT="Not an inpatient" D GETOR G ERR
|
---|
21 | S ADM=$G(^DPT("CN",WARD,DFN)) I ADM<1 S TXT="Admission not found" D GETOR G ERR
|
---|
22 | I '$D(^FHPT(FHDFN,"A",ADM,0)) I '$D(^DGPM(ADM,0)) S TXT="Admission not found" D GETOR G ERR
|
---|
23 | I '$D(^FHPT(FHDFN,"A",ADM,0)) S DA=DFN D ^FHWADM
|
---|
24 | ; Check PV1
|
---|
25 | S X=$G(FHMSG(3)) G:$E(X,1,3)="ORC" CANCEL I $E(X,1,3)'="PV1" S TXT="Third message not ORC or PV1" D GETOR G ERR
|
---|
26 | ; Decode ORC
|
---|
27 | S X=$G(FHMSG(4)) I $E(X,1,3)'="ORC" S TXT="Message 4 not ORC as expected" D GETOR G ERR
|
---|
28 | S ACT=$P(X,"|",2) I ACT'="NW" S TXT="Action not NW as expected" D GETOR G ERR
|
---|
29 | S FHORN=$P(X,"|",3),DUR=$P(X,"|",8)
|
---|
30 | S ITVL=$P(DUR,"^",2),SDT=$P(DUR,"^",4),EDT=$P(DUR,"^",5)
|
---|
31 | S FHPV=$P(X,"|",13),NOW=$P(X,"|",16) I NOW="" S TXT="No Effective Date" G ERR
|
---|
32 | S X=$G(FHMSG(5)) I $E(X,1,3)="ODT" D ^FHWOR3 G KIL
|
---|
33 | I $E(X,1,3)="OBR" D ^FHWOR61 G KIL
|
---|
34 | I $E(X,1,3)'="ODS" S TXT="Message 5 not ODT or ODS as expected" G ERR
|
---|
35 | S TYPC=$P(X,"|",2) I TYPC="ZE" D ^FHWOR5 G KIL
|
---|
36 | S DIET=$P(X,"|",4),DIET=$E(DIET,4,$L(DIET)),COM=$P(X,"|",5)
|
---|
37 | I $E(DIET,1,4)="FH-5" D ^FHWOR4 G KIL
|
---|
38 | I $E(DIET,1,4)="FH-6" D ^FHWOR1 G KIL
|
---|
39 | D ^FHWOR2 G KIL
|
---|
40 | CANCEL ; Cancel/Discontinue
|
---|
41 | S DATA=X,FOR=0
|
---|
42 | S ACT=$P(DATA,"|",2)
|
---|
43 | S FHORN=$P(DATA,"|",3),FILL=$P(DATA,"|",4),FTYP=$P(FILL,";",1)
|
---|
44 | I ACT'="CA",ACT'="DC",ACT'="NA",ACT'="DE",ACT'="SS" S TXT="Action not CA, DC, NA, or DE as expected" G CERR
|
---|
45 | I FTYP="R"!(FTYP="S") D OMSTAT^FHWORR Q ;Status update for outpt meals
|
---|
46 | I "ADEINT"'[FTYP G CSEND:ACT="CA"!(ACT="DC"),KIL
|
---|
47 | S FOR=$S(FTYP="A":1,FTYP="D":2,FTYP="E":3,FTYP="N":4,FTYP="T":5,FTYP="I":6,1:0)
|
---|
48 | I 'FOR G CSEND:ACT="CA"!(ACT="DC"),KIL
|
---|
49 | I ACT="SS" G STATUS^FHWORR
|
---|
50 | I ACT="NA" D NA K ACT,TXT K MSG Q
|
---|
51 | I ACT="DE" K MSG G KIL
|
---|
52 | CAN ; Cancel Order From OE
|
---|
53 | I FOR=1 D CAN^FHWOR1 G KIL
|
---|
54 | I FOR=2 D CAN^FHWOR2 G KIL
|
---|
55 | I FOR=3 D CAN^FHWOR3 G KIL
|
---|
56 | I FOR=4 D CAN^FHWOR4 G KIL
|
---|
57 | I FOR=5 D CAN^FHWOR5 G KIL
|
---|
58 | I FOR=6 D CAN^FHWOR61 G KIL
|
---|
59 | G KIL
|
---|
60 | PURGE ; Purge OE/RR Orders
|
---|
61 | I $E(X,5,6)'="Z@" G KIL
|
---|
62 | S FHORN=+$P(X,"|",3),FILL=$P(X,"|",4),FTYP=$P(FILL,";",1)
|
---|
63 | S FHDR=+$P(FILL,";",3),ADM=+$P(FILL,";",2)
|
---|
64 | I FTYP="A" S:$P($G(^FHPT(FHDFN,"A",ADM,"OO",FHDR,0)),"^",8)=FHORN $P(^FHPT(FHDFN,"A",ADM,"OO",FHDR,0),"^",8)=""
|
---|
65 | I FTYP="D" S:$P($G(^FHPT(FHDFN,"A",ADM,"DI",FHDR,0)),"^",14)=FHORN $P(^FHPT(FHDFN,"A",ADM,"DI",FHDR,0),"^",14)=""
|
---|
66 | I FTYP="E" S SDT=$P(FILL,";",4),EDT=$P(FILL,";",5) S:EDT<SDT EDT=SDT D
|
---|
67 | .F EL=SDT\1:0 S EL=$O(^FHPT(FHDFN,"A",ADM,"EL",EL)) Q:EL<1!(EL>EDT) D
|
---|
68 | ..S:$P($G(^FHPT(FHDFN,"A",ADM,"EL",EL,0)),"^",7)=FHORN $P(^FHPT(FHDFN,"A",ADM,"EL",EL,0),"^",7)=""
|
---|
69 | ..Q
|
---|
70 | .Q
|
---|
71 | I FTYP="N" S:$P($G(^FHPT(FHDFN,"A",ADM,"DI",FHDR,0)),"^",14)=FHORN $P(^FHPT(FHDFN,"A",ADM,"DI",FHDR,0),"^",14)=""
|
---|
72 | I FTYP="T" S:$P($G(^FHPT(FHDFN,"A",ADM,"TF",FHDR,0)),"^",14)=FHORN $P(^FHPT(FHDFN,"A",ADM,"TF",FHDR,0),"^",14)=""
|
---|
73 | I FTYP="I" S:$P($G(^FHPT(FHDFN,"A",ADM,0)),"^",13)=FHORN $P(^FHPT(FHDFN,"A",ADM,0),"^",13)=""
|
---|
74 | K EL,FHDR
|
---|
75 | S $P(MSG(1),"|",9)="ORR",$P(MSG(3),"|",2)="ZR",$P(MSG(1),"|",3)="DIETETICS" G EVSEND
|
---|
76 | NA ; Number Assign
|
---|
77 | I FOR=1 D NA^FHWOR1 G KIL
|
---|
78 | I FOR=2 D NA^FHWOR2 G KIL
|
---|
79 | I FOR=3 D NA^FHWOR3 G KIL
|
---|
80 | I FOR=4 D NA^FHWOR4 G KIL
|
---|
81 | I FOR=5 D NA^FHWOR5 G KIL
|
---|
82 | I FOR=6 D NA^FHWOR61 G KIL
|
---|
83 | Q
|
---|
84 | CVT ; Convert HL7 date to FM date
|
---|
85 | Q:DATE="" S DATE=$$HL7TFM^XLFDT(DATE)
|
---|
86 | I $P(DATE,".",2)=24 S DATE=$$FMADD^XLFDT(DATE,0,0,1)
|
---|
87 | Q
|
---|
88 | ERR ; Send error MSG
|
---|
89 | K MSG D RMSH
|
---|
90 | S $P(MSG(3),"|",1,2)="ORC"_"|"_$S($P($G(MSG(3)),"|",1)="ORC":"U"_$E($P($G(MSG(3)),"|",2),1),1:"OC"),$P(MSG(3),"|",3)=FHORN
|
---|
91 | S $P(MSG(3),"|",4)=$S($P(FHMSG(3),"|",1)="ORC":$P(FHMSG(3),"|",4),1:"")
|
---|
92 | S $P(MSG(3),"|",13)=$S($P(FHMSG(3),"|",1)="ORC":$P(FHMSG(3),"|",13),1:$P(FHMSG(4),"|",13))
|
---|
93 | S $P(MSG(3),"|",16)=$S($P(FHMSG(3),"|",1)="ORC":$P(FHMSG(3),"|",16),1:$P(FHMSG(4),"|",16))
|
---|
94 | S $P(MSG(3),"|",17)=TXT G EVSEND
|
---|
95 | SEND ; Send OK MSG to OERR
|
---|
96 | K MSG D RMSH
|
---|
97 | S MSG(3)="ORC|OK|"_FHORN_"|"_FILL_"^"_"FH" G EVSEND
|
---|
98 | CERR ; Send unable MSG
|
---|
99 | K MSG D RMSH
|
---|
100 | S MSG(3)="ORC|U"_$E(ACT,1)_"|"_FHORN_"|"_FILL_"|||||||||||||"_TXT G EVSEND
|
---|
101 | CSEND ; Send Canceled/Discontinued MSG to OERR
|
---|
102 | K MSG D RMSH
|
---|
103 | S MSG(3)="ORC|"_$E(ACT,1)_"R"_"|"_FHORN_"|"_FILL
|
---|
104 | EVSEND ; Send Message to OE/RR
|
---|
105 | K ACT,FILL,FHORN,SITE,TXT D MSG^XQOR("FH EVSEND OR",.MSG) K MSG Q
|
---|
106 | MSH ; Code MSH message
|
---|
107 | D MSH^FHWORR
|
---|
108 | Q
|
---|
109 | RMSH ; Code MSH Return Message
|
---|
110 | D SITE^FH
|
---|
111 | S MSG(1)="MSH|^~\&|DIETETICS|"_SITE(1)_"|||||ORR"
|
---|
112 | ; code PID
|
---|
113 | S MSG(2)="PID|||"_DFN_"||"_$P($G(^DPT(DFN,0)),"^",1)
|
---|
114 | Q
|
---|
115 | GETOR ; Call to Get FHORN
|
---|
116 | D GETOR^FHWORR Q
|
---|
117 | KIL ; Kill Variables
|
---|
118 | K ACT,ADM,BID,COM,FHDFN,DFN,EDT,FHPV,FHMSG,FHWF,NOW,SDT,CHK,DA,DATA,DATE,DIET,DUR,FHC,FHD,FHD1,FHD2,FOR,FTYP,IEN,ITVL,LP,MEAL,NAM,PER,PID,SERV,TIM,TIME,TM,TXT,TYPC,WARD,X,XX,YR Q
|
---|