source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCVREA.m@ 619

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

initial load of WorldVistAEHR
File size: 4.7 KB
Line 
1PRCVREA ;WOIFO/VC-Transmit HL7 message to IFCAP for RIL(cont);11/24/03 ; 2/29/08 1:54pm
2 ;;5.1;IFCAP;**81,119**;Oct 20, 2000;Build 8
3 ;Per VHA Directive 2004-038, this routine should not be modified
4 ;
5CALLIT ;Call the IFCAP RIL build Routine
6 ;
7 D EN^PRCVRC1(PRCSUB)
8 ;
9SETUP S PRCHD(1)=""
10 ;Added 1,"T" node to stop crash
11 S PRCHD(1,"T")="ORDER HEADER INFO"
12 S PRCHD(2)="ORC"_PRCCS_PRCCS_3
13 S PRCHD(2,"T")="FUND CONTROL POINT"
14 S PRCHD(3)="ORC"_PRCCS_PRCCS_17
15 S PRCHD(3,"T")="COST CENTER"
16 S PRCHD(4)=""
17 S PRCHD(5)="ORC"_PRCCS_PRCCS_21
18 S PRCHD(5,"T")="SITE NUMBER"
19 S PRCHD(6)=""
20 S PRCHD(7)="ORC"_PRCCS_PRCCS_10
21 S PRCHD(7,"T")="DUZ"
22 S PRCHD(8)="ORC"_PRCCS_PRCCS_10
23 S PRCHD(8,"T")="LAST NAME"
24 S PRCHD(9)="ORC"_PRCCS_PRCCS_11
25 S PRCHD(9,"T")="FIRST NAME"
26 S PRCDET(1)="RQD"_PRCCS_PRCCS_3
27 S PRCDET(1,"T")="ITEM NUMBER"
28 S PRCDET(2)="RQD"_PRCCS_PRCCS_5
29 S PRCDET(2,"T")="QUANTITY"
30 S PRCDET(3)="RQ1"_PRCCS_PRCCS_4
31 S PRCDET(3,"T")="VENDOR ID"
32 S PRCDET(4)="RQ1"_PRCCS_PRCCS_1
33 S PRCDET(4,"T")="UNIT COST"
34 S PRCDET(5)="RQD"_PRCCS_PRCCS_10
35 S PRCDET(5,"T")="DATE NEEDED"
36 S PRCDET(6)="RQD"_PRCCS_PRCCS_2
37 S PRCDET(6,"T")="DYNAMED DOCUMENT ID"
38 S PRCDET(7)="RQ1"_PRCCS_PRCCS_5
39 S PRCDET(7,"T")="NIF NUMBER"
40 S PRCDET(8)="RQ1"_PRCCS_PRCCS_3
41 S PRCDET(8,"T")="BOC"
42 ;Check if IFCAP has returned any errors
43 ;
44 S ERRCNT=1
45 S PRCVERR(0)="0"
46HEAD ;If there are errors in the "1" sub-segment, add all errors to all
47 ; line items
48 S ERRCNT=1,MSGFLG=0,PRCSUB2=$P(PRCSUB,"*",2)
49 I $D(^XTMP(PRCSUB,1,"ERR"))>0 D
50 .S II=0
51 .F I=1:1 S II=$O(^XTMP(PRCSUB,1,"ERR",II)) Q:II="" D
52 ..S ERRDAT=$G(^XTMP(PRCSUB,1,"ERR",II))
53 ..Q:ERRDAT=""
54 ..S MSGFLG=1
55 ..S FLDNO=$P(ERRDAT,U,1),ERRCOD="PRCV"_$P(ERRDAT,U,2),ERRTXT=$P(ERRDAT,U,3)
56 ..S SEVER=$P(ERRDAT,U,4)
57 ..S ERRSTR="ERR"_PRCFS_PRCFS_PRCHD(FLDNO)_PRCFS_"207"_PRCCS_"Application internal error"_PRCCS_"HL70357"_PRCFS_SEVER_PRCFS_ERRCOD_PRCCS_ERRTXT_PRCFS
58 ..S PRCVERR(ERRCNT)="Error in Requisition Header for "_PRCHD(FLDNO,"T")_" from HL7 MESSAGE "_PRCSUB2_" "_ERRCOD_" "_ERRTXT,ERRCNT=ERRCNT+1
59 ..S J=0
60 ..F IL=1:1 S J=$O(^XTMP(PRCSUB,2,J)) Q:J="" D
61 ...S ERRSUB=$P(ERRSTR,PRCFS,3)
62 ...S $P(ERRSUB,U,2)=J
63 ...S $P(ERRSTR,PRCFS,3)=ERRSUB
64 ...;S $P($P(ERRSTR,PRCFS,3),U,2)=J
65 ...S $P(ERRSTR,PRCFS,7)=$P($G(^XTMP(PRCSUB,2,J)),U,6)
66 ...S ^TMP("PRCVRIL",$J,"NAK",ACKCNT)=ERRSTR,ACKCNT=ACKCNT+1
67DETAIL ;If there are errors in the detail lines, add them
68 S II=0
69 F I=1:1 S II=$O(^XTMP(PRCSUB,2,II)) Q:II="" D
70 .S DOCID=$P(^XTMP(PRCSUB,2,II),U,6)
71 .S III=0
72 .F J=1:1 S III=$O(^XTMP(PRCSUB,2,II,"ERR",III)) Q:III="" D
73 ..S ERRDAT=$G(^XTMP(PRCSUB,2,II,"ERR",III))
74 ..Q:ERRDAT=""
75 ..S MSGFLG=1
76 ..S FLDNO=$P(ERRDAT,U,1),ERRCOD="PRCV"_$P(ERRDAT,U,2),ERRTXT=$P(ERRDAT,U,3)
77 ..S ERRLOC=PRCDET(FLDNO),$P(ERRLOC,U,2)=II
78 ..S SEVER=$P(ERRDAT,U,4)
79 ..S ERRSTR="ERR"_PRCFS_PRCFS_ERRLOC_PRCFS_"207"_PRCCS_"Application internal error"_PRCCS_"HL70357"_PRCFS_SEVER_PRCFS_ERRCOD_PRCCS_ERRTXT_PRCFS_DOCID
80 ..S ^TMP("PRCVRIL",$J,"NAK",ACKCNT)=ERRSTR,ACKCNT=ACKCNT+1
81 ..S PRCVERR(ERRCNT)="Error in detail for Message Control ID "_PRCSUB2_". Field in error - "_PRCDET(FLDNO,"T")_". "_ERRTXT_" DynaMed Doc ID "_DOCID
82 ..S ERRCNT=ERRCNT+1
83 ;
84 I MSGFLG=0 D ACKIT,CLEANUP^PRCVRE1 Q
85SETNTE ; If there are errors set an NTE segment
86 ;
87 S TOT=0,TOTREC=0,TOTERR=0
88 F I=1:1 S TOT=$O(^XTMP(PRCSUB,2,TOT)) Q:TOT="" D
89 .S TOTREC=TOT
90 .I $D(^XTMP(PRCSUB,2,TOT,"ERR"))>0 D
91 ..S ERRS=0
92 ..F J=1:1 S ERRS=$O(^XTMP(PRCSUB,2,TOT,"ERR",ERRS)) Q:ERRS="" D
93 ...S SEVER=$P($G(^XTMP(PRCSUB,2,TOT,"ERR",ERRS)),U,4)
94 ...I SEVER'="W" S TOTERR=TOTERR+1,ERRS=99
95 I $D(^XTMP(PRCSUB,2,"ERR",1))>1 S TOTERR=TOTREC
96 S TOTGOOD=TOTREC-TOTERR
97 S ^TMP("PRCVRIL",$J,"NAK",ACKCNT)="NTE"_PRCFS_PRCFS_PRCFS_TOTREC_"-"_TOTERR_"-"_TOTGOOD,ACKCNT=ACKCNT+1
98 D NAKIT,CLEANUP^PRCVRE1 Q
99 ;
100NAKIT ;Send an acknowledgement that the message is rejected
101 ;
102 I HL("APAT")'="AL" Q
103 S MSG=""
104 F I=1:1 S MSG=$O(^TMP("PRCVRIL",$J,"NAK",MSG)) Q:MSG="" D
105 .S ^TMP("HLA",$J,I)=^TMP("PRCVRIL",$J,"NAK",MSG)
106 S PRCVRES=""
107 D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"GM",1,.PRCVRES)
108 ;I +$P(PRCVRES,U,2) D
109 ;.S PRCVERR(ERRCNT)="Application ACK not processed. Contact EVS."
110MAIL ;Send MailMan message with error
111 Q:LENVAL="NOTOK"
112 N XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ
113 S XMSUB="RIL build errors in HL7 message "_HL("MID")_" "
114 S XMDUZ="IFCAP/DynaMed Interface"
115 S XMTEXT="PRCVERR("
116 D GETFCPU^PRCVLIC(.XMY,PRCSITE,PRCFCP)
117 D ^XMD
118 K XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ
119 Q
120 ;
121ACKIT ;Send an acknowledgement that everything went fine
122 ;
123 I HL("APAT")'="AL" Q
124 F I=1:1:1 S ^TMP("HLA",$J,I)=$G(^TMP("PRCVRIL",$J,"ACK",I))
125 ;
126 D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"GM",1,.PRCVRES)
127 ;I +P(PRCVRES,U,2) D
128 ;.I $D(ERRCNT)=0 S ERRCNT=1
129 ;.S PRCVERR(ERRCNT)="Application ACK not processed. Contact EVS."
130 ;.D MAIL
131 Q
Note: See TracBrowser for help on using the repository browser.