source: FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCVPOSD.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 6.4 KB
Line 
1PRCVPOSD ;WOIFO/DAP-DYNAMED COMBINED PO EVENTS SEND ; 12/13/04
2V ;;5.1;IFCAP;**81**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;This routine is used to send an ORM^O01 HL7 message to the DynaMed inventory system to report one of four Purchase Order operations.
6 ;1-Purchase Order Obligations
7 ;2-Amendments to Obligated Purchase Orders
8 ;3-Purchase Order Receiving Reports
9 ;4-Adjustments to Purchase Order Receiving Reports
10 ;
11 Q
12 ;
13EN(PRCVX) ;Entry point for API Call
14 I $$GET^XPAR("SYS","PRCV COTS INVENTORY",1,"Q")'=1 Q
15 I $D(PRCVX)=0 Q
16 N HLA
17 S PRCVCNT=0,PRCVERG=0
18 D HDRBLD
19 I PRCVERG=1 K PRCVERG Q
20 S N=0 F S N=$O(^TMP("PRCV442A",$J,PRCVX,N)) Q:+N=0 D
21 . D MSGBLD
22 . Q
23 ;
24 S PRCVDP="" D GENERATE^HLMA(PRCVPRO,"LM",1,.PRCVDP)
25 I +$P(PRCVDP,"^",2) S PRCVERR(1)="Error generating message through VistA HL7 package for PO # "_PRCVPO,PRCVERD=PRCVPO D CLIFP
26 ;
27 K ^TMP("PRCV442A",$J,PRCVX)
28 D FIN
29 K PRCVERG
30 ;
31 Q
32 ;
33HDRBLD ;Build message elements from provided header level data
34 ;
35 ;PRCVPO Purchase Order #
36 S PRCVPO=$P(^TMP("PRCV442A",$J,PRCVX),"^",1)
37 ;PRCVTT Transaction Type
38 S PRCVTT=$P(^TMP("PRCV442A",$J,PRCVX),"^",2)
39 I PRCVTT=1 S PRCVT1="NW",PRCVT2="CG",PRCVPRO="PRCV_IFCAP_02_EV_OBL/AMEND"
40 I PRCVTT=2 S PRCVT1="XO",PRCVT2="AJ",PRCVPRO="PRCV_IFCAP_02_EV_OBL/AMEND"
41 I PRCVTT=3 S PRCVT1="SC",PRCVT2="CG",PRCVPRO="PRCV_IFCAP_03_EV_REC/ADJ"
42 I PRCVTT=4 S PRCVT1="XX",PRCVT2="AJ",PRCVPRO="PRCV_IFCAP_03_EV_REC/ADJ"
43 I PRCVTT=5 S PRCVT1="CA",PRCVT2="AJ",PRCVPRO="PRCV_IFCAP_02_EV_OBL/AMEND"
44 ;PRCVDZ IFCAP User DUZ
45 S PRCVDZ=$P(^TMP("PRCV442A",$J,PRCVX),"^",3)
46 ;Retrieve user name based on DUZ from file 200 using $$HLNAME^XLFNAME call as detailed in DBIA #3065
47 S PRCVDNM("FILE")=200,PRCVDNM("FIELD")=.01,PRCVDNM("IENS")=PRCVDZ_","
48 S PRCVDNM=$P($$HLNAME^XLFNAME(.PRCVDNM," ","^"),"^",1,2)
49 S PRCVNML=$P(PRCVDNM,"^",1)
50 S PRCVNMF=$P(PRCVDNM,"^",2)
51 ;PRCVVNI Vendor Number IEN
52 S PRCVVNI=$P(^TMP("PRCV442A",$J,PRCVX),"^",4)
53 ;PRCVVNF Vendor Number FMS
54 S PRCVVNF=$P(^TMP("PRCV442A",$J,PRCVX),"^",5)
55 ;
56 ;##### FMS ALTERNATE ADDRESS INDICATOR #####
57 ;PIECE 6
58 ;
59 ;PRCVDT Transaction Date / Time
60 S PRCVDT=$P(^TMP("PRCV442A",$J,PRCVX),"^",7)
61 S PRCVDT=$$FMTHL7^XLFDT(PRCVDT)
62 ;PRCVSTA Station #
63 S PRCVSTA=$P(^TMP("PRCV442A",$J,PRCVX),"^",8)
64 ;PRCVPSTA Purchasing Station #
65 S PRCVPSTA=+(PRCVPO)
66 ;
67 K HL D INIT^HLFNC2(PRCVPRO,.HL)
68 I $G(HL) S PRCVERR(1)="Error generating message through VistA HL7 package for PO # "_PRCVPO,PRCVERD=PRCVPO D CLIFP D FIN Q
69 ;
70 S PRCVCS=$E(HL("ECH")),PRCVFS=HL("FS")
71 ;
72 Q
73 ;
74MSGBLD ;Generate repeating message body for all line level data
75 ;
76 ;PRCVDDN DynaMed Document Number
77 S PRCVDDN=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",1)
78 ;S PRCVDDN=$E(PRCVDDN,1,4)_"-"_$E(PRCVDDN,5,8)_"-"_$E(PRCVDDN,9,11)
79 ;PRCVIN Item Number
80 S PRCVIN=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",2)
81 ;PRCVLN PO Line Number
82 S PRCVLN=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",3)
83 ;PRCVTN 2237 Transaction Number
84 S PRCVTN=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",4)
85 ;PRCVUOP Unit Of Purchase
86 S PRCVUOP=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",5)
87 ;PRCVQO Quantity Ordered
88 S PRCVQO=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",6)
89 ;PRCVUP Unit Price
90 S PRCVUP=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",7)
91 ;PRCVNIF NIF Number
92 S PRCVNIF=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",8)
93 ;I PRCVNIF="" S PRCVNIF="1234"
94 ;PRCVPM Packaging Multiple
95 S PRCVPM=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",9)
96 ;PRCVQR Quantity Received
97 S PRCVQR=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",10)
98 ;PRCVTIC Total Item Cost
99 S PRCVTIC=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",11)
100 ;PRCVDIC Discounted Item Cost
101 S PRCVDIC=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",12)
102 ;PRCVERD Expected Delivery Date
103 S PRCVERD=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",13)
104 S PRCVERD=$$FMTHL7^XLFDT(PRCVERD)
105 ;PRCVAT Amendment/Adjustment Type
106 S PRCVAT=$P(^TMP("PRCV442A",$J,PRCVX,N),"^",14)
107 I PRCVAT=1 S PRCVAT="1^Line Item Edit"
108 I PRCVAT=2 S PRCVAT="2^Line Item Delete"
109 I PRCVAT=3 S PRCVAT="3^Change Vendor"
110 I PRCVAT=4 S PRCVAT="4^Replace PO Number"
111 I PRCVAT=5 S PRCVAT="5^Authority Edit"
112 ;
113 ;Build ORC Segment
114 S PRCVCNT=PRCVCNT+1
115 S HLA("HLS",PRCVCNT)="ORC"_PRCVFS_PRCVT1_PRCVFS_PRCVPO_PRCVFS_PRCVFS_PRCVFS_PRCVFS_PRCVFS_PRCVFS_PRCVFS_PRCVDT_PRCVFS
116 S HLA("HLS",PRCVCNT)=HLA("HLS",PRCVCNT)_PRCVDZ_PRCVCS_PRCVNML_PRCVCS_PRCVNMF_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVCS_PRCVSTA_PRCVFS_PRCVFS_PRCVFS_PRCVFS_PRCVFS_PRCVFS_PRCVAT_PRCVFS_PRCVFS_PRCVFS_PRCVFS_PRCVFS_PRCVPSTA
117 ;
118 ;Build RQD Segment
119 S PRCVCNT=PRCVCNT+1
120 S HLA("HLS",PRCVCNT)="RQD"_PRCVFS_PRCVLN_PRCVFS_PRCVDDN_PRCVFS_PRCVIN_PRCVFS_PRCVPM_PRCVFS_PRCVQO_PRCVFS_PRCVUOP
121 S HLA("HLS",PRCVCNT)=HLA("HLS",PRCVCNT)_PRCVFS_PRCVFS_PRCVFS_PRCVTN_PRCVFS_PRCVERD
122 ;
123 ;Build RQ1 Segment
124 S PRCVCNT=PRCVCNT+1
125 S HLA("HLS",PRCVCNT)="RQ1"_PRCVFS_PRCVUP_PRCVFS_PRCVFS_PRCVFS_PRCVVNI_PRCVCS_PRCVCS_PRCVCS_PRCVVNF_PRCVFS_PRCVNIF
126 ;
127 ;Build FT1 Segment
128 S PRCVCNT=PRCVCNT+1
129 S HLA("HLS",PRCVCNT)="FT1"_PRCVFS_PRCVFS_PRCVFS_PRCVFS_PRCVDT_PRCVFS_PRCVFS_PRCVT2_PRCVFS_PRCVPO_PRCVFS
130 S HLA("HLS",PRCVCNT)=HLA("HLS",PRCVCNT)_PRCVFS_PRCVFS_PRCVQR_PRCVFS_PRCVTIC_PRCVFS_PRCVDIC
131 ;
132 Q
133 ;
134ORRPROC ;Process ORR^O02 response message
135 ;
136 ;Uses HLNEXT twice to bypass the MSH segment and go directly to the MSA segment
137 X HLNEXT
138 ;
139 X HLNEXT
140 S VAL=$$FLD^HLCSUTL(HLNODE,2)
141 I VAL'="AA" D ERROR
142 ;
143 D FIN
144 ;
145 Q
146 ;
147ERROR ;Process ERR Segments
148 S PRCVERC=1 F N=1:1 X HLNEXT Q:HLQUIT'>0 D
149 . S VAL=$$FLD^HLCSUTL(HLNODE,1)
150 . I VAL="ERR" S PRCVERC=PRCVERC+1,PRCVERM=$$FLD^HLCSUTL(HLNODE,6),PRCVERD=$$FLD^HLCSUTL(HLNODE,7)
151 . S PRCVPO2=$P(PRCVERD,"~",1)
152 . S PRCVERR(PRCVERC)="At Line Number "_$P(PRCVERD,"~",2)_" involving Document ID "_$P(PRCVERD,"~",3)_" the following errors occurred:"
153 . S PRCVERC=PRCVERC+1
154 . S PRCVERR(PRCVERC)=$P(PRCVERM,"^",2)
155 . Q
156 S PRCVERR(1)="PO # "_PRCVPO2_" failed to update in the DynaMed system"
157 ;
158 D CLIFP
159 ;
160 Q
161 ;
162CLIFP ;Call partner app w/ mail message for users on error
163 N XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ
164 I $D(PRCVPO) S PRCVPO2=PRCVPO
165 S XMSUB="Inventory System PO # "_PRCVPO2_" Errors "_$$HTE^XLFDT($H)
166 S XMDUZ="IFCAP/COTS Inventory Interface"
167 S XMTEXT="PRCVERR("
168 ;
169 S PRCVSIT=+PRCVPO2,PRCVFCP=$$FCP^PRCV442B(PRCVPO2)
170 D GETFCPU^PRCVLIC(.XMY,PRCVSIT,PRCVFCP)
171 ;
172 D ^XMD
173 S PRCVERG=1
174 K PRCVPO2,PRCVFCP,PRCVSIT
175 ;
176 Q
177 ;
178FIN ;Clean up variables
179 K PRCVINP,PRCVCNT,PRCVPO,PRCVTT,PRCVT1,PRCVT2,PRCVDZ,PRCVDNM,PRCVNML,PRCVNMF,PRCVVNI,PRCVVNF,PRCVDT,PRCVERD,PRCVSTA,N,PRCVX
180 K PRCVPRO,PRCVCS,PRCVFS,PRCVLN,PRCVDDN,PRCVIN,PRCVTN,PRCVUOP,PRCVQO,PRCVUP,PRCVNIF,PRCVPM,PRCVQR,PRCVTIC,PRCVDIC,PRCVAT,PRCVPSTA
181 K HLA,VAL,PRCVDP,PRCVERC,PRCVERM,PRCVERD,PRCVERR
182 ;
183 Q
Note: See TracBrowser for help on using the repository browser.