source: WorldVistAEHR/trunk/r/MY_HEALTHEVET-MHV/MHV7B2.m@ 1800

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

revised back to 6/30/08 version

File size: 4.2 KB
RevLine 
[623]1MHV7B2 ;WAS/GPM - HL7 message builder ORP^O10 ; [8/22/05 11:47pm]
2 ;;1.0;My HealtheVet;;Aug 23, 2005
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 Q
6 ;
7ORPO10(MSGROOT,REQ,ERR,DATAROOT,HL) ; Build refill request response
8 ;
9 ; Populates the array pointed to by MSGROOT with an ORP^O10 order
10 ; response message by calling the appropriate segment builders based
11 ; on the type of response ACK or NAK. Extracted data pointed to
12 ; by DATAROOT, errors, and request parameters are used to build the
13 ; segments. An error number in ERR^4 indicates a NAK is needed.
14 ;
15 ; Integration Agreements:
16 ; 3065 : $$HLNAME^XLFNAME
17 ; 10112 : $$SITE^VASITE
18 ;
19 ; Input:
20 ; MSGROOT - Global root of message
21 ; REQ - Query parameters
22 ; REQ("TYPE") - Request type number
23 ; REQ("MID") - original message control ID
24 ; ERR - Caret delimited error string
25 ; segment^sequence^field^code^ACK type^error text
26 ; DATAROOT - Global root of data array
27 ; HL - HL7 package array variable
28 ;
29 ; Output: ORP^O10 message in MSGROOT
30 ;
31 N CNT,RDT,HIT,I
32 K @MSGROOT
33 S CNT=1,@MSGROOT@(CNT)=$$MSA^MHV7B1($G(REQ("MID")),ERR,.HL)
34 I $P(ERR,"^",4) S CNT=CNT+1,@MSGROOT@(CNT)=$$ERR^MHV7B1(ERR,.HL)
35 Q:$P(ERR,"^",4)
36 S CNT=CNT+1,@MSGROOT@(CNT)=$$PID(.REQ,.HL)
37 F I=1:1 Q:'$D(@DATAROOT@(I)) D
38 . S CNT=CNT+1,@MSGROOT@(CNT)=$$ORC(@DATAROOT@(I),.HL)
39 . S CNT=CNT+1,@MSGROOT@(CNT)=$$RXE(@DATAROOT@(I),.HL)
40 . Q
41 Q
42 ;
43PID(REQ,HL) ;
44 N PID,NAME,STATION,IDCNT
45 S STATION=$P($$SITE^VASITE,"^",3)
46 S PID(0)="PID"
47 S IDCNT=0
48 I REQ("ICN")'="" D
49 . S IDCNT=IDCNT+1
50 . S PID(3,IDCNT,1)=REQ("ICN") ;Patient ID - ICN
51 . S PID(3,IDCNT,4,1)="USVHA" ;assigning authority ID
52 . S PID(3,IDCNT,4,3)="HL70363" ;assigning authority type
53 . S PID(3,IDCNT,5)="NI" ;Patient ID type
54 . S PID(3,IDCNT,6,1)="VA FACILITY ID" ;assigning facility
55 . S PID(3,IDCNT,6,2)=STATION ;Station number
56 . S PID(3,IDCNT,6,3)="L" ;facility ID type
57 . Q
58 ;
59 I REQ("DFN")'="" D
60 . S IDCNT=IDCNT+1
61 . S PID(3,IDCNT,1)=REQ("DFN") ;Patient ID - DFN
62 . S PID(3,IDCNT,4,1)="USVHA" ;assigning authority ID
63 . S PID(3,IDCNT,4,3)="HL70363" ;assigning authority type
64 . S PID(3,IDCNT,5)="PI" ;Patient ID type
65 . S PID(3,IDCNT,6,1)="VA FACILITY ID" ;assigning facility
66 . S PID(3,IDCNT,6,2)=STATION ;Station number
67 . S PID(3,IDCNT,6,3)="L" ;facility ID type
68 . Q
69 ;
70 I REQ("SSN")'="" D
71 . S IDCNT=IDCNT+1
72 . S PID(3,IDCNT,1)=REQ("SSN") ;Patient ID - SSN
73 . S PID(3,IDCNT,4,1)="USSSA" ;assigning authority ID
74 . S PID(3,IDCNT,4,3)="HL70363" ;assigning authority type
75 . S PID(3,IDCNT,5)="SS" ;Patient ID type
76 . S PID(3,IDCNT,6,1)="VA FACILITY ID" ;assigning facility
77 . S PID(3,IDCNT,6,2)="200MH" ;Station number
78 . S PID(3,IDCNT,6,3)="L" ;facility ID type
79 . Q
80 ;
81 S NAME("FILE")=2,NAME("FIELD")=.01,NAME("IENS")=REQ("DFN")_","
82 S NAME=$$NAMEFMT^XLFNAME(.NAME)
83 S PID(5,1,1)=$$ESCAPE^MHV7U($P(NAME,"^"),.HL) ;family
84 S PID(5,1,2)=$$ESCAPE^MHV7U($P(NAME,"^",2),.HL) ;given
85 S PID(5,1,3)=$$ESCAPE^MHV7U($P(NAME,"^",3),.HL) ;middle
86 S PID(5,1,4)=$$ESCAPE^MHV7U($P(NAME,"^",4),.HL) ;suffix
87 ;
88 Q $$BLDSEG^MHV7U(.PID,.HL)
89 ;
90ORC(DATA,HL) ;build ORC segment
91 N ORC,STATUS,CONTROL
92 S STATUS=$P(DATA,"^",2)
93 S CONTROL=$S(STATUS=1:"OK",1:"UA")
94 S ORC(0)="ORC"
95 S ORC(1)=CONTROL ;order control
96 S ORC(2)=$P(DATA,"^",3) ;placer order number
97 S ORC(3)=$P(DATA,"^",3) ;filler order number
98 Q $$BLDSEG^MHV7U(.ORC,.HL)
99 ;
100RXE(DATA,HL) ;build RXE segment
101 N RXE,STATUS,CONTROL
102 S STATUS=$P(DATA,"^",2)
103 S CONTROL=$S(STATUS=1:"OK",1:"UA")
104 S RXE(0)="RXE"
105 S RXE(1,1,1,1)=1 ;order quantity
106 S RXE(1,1,4,1)=$P(DATA,"^",4) ;order start time
107 S RXE(2,1,1)=CONTROL ;give code identifier
108 S RXE(2,1,2)=STATUS ;give code text
109 S RXE(2,1,3)="HL70119" ;give code system
110 S RXE(3)=1 ;give amount
111 S RXE(5)="1 refill unit" ;give units
112 ;S RXE(7)="" ;division number
113 S RXE(15)=$P(DATA,"^",1) ;prescription number
114 Q $$BLDSEG^MHV7U(.RXE,.HL)
115 ;
Note: See TracBrowser for help on using the repository browser.