source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCVEE1.m@ 623

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

initial load of WorldVistAEHR

File size: 5.0 KB
Line 
1PRCVEE1 ;WOIFO/VAC-EDIT/CANCELLATION FOR RIL/2237 FROM IFCAP TO DYNAMED ; 5/4/05 10:41am
2 ;;5.1;IFCAP;**81**;Oct 20, 2000
3 ;PER VHA Directive 10-93-142, this routine should not be modified
4 ;
5 ;This routine will pass changes, cancellations and approvals from
6 ;IFCAP to DynaMed because of changes in RIL's or 2237's
7BEGIN(REF,PRCVDT) ;
8 ; REF is passed in as node for ^XTMP(REF)
9 ; PRCVDT is passed in as node for ^XTMP(REF,PRCVDT)
10 ; Note: PRCVDT is really two data elements $H and comma delimited
11 ; There are two XTMP structures for this process. The first is
12 ; for the original message sent from IFCAP. The first node is
13 ; "PRCVUP*"+the RIL or 2237 number. The second node is $H. The third
14 ; node is either 0,1 or 2. Zero is the standard ^XTMP structure
15 ; plus $H. The 1 node contains header information common to all
16 ; items. The 2 node contains detail information to be sent.
17 ; Subordinate to the 2 node is a counter node unique for each item.
18 ; Under the 1 and 2 nodes, will reside an "ERR" node with
19 ; subordinate counters for multiple errors per item. The second
20 ; ^XTMP is a pointer to the PRCVUP*xxx node. The first node is
21 ; "PRCVMID*"+the Message Control ID for the original message.
22 ; The 1 node contains the PRCVUP*+xxx and $H to point back to the
23 ; original XTMP("PRCVUP*"+RIL/2237)
24 ; PRCPRO - Procedure call ID
25 ; PRCERR - Error array for processing message errors
26 ; PRCFS - Field separator
27 ; PRCCS - Component separator
28 ; PRCRS - Repetition separator
29 ; PRCEE - Escape separator
30 ; PRCSC - Sub-component separator
31 ; PRCMID - Message Control ID for sent message
32 ; ORCDAT - a single field that holds an ORC Segment
33 ; RQD - an array of fields for the RQD segment
34 ; RQ1 - an array of fields for the RQ1 segment
35 ; ORC - an array of fields for the ORC segment
36 ; PRCCNT - a record counter
37 ; PRCVY - Loop counter
38 N PRCPRO,PRCERR,PRCFS,PRCCS,PRCRS,PRCEE,PRCSC,PRCDP
39 N ORCDAT,I,J,K,Y,X,X1,X2,XX,RQD,ORC,PRCCNT,RQ1
40 N ODATE,PRCDTS,PRCDT,PRCMID,PRCVMID,DETAIL,HLA,HL,ERRCNT
41 N PRCVERR,PRCVY,PRCDATA,PRCSITE,PRCFCP
42 S PRCDATA=$P(REF,"*",2)
43 S PRCSITE=$P(PRCDATA,"-",1),PRCFCP=$P(PRCDATA,"-",4)
44 S PRCERR="OK"
45 I REF="" Q
46 S PRCDTS=$$NOW^XLFDT
47 S PRCDT=$$FMTHL7^XLFDT(PRCDTS),ERRCNT=1
48 D BUILD
49 D SEND
50 D CLEAN
51 Q
52BUILD ;Create the ORC record for the message
53 S PRCCNT=1
54 S PRCPRO="PRCV_IFCAP_01_EV_DYNAMED_UPDATE"
55 K HL D INIT^HLFNC2(PRCPRO,.HL)
56 I $G(HL) S PRCVERR(ERRCNT)="Error Generating Message to DynaMed" D MSGRTN Q
57 S PRCFS=HL("FS"),PRCCS=$E(HL("ECH"),1),PRCRS=$E(HL("ECH"),2),PRCEE=$E(HL("ECH"),3),PRCSC=$E(HL("ECH"),4)
58 ;
59ORC ;Build ORC Segment
60 S ORCDAT=$G(^XTMP(REF,PRCVDT,1))
61 Q:ORCDAT=""
62 F I=1:1:21 S ORC(I)=""
63 ;Convert a $H node value to a HL7 date format
64 S ODATE=$$HTFM^XLFDT(PRCVDT) S ORC(9)=$$FMTHL7^XLFDT(ODATE)
65 S ORC(21)=$P(ORCDAT,U,2)
66 S ORC(10)=$P(ORCDAT,U,3)_PRCCS_$P(ORCDAT,U,4)_PRCCS_$P(ORCDAT,U,5)
67 S $P(ORC(10),PRCCS,9)=ORC(21)
68 ;S HLA("HLS",PRCCNT)="ORC"_PRCFS
69 ;
70RQD ;Build RQD segment
71 S PRCVY=0 F K=1:1 S PRCVY=$O(^XTMP(REF,PRCVDT,2,PRCVY)) Q:PRCVY="" D
72 .S DETAIL=$G(^XTMP(REF,PRCVDT,2,PRCVY))
73 .Q:DETAIL=""
74 .S ORC(1)=$P(DETAIL,PRCCS,1)
75 .S HLA("HLS",PRCCNT)="ORC"_PRCFS
76 .F I=1:1:10 S RQD(I)=""
77 .F I=1:1:20 S HLA("HLS",PRCCNT)=HLA("HLS",PRCCNT)_ORC(I)_PRCFS
78 .S HLA("HLS",PRCCNT)=HLA("HLS",PRCCNT)_ORC(21)
79 .S PRCCNT=PRCCNT+1
80 .S HLA("HLS",PRCCNT)="RQD"_PRCFS
81 .S RQD(1)=PRCVY
82 .S RQD(2)=$P(DETAIL,U,7)
83 .S RQD(3)=$P(DETAIL,U,2)
84 .S RQD(4)=$P(DETAIL,U,11)
85 .S RQD(5)=$P(DETAIL,U,3)
86 .S RQD(6)=$P(DETAIL,U,9)
87 .S RQD(9)=$P(REF,"*",2)
88 .S RQD(10)=$P(DETAIL,U,8)
89 .S RQD(10)=$$FMTHL7^XLFDT(RQD(10))
90 .F J=1:1:9 S HLA("HLS",PRCCNT)=HLA("HLS",PRCCNT)_RQD(J)_PRCFS
91 .S HLA("HLS",PRCCNT)=HLA("HLS",PRCCNT)_RQD(10)
92 .S PRCCNT=PRCCNT+1
93 .;Build RQ1 segment
94 .F I=1:1:5 S RQ1(I)=""
95 .S HLA("HLS",PRCCNT)="RQ1"_PRCFS
96 .S RQ1(1)=$P(DETAIL,U,6)
97 .S RQ1(2)=$P(DETAIL,U,10)
98 .S RQ1(3)=$P(DETAIL,U,12)
99 .S RQ1(4)=$P(DETAIL,U,4)_PRCCS_PRCCS_PRCCS_$P(DETAIL,U,5)
100 .S RQ1(5)=$P(DETAIL,U,15)
101 .F J=1:1:4 S HLA("HLS",PRCCNT)=HLA("HLS",PRCCNT)_RQ1(J)_PRCFS
102 .S HLA("HLS",PRCCNT)=HLA("HLS",PRCCNT)_RQ1(5)
103 .S PRCCNT=PRCCNT+1
104 Q
105SEND ;Send record to HL7 interface to DynaMed
106 S PRCDP="" D GENERATE^HLMA(PRCPRO,"LM",1,.PRCDP)
107 I $P(PRCDP,PRCCS,2)'="" S PRCVERR(ERRCNT)="Generated "_$P(PRCDP,U,3) D MSGRTN
108 ;
109 ;Get the Message Control ID
110 S PRCMID=$P(PRCDP,U,1)
111 S XX=$$HTFM^XLFDT($H,1)
112 S X1=$$FMADD^XLFDT(XX,5)
113 S PRCVMID="PRCVMID*"_PRCMID
114 S ^XTMP(PRCVMID,0)=X1_U_XX_"^ACK 2237/RIL message from DynaMed"
115 S ^XTMP(PRCVMID,1)=REF_U_PRCVDT
116 Q
117MSGRTN ;Send message to Fund Control Point users for update
118 N XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ
119 S XMSUB="TRANSMISSION ERRORS FOR "_$P(REF,"*",2)
120 S XMDUZ="IFCAP OUTBOUND ERROR MESSAGE FOR RIL/2237"
121 S XMTEXT="PRCVERR("
122 D GETFCPU^PRCVLIC(.XMY,PRCSITE,PRCFCP)
123 D ^XMD
124 K XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ
125 Q
126CLEAN ;Clean up variables
127 K ODATE,PRCPRO,PRCERR,PRCFS,PRCCS,PRCRS,PRCEE,PRCSC
128 K DETAIL,HLA("HLS"),PRCDP,PRCERR,PRCMID,PRCVMID,PRCDT,PRCDTS
129 K ORCDAT,I,J,K,Y,X,X1,X2,XX,HLA,RQD,RQ1,ORC,PRCCNT,PRCVY
130 K XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ,ERRCNT,PRCVERR
131 K PRCDATA,PRCSITE,PRCFCP
132 Q
133 ;
Note: See TracBrowser for help on using the repository browser.