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

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

revised back to 6/30/08 version

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