source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHAAC1.m@ 1046

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

initial load of WorldVistAEHR
File size: 6.4 KB
Line 
1PRCHAAC1 ;WIFO/CR-CONT. OF IFCAP HL7 MESSAGE TO AUSTIN ;3/4/05 11:43 AM
2 ;;5.1;IFCAP;**79,105**;Oct 20, 2000;Build 4
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; This routine is called from the routine PRCHAAC.
6 ; Set up HL7 environment for message.
7 K HLA,HL,HLFS,HLCS,HLRS
8 N PRCAPPO,PRCPPA,PRCERR,PRCMID,PRCMSG,PRCSEG,PRCSUB,PRCPROT,PRCRSULT,PRCOPTNS
9 S PRCDUZ=$G(DUZ) I +PRCDUZ'>0 D EN^DDIOL("User undefined","","!!?5") Q 0 ;DUZ is system-supplied
10 S PRCPROT="PRC_IFCAP_01_EV_AAC"
11 D INIT^HLFNC2(PRCPROT,.HL)
12 I $G(HL) D Q 0 ;tell user if there was an error
13 . S PRCMSG=0
14 . I $P(HL,"^",2)]"" D
15 .. D:'$D(ZTQUEUED) EN^DDIOL("Error: "_$P(HL,"^",2)_" occurred. Please try later.")
16 ;
17 S HLFS=$G(HL("FS")) ;field separator
18 S HLCS=$E(HL("ECH"),1) ;component separator
19 S HLRS=$E(HL("ECH"),2) ;repetition separator
20 ;
21 ;======== MFI Segment ===========
22 S PRCSEG="MFI"_HLFS_"CDM"_HLFS_HLFS_"UPD"_HLFS_HLFS_HLFS_"AL"
23 S HLA("HLS",1)=PRCSEG
24 ;
25 ;======== MFE Segment ===========
26 S PRCSEG="MFE"_HLFS_"MAD"_HLFS_HLFS
27 S $P(PRCSEG,HLFS,5)="V"_PRCROOT_HLFS_"CE" ;primary key value
28 S HLA("HLS",2)=PRCSEG
29 ;
30 ;======== CDM Segment ===========
31 S PRCSEG="CDM"
32 S $P(PRCSEG,HLFS,2)="V"_PRCROOT ;primary key value
33 S $P(PRCSEG,HLFS,4)="PROCUREMENT DETAIL FROM IFCAP"
34 S $P(PRCSEG,HLFS,12)=PRCCN ;contract number
35 S:$G(PRCAM)="" $P(PRCSEG,HLFS,13)=PRCVEN_HLCS_HLCS_PRCDB
36 S HLA("HLS",3)=PRCSEG
37 ;
38 ;======== PRC Segment ===========
39 S PRCSEG="PRC"
40 S $P(PRCSEG,HLFS,2)="V"_PRCROOT ;primary key value
41 S:$G(PRCAM)="" $P(PRCSEG,HLFS,10)="0"_HLCS_"US"
42 S $P(PRCSEG,HLFS,11)=PRCAMT_HLCS_"US"
43 S $P(PRCSEG,HLFS,12)=$G(PRCOD) ;effective start date = P.O. Date
44 S $P(PRCSEG,HLFS,13)=$G(PRCDD) ;effective end date = delivery date
45 S HLA("HLS",4)=PRCSEG
46 ;
47 ;======== ZPO Segment ===========
48 ; Purchase order details - check if this PO has been amended and get
49 ; just a few fields for this segment as requested by Austin Automation
50 ; Center (AAC)
51 I $D(^PRC(442,PRCHPO,6,0)) G AMEND
52 S PRCSEG="ZPO"
53 S:$G(PRCECC)'="" $P(PRCSEG,HLFS,2)=PRCECC ;extent competed
54 S:$G(PRCRNC)'="" $P(PRCSEG,HLFS,3)=PRCRNC ;reason not competed
55 S $P(PRCSEG,HLFS,4)=PRCEPAC ;EPA designated product
56 S:$G(PRCFSC)'="" $P(PRCSEG,HLFS,5)=PRCFSC ;Federal Supply Class. (or PSC code)
57 S $P(PRCSEG,HLFS,6)=PRCPP ;place of performance question
58 S $P(PRCSEG,HLFS,7)=PRCPF ;place of performance
59 S $P(PRCSEG,HLFS,8)=PRCCB ;contract bundling
60 S $P(PRCSEG,HLFS,9)="N" ;government furnished eqmt.
61 S $P(PRCSEG,HLFS,10)=PRCPER ;DUZ^LastName^FirstName (contr. officer)
62 S $P(PRCSEG,HLFS,11)=PRCMOP ;method of processing
63 S $P(PRCSEG,HLFS,12)="J" ;type of contract
64 S $P(PRCSEG,HLFS,13)=PRCAAD ;alternative advertising
65 S $P(PRCSEG,HLFS,14)=$G(PRCDS) ;date PO was signed
66 S $P(PRCSEG,HLFS,15)=PRCAT ;award type
67 S $P(PRCSEG,HLFS,16)=PRCRT ;record type
68 S $P(PRCSEG,HLFS,17)=PRCSPC ;solicitation procedure
69 S $P(PRCSEG,HLFS,18)=PRCEPC ;evaluated preference
70 S $P(PRCSEG,HLFS,19)=PRCFAC ;funding agency code
71 S $P(PRCSEG,HLFS,20)="N" ;contract funded by foreign gov.
72 S $P(PRCSEG,HLFS,21)=PRCFOC ;funding agency office code
73 S $P(PRCSEG,HLFS,22)=PRCMY ;multiyear (for contracts)
74 S $P(PRCSEG,HLFS,23)=PRCPAS ;pre award synopsis
75 S $P(PRCSEG,HLFS,24)="N" ;synopsis waiver
76 S $P(PRCSEG,HLFS,25)=PRCNOF ;number of offers
77 S $P(PRCSEG,HLFS,26)=PRCUV_HLCS_"US" ;ultimate contract value
78 S $P(PRCSEG,HLFS,27)=PRCCV_HLCS_"US" ;current contract value
79 S $P(PRCSEG,HLFS,28)=PRCDES ;description of reqmt. (line item)
80 S $P(PRCSEG,HLFS,29)=3600 ;agency identifier
81 S $P(PRCSEG,HLFS,30)=PRCBZ ;business size
82 S $P(PRCSEG,HLFS,31)=PRCTSAC ;type set aside
83 S $P(PRCSEG,HLFS,32)=PRCPBC ;perf. based service contract
84 S $P(PRCSEG,HLFS,33)=3600 ;contracting agency code
85 S $P(PRCSEG,HLFS,34)=PRCOFC ;contracting office code
86 S $P(PRCSEG,HLFS,35)=PRCCH ;Clinger Cohen Act
87 S $P(PRCSEG,HLFS,37)=PRCUCD ;ultimate completion date
88 S HLA("HLS",5)=PRCSEG
89 G GEN
90 ;
91AMEND ; Get ready for a short amended message
92 S PRCSEG="ZPO"
93 S $P(PRCSEG,HLFS,14)=PRCDS ;date PO was signed
94 S $P(PRCSEG,HLFS,16)=PRCRT ;record type
95 S $P(PRCSEG,HLFS,20)="N" ;contract funded by foreign govt.
96 S $P(PRCSEG,HLFS,26)=PRCUV_HLCS_"US" ;ultimate contract value
97 S $P(PRCSEG,HLFS,27)=PRCCV_HLCS_"US" ;current contract value
98 S $P(PRCSEG,HLFS,29)=3600 ;agency identifier
99 S $P(PRCSEG,HLFS,33)=3600 ;contracting agency code
100 S $P(PRCSEG,HLFS,34)=PRCOFC ;contracting office code
101 S $P(PRCSEG,HLFS,36)=$G(PRCMN) ;modification number (amendment #)
102 S $P(PRCSEG,HLFS,38)=$G(PRCRMC) ;reason for mod. (amend authority)
103 S HLA("HLS",5)=PRCSEG
104 ;
105 ; Call HL7 to build/send message and get its number (PRCMID)
106GEN D GENERATE^HLMA(PRCPROT,"LM",1,.PRCRSULT,"",.PRCOPTNS)
107 I $P(PRCRSULT,U,1)]"" S PRCMID=$P(PRCRSULT,U,1)
108 S PRCSUB=$S(PRCMID>0:"PRCHAAC1;"_PRCMID,1:"PRCHAAC1;"_"No MID")
109MAIL2 ;
110 S MSG(1,0)="The following Purchase Order transaction has been sent "
111 S MSG(2,0)="to the Austin Automation Center (AAC) to report"
112 S MSG(3,0)="required FPDS information. Please keep this information"
113 S MSG(4,0)="for two weeks for tracking purposes."
114 S MSG(5,0)=" "
115 S MSG(6,0)="Purchase Order Number: "_$E(PRCROOT,1,3)_"-"_$E(PRCROOT,4,9)
116 S MSG(7,0)=" "
117 S MSG(8,0)="The HL7 Message # is: "_PRCMID
118 S XMSUB="Message for PO #: "_$E(PRCROOT,1,3)_"-"_$E(PRCROOT,4,9)_" to the AAC"
119 ; Get approving official for a delivery order, certified invoice, etc.
120 I $D(^PRC(442,PRCHPO,10)) D
121 . I $P(^PRC(442,PRCHPO,23),U,11)="D" S PRCAPPO=$P(^PRC(442,PRCHPO,10,1,0),U,2)
122 . E S PRCAPPO=$P(^PRC(442,PRCHPO,10,1,0),U,2)
123 ;
124 ; Get approving official for an order created by a purchasing agent
125 I $P($G(^PRC(442,PRCHPO,23)),U,11)="" D
126 . I '$D(^PRC(442,PRCHPO,13)) Q
127 . S PRC2237=$P(^PRC(442,PRCHPO,13,0),U,3)
128 . S PRCAPPO=$P(^PRC(442,PRCHPO,13,PRC2237,0),U,2)
129 ;
130 ; Get authorized buyer for all POs
131 S PRCPPA=$P(^PRC(442,PRCHPO,1),U,10)
132 S XMDUZ=PRCDUZ
133 S XMY(PRCPPA)=""
134 S:$G(PRCAPPO)'="" XMY(PRCAPPO)=""
135 S XMTEXT="MSG("
136 D ^XMD
137 ;
138 D LOG^PRCHAAC2 ;log record of outgoing message to the AAC
139 ; Keep track of any error found
140 I $P(PRCRSULT,U,2,3)]"",+PRCMID=0 D
141 . S PRCMID=$P(PRCRSULT,U,2,3)
142 . S PRCERR=1
143 . D REC^PRCHAAC2
144 K HLA,HL,HLFS,HLCS,HLRS
145 Q
Note: See TracBrowser for help on using the repository browser.