source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOHLINC.m@ 1800

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1PSOHLINC ;BIR/RTR - Process incoming order messages from CHCS ;06/17/02
2 ;;7.0;OUTPATIENT PHARMACY;**111,143**;DEC 1997
3 ;
4EN ;Process incoming outpatient order messages
5 N PSOXLONG,PSOHDFOR,PSOHLTAG,PSOHBDS,PSOHMSG,PSOHLMIS,PSOHLRS,PSOHEID,PSOHEIDS,PSOHFSP,PSOHLNOP,PSOXHI,PSOHLZ,PSOHLZC,PSOHLRXO,PSOXMH,PSOHY,PSOEXMS,PSOEXXQ,PSOHG,PSOBH,X,Y
6 I '$G(DT) S DT=$$DT^XLFDT
7 S (PSOXLONG,PSOHLRXO,PSOHLNOP,PSOHDFOR)=0
8 S PSOHFSP=$E(HL("ECH"),1)
9 K PSOHLMIS
10 F PSOXHI=1:1 K PSOHB X HLNEXT Q:HLQUIT'>0!(PSOHLNOP)!(PSOHDFOR)!(PSOXLONG) S PSOHB=HLNODE,PSOXMH=$E(PSOHB,1,3) D
11 .S PSOHG=0 F S PSOHG=$O(HLNODE(PSOHG)) Q:'PSOHG!(PSOHLNOP)!(PSOHDFOR)!(PSOXLONG) S PSOHB(PSOHG)=HLNODE(PSOHG)
12 .I (PSOXMH'?3U),(PSOXMH'?2U1N) S PSOHDFOR=1 Q
13 .I $T(@PSOXMH)]"" D @PSOXMH
14 ;Quit if not a Pharmacy message, no acknowledgements
15 I $G(PSOHLNOP) Q
16 I $G(PSOHY("OCC"))="CA" D ENDC^PSOHLDC Q
17 I PSOXLONG S PSOEXMS="Invalid NTE segment, greater than 245 characters." D NAK^PSOHLEXC Q
18 S (PSOHBDS,PSOEXXQ)=0
19 I PSOHDFOR S PSOEXMS="Invalid message structure." D NAK^PSOHLEXC Q
20 F PSOHMSG="MSH","PID","PV1","ORC","RXO" Q:PSOEXXQ I '$D(PSOHLMIS(PSOHMSG)) S PSOEXMS="Missing "_PSOHMSG_" segment." S PSOHBDS=1 D NAK^PSOHLEXC
21 ;Quit if segment is missing
22 I $G(PSOEXXQ) Q
23 ;Quit if not a Pharmacy message, no acknowledgements
24 ;I $G(PSOHLNOP) Q
25 ;check for data exceptions
26 D CHECK^PSOHLEXC
27 ;PSOEXXQ set if a NAK was sent back
28 I $G(PSOEXXQ) Q
29 ;Enter order into Pending Outpatient Orders file
30 D ADD^PSOHCPRS
31 ;Send successful acknowledgement if PSOEXXQ not set
32 I '$G(PSOEXXQ) D ACK^PSOHLEXC
33 Q
34 ;What about regular acknowledgements? handled by HL7 package somehow
35 Q
36MSH ;Process MSH segment
37 I $P(PSOHB,HL("FS"),5)'="PSO RECEIVE" S PSOHLNOP=1
38 S PSOHLMIS("MSH")=""
39 Q
40PID ;Process PID segment
41 D FORM
42 S PSOHY("PAT")=+$P(PSOHB,HL("FS"),3)
43 S PSOHLMIS("PID")=""
44 Q
45PV1 ;Process PV1 segment
46 D FORM
47 S PSOHY("LOC")=+$P(PSOHB,HL("FS"),3)
48 S PSOHLMIS("PV1")=""
49 Q
50DG1 ;Process DG1 segment ; future use
51 D FORM
52 S $P(PSOHY("ICD"),U,$P(PSOHB,HL("FS"),1))=$P(PSOHB,HL("FS"),3)
53ZCL Q ;future use
54 ;
55ORC ;Process ORC segment
56 S PSOHLRXO=1 ;For future use in processing NTE's, if other segments get NTE(6) or (7)
57 D FORM
58 I $O(PSOHB(""))'="" D ORC^PSOHLINL Q
59 S PSOHY("OCC")=$P(PSOHB,HL("FS"))
60 ;Set priority to Routine
61 S PSOHY("PRIOR")="R"
62 S PSOHY("CHNUM")=$P($P(PSOHB,HL("FS"),2),PSOHFSP)
63 D NOW^%DTC S PSOHY("EDT")=%
64 S X=$P(PSOHB,HL("FS"),9) D
65 .I X S PSOHY("SDT")=$$HL7TFM^XLFDT(X) Q
66 .S PSOHY("SDT")=$G(PSOHY("EDT"))
67 S PSOHY("ENTER")=+$P(PSOHB,HL("FS"),10)
68 S PSOHY("PROV")=+$P(PSOHB,HL("FS"),12)
69 S PSOHLMIS("ORC")=""
70 Q
71RXO ;Process RXO segment
72 D FORM
73 I $O(PSOHB(""))'="" D RXO^PSOHLINL Q
74 S PSOHY("DRUG")=+$P(PSOHB,HL("FS"),10)
75 S PSOHY("QTY")=$P(PSOHB,HL("FS"),11)
76 S PSOHY("REF")=$P(PSOHB,HL("FS"),13)
77 S PSOHLMIS("RXO")=""
78 Q
79RXR ;Process RXR segment
80 D FORM
81 Q
82ZRX ;Process ZRX segment
83 D FORM
84 S PSOHY("PICK")=$S($P(PSOHB,HL("FS"),4)="M":"M",1:"W")
85 Q
86NTE ;
87 D FORM
88 I $P(PSOHB,HL("FS"))=6 D COMM Q
89 I $P(PSOHB,HL("FS"))=7 D SIG Q
90 Q
91COMM ;Process Provider Comments
92 I $O(PSOHB(""))'="" D COMM^PSOHLINL Q
93 K ^UTILITY($J,"W")
94 S X=$P(PSOHB,HL("FS"),3,999)
95 I $L(X)>245 S PSOXLONG=1 Q
96 S DIWL=1,DIWR=70,DIWF="" D ^DIWP
97 D ENCOMM^PSOHLINL
98 K ^UTILITY($J,"W")
99 Q
100SIG ;Process SIG
101 I $O(PSOHB(""))'="" D SIG^PSOHLINL Q
102 K ^UTILITY($J,"W")
103 S X=$P(PSOHB,HL("FS"),3,999)
104 I $L(X)>245 S PSOXLONG=1 Q
105 S DIWL=1,DIWR=70,DIWF="" D ^DIWP
106 D ENSIG^PSOHLINL
107 K ^UTILITY($J,"W")
108 Q
109FORM ;
110 S PSOHB=$E(PSOHB,(4+$L(HL("FS"))),$L(PSOHB))
111 Q
112 ;AND IF YOU ADD PSOHLNEW TO THE PATCH, FIX THE HEADER OF THE 3 NODE TO MATCH HOW YOU DID IT IN PSOHCPRS. SINCE IT IS A WORD PROCESSING FIELD
113 ; And maybe fix -1 problem if no related institution is found
114 ; AND IF YOU PATCH PSOHLSN1, AT THE rxr POINT, INITIALIZE RTENAME AT THE BEGINNING OF EACH LOOP
Note: See TracBrowser for help on using the repository browser.