source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCVEE5.m@ 1073

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

initial load of WorldVistAEHR
File size: 5.2 KB
Line 
1PRCVEE5 ;WOIFO/VAC - Routine to handle Error Messages sent from DynaMed ; 5/16/05 4:34pm
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 reads an ACK from DynaMed in answer to a message sent
6 ;regarding an Edit/Cancel/Approval to a RIL/2237.
7 ;ERRTXT - Text of the error message severity
8 ;MSGDAT -A single field that holds an error segment
9 ;MSGDAT2 - MSGDAT without the segment identifier
10 ;MSGDAT3 - Message type/Event type
11 ;MSGTYP - Indicates if there are errors in the message
12 ;PRCCNT - Record counter -indicates the message line number
13 ;PRCERCD - Error code returned
14 ;PRCERTX - Error text returned with error code
15 ;PRCFLD - Field where error occurred
16 ;PRCSEG - Segment where error has occurred
17 ;PRCSEQ - Sequence number where error occurred
18 ;PRCTYP - Type of form RIL or 2237
19 ;PRCVACK - Acknowledgement type AA, AE, AR, etc
20 ;PRCVAEC - Application error code string returned in message - ERR-5
21 ;PRCVDT - Second node level of ^XTMP
22 ;PRCVEC - Error component - ERR-3
23 ;PRCVERR - Array of email message
24 ;PRCVID - RIL/2237 ID - ERR-6
25 ;PRCVLOC - Error Location component - ERR-2
26 ;PRCMID - Message ID of original message
27 ;PRCVMID2 - Cross reference into ^XTMP
28 ;PRCVPTR - First node level of ^XTMP
29 ;PRCVSEV - Severity Component ERR-4
30 ;PRCVTYP - Original Form Type - RIL or 2237
31 ;SSTOP - Stop flag
32 ;PRCFS - Field separator
33 ;PRCCS - Component separator
34 ;PRCRS - Repetition separator
35 ;PRCSC - Sub-component separator
36 ;PRCDET - Array of field names inside of HL7 segments
37 ;PRCFCP - Fund Control Point for message
38 ;PRCSITE and PRCSITE0 - Receiving facility number
39 ;ERRCNT - a counter
40 ;^TMP - Global to hold error message information
41BEGIN N I,J
42 N PRCFS,PRCCS,PRCDET,ERRCNT,ERRTXT
43 N MSGDAT,PRCCNT,MSGTYP
44 N MSGDAT2,MSGDAT3,PRCERCD,PRCERTX,PRCFLD,PRCFCP,PRCSITE,PRCSITE0
45 N PRCSEG,PRCSEQ,PRCTYP,PRCVACK,PRCVAEC,PRCVDT,PRCVEC,PRCVERR
46 N PRCVID,PRCVLOC,PRCVMID,PRCVMID2,PRCVPTR,PRCVSEV,PRCVTYP,SSTOP
47 S PRCFS=HL("FS"),PRCCS=$E(HL("ECH"),1)
48 K ^TMP($J)
49SETUP ;Set up array for HL7 crosswalk
50 S PRCDET("ORC",1)="Order Control"
51 S PRCDET("ORC",9)="Date/Time Created"
52 S PRCDET("ORC",10)="Entered by"
53 S PRCDET("ORC",21)="Ordering Facility"
54 S PRCDET("RQD",1)="Line number"
55 S PRCDET("RQD",2)="DM Document ID"
56 S PRCDET("RQD",3)="Item number"
57 S PRCDET("RQD",4)="Packaging Multiple"
58 S PRCDET("RQD",5)="Quantity"
59 S PRCDET("RQD",6)="Unit of purchase"
60 S PRCDET("RQD",9)="Identifier"
61 S PRCDET("RQD",10)="Date needed"
62 S PRCDET("RQ1",1)="Unit cost"
63 S PRCDET("RQ1",2)="Vendor Stock Number"
64 S PRCDET("RQ1",3)="BOC"
65 S PRCDET("RQ1",4)="Vendor and/or FMS Vendor"
66 S PRCDET("RQ1",5)="NIF number"
67 S MSGTYP="",PRCVTYP=""
68 F I=1:1 X HLNEXT Q:HLQUIT'>0 D
69 .S ^TMP($J,I)=HLNODE,J=0
70 .F S J=$O(HLNODE(J)) Q:'J S ^TMP($J,I,J)=HLNODE(J)
71 ;
72 S PRCCNT="",SSTOP="GO"
73 F I=1:1:2 S PRCCNT=$G(^TMP($J,I)) Q:PRCCNT="" Q:SSTOP="STOP" D
74 .S MSGDAT=$G(^TMP($J,I))
75 .Q:MSGDAT=""
76 .S MSGDAT2=$P(MSGDAT,PRCFS,2,21)
77 .I $E(MSGDAT,1,3)="MSH" D Q
78 ..S MSGDAT3=$P(MSGDAT2,PRCFS,8)
79 ..I MSGDAT3'["ORN"_PRCCS_"O08" D
80 ...S SSTOP="STOP",MSGTYP="NOK"
81 ...S PRCVTYP="ACK",PRCVID=$P(MSGDAT2,PRCFS,9)
82 ...S PRCVERR(1)="IN "_PRCVTYP_" "_PRCVID_" there was a bad message type"
83 ...S PRCVPTR="*"_$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99)_"- - -076"
84 .I $E(MSGDAT,1,3)="MSA" D Q
85 ..S PRCVACK=$P(MSGDAT2,PRCFS,1)
86 ..S PRCVMID=$P(MSGDAT2,PRCFS,2)
87 ..S PRCVMID2="PRCVMID*"_PRCVMID
88 ..S PRCVPTR=$P($G(^XTMP(PRCVMID2,1)),U,1)
89 ..S PRCVDT=$P($G(^XTMP(PRCVMID2,1)),U,2)
90 ..I PRCVACK="AA" D Q
91 ...S MSGTYP="OK"
92 ..I (PRCVACK="AE")!(PRCVACK="AR") D Q
93 ...S MSGTYP="NOK"
94 I $E(MSGTYP,1,2)="OK" D VALID Q
95 I PRCVTYP="ACK" D NOVALID Q
96ERROR ;Now process error messages
97 ;
98 S ERRCNT=1
99 S PRCCNT="" F I=3:1 S PRCCNT=$G(^TMP($J,I)) Q:PRCCNT="" D
100 .S MSGDAT=$G(^TMP($J,I))
101 .Q:MSGDAT=""
102 .S MSGDAT2=$P(MSGDAT,PRCFS,2,7)
103 .S PRCVLOC=$P(MSGDAT2,PRCFS,2)
104 .S PRCVEC=$P(MSGDAT2,PRCFS,3)
105 .S PRCVSEV=$P(MSGDAT2,PRCFS,4)
106 .S PRCVAEC=$P(MSGDAT2,PRCFS,5)
107 .S PRCVID=$P(MSGDAT2,PRCFS,6)
108 .S PRCVTYP="RIL"
109 .I PRCVID?.N1"-".N1"-".N1"-".E1"-".N S PRCVTYP="2237"
110 .S PRCSEG=$P(PRCVLOC,PRCCS,1)
111 .S PRCSEQ=$P(PRCVLOC,PRCCS,2)
112 .S PRCFLD=$P(PRCVLOC,PRCCS,3)
113 .S PRCERCD=$P(PRCVAEC,PRCCS,1)
114 .S PRCERTX=$P(PRCVAEC,PRCCS,2)
115 .S ERRTXT="Error"
116 .I PRCVSEV="W" S ERRTXT="Warning"
117 .S PRCVERR(ERRCNT)="In "_PRCVTYP_" "_PRCVID_" the following occurred"
118 .S ERRCNT=ERRCNT+1
119 .S PRCVERR(ERRCNT)="For Line item "_PRCSEQ_" the "_PRCDET(PRCSEG,PRCFLD)_" had the following "_ERRTXT_": "
120 .S ERRCNT=ERRCNT+1
121 .S PRCVERR(ERRCNT)=PRCERTX
122 .S ERRCNT=ERRCNT+1
123 D NOVALID
124 Q
125VALID ;Do NOTHING to notify user that message is ok.
126 D CLEANUP
127 Q
128NOVALID ;Mailman message
129 N XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ
130 S XMSUB="IFCAP to DynaMed "_PRCVTYP_" Errors "_PRCVID_" "
131 S XMDUZ="IFCAP/DynaMed Interface"
132 S XMTEXT="PRCVERR("
133 ;S XMY("CARR.VICTOR@CSL.FO-WASH.MED.VA.GOV")=""
134 S PRCFCP=$P(PRCVPTR,"-",4)
135 S PRCSITE0=$P(PRCVPTR,"-",1)
136 S PRCSITE=$P(PRCSITE0,"*",2)
137 D GETFCPU^PRCVLIC(.XMY,PRCSITE,PRCFCP)
138 D ^XMD
139 K XMSUB,XMMG,XMDUZ,XMTEXT,XMY,XMZ
140 D CLEANUP
141 Q
142 ;
143CLEANUP ; Clean up data
144 K MSGTYP,MSGDAT,MSGDAT2,MSGDAT3,ERRTXT
145 K PRCCNT,PRCFS,PRCCS,I,J,SSTOP,PRCFCP,PRCSITE,PRCSITE0
146 K ^TMP($J),ERRCNT,PRCERCD,PRCERTX,PRCFLD,PRCSEG,PRCSEQ
147 K PRCTYP,PRCVACK,PRCVAEC,PRCVDT,PRCVEC,PRCVERR,PRCVID,PRCVLOC
148 K PRCVMID,PRCVMID2,PRCVPTR,PRCVSEV,PRCVTYP,PRCDET
149 ;
Note: See TracBrowser for help on using the repository browser.