source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCVTAP.m@ 724

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

initial load of WorldVistAEHR
File size: 7.8 KB
Line 
1PRCVTAP ;WOIFO/SC-2237 APPROVAL TO DYNAMED ; 5/31/05 2:30pm
2 ;;5.1;IFCAP;**81**;Oct 20, 2000
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;PRCVTAP is called by routine PRCSAPP2
6 ;This routine is extracting 2237 APPROVED data and passing that info
7 ;to routine PRCVEE1 which formats data into HL7 Message and then
8 ;sends data to DynaMed. It also updates relevant info in Audit File
9 ;#414.02. A bulletin is send if DM DOC ID is missing from an item
10 ;or if record doesn't get updated properly in Audit File.
11 ;
12EN(PRCVDA) ;
13 ; Input PRCVDA = ien of top entry of the file
14 ;Quit if system parameter is not set to DynaMed
15 N PRCVSYS
16 S PRCVSYS=$$GET^XPAR("SYS","PRCV COTS INVENTORY",1,"Q")
17 Q:PRCVSYS'=1
18 ;
19 N PRCVRIEN,PRCVDUZ,PRCVNO,PRCVIT,PRCVEXTN,PRCVV,PRCVFLDS
20 N PRCVSTA,CNT,PRCVTM,K,PRCVCRDT,PRCVPGDT,PRCVL,PRCVDT
21 N PRCVI,PRCVJ,PRCVK,PRCVDID,PRCVITN,PRCVQTY,PRCVCST,PRCVDNB
22 N PRCVDTCR,PRCVNAME,PRCVIEN,PRCVTIME,PRCVOCD,PRCV2IEN
23 N PRCVAR,PRCVFMS,PRCVUOP,PRCVSTK,PRCVPKG,PRCVBOC,PRCVNIF
24 N PRCVFCP,PRCVTMG,PRCVTT
25 ;
26 S PRCVDUZ=DUZ
27 S PRCV2IEN=PRCVDA ; ien of the 2237 trx.
28 S PRCVTIME=$H
29 S PRCVEXTN=$$GET1^DIQ(410,PRCV2IEN_",",.01) ;.01 value of 2237 trx
30 ;
31 ;Quit if DM 2237 .01 value is not found in Audit file 414.02 'D' xref
32 ;And check if child 2237 that was split has a parent 2237 (in
33 ;file 410, node 10, piece 2, fld51) is recorded in Audit File 414.02
34 ;'D' x-ref.
35 S PRCVTT=$$CHKDM^PRCVLIC(PRCVEXTN) Q:PRCVTT'=1
36 ;
37 D NOW^%DTC,YX^%DTC
38 S PRCVTM=Y ;date/time in ext format MAR 07, 2005@16:08
39 S PRCVFCP=$P($G(PRCVEXTN),"-",4)
40 S PRCVNO="PRCVUP*"_PRCVEXTN ; .01 val in the XTMP subscript
41 ;S PRCVNO="PRCVUP*"_PRCV2IEN ; ien in the XTMP subscript
42 S PRCVSTA=$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99)
43 S PRCVNAME=$$GET1^DIQ(200,PRCVDUZ_",",.01,"E")
44 ;
45 S CNT=0
46 K ^XTMP(PRCVNO,PRCVTIME)
47 D SETUP0 ; set up XTMP global's zero node
48 D ITEM ; process all of the items
49 I CNT>0 D SETUP1 ; if there is a line item then set Node 1
50 I CNT'>0 K ^XTMP(PRCVNO,PRCVTIME)
51 ;Call HL7 Message builder/transmitter routine
52 ;PRCVNO is comprised of "PRCVUP*Trx#" & Trx# is Sta-fy-Qtr-FCP-seq#
53 ;PRCVTIME is time stamp in $H format
54 I CNT>0 D BEGIN^PRCVEE1(PRCVNO,PRCVTIME)
55 D EXIT
56 Q
57 ;
58ITEM ;
59 ;N PRCVAR
60 S (PRCVI,PRCVJ,PRCVL)=0
61 S PRCVIEN=$$GET1^DIQ(410,PRCV2IEN_",",12,"I") ;vendor ien F410N3P4
62 S PRCVFMS=$$GET1^DIQ(440,PRCVIEN_",",34,"I") ;FMS vendor ien F440N3P4
63 ;
64 F S PRCVI=$O(^PRCS(410,PRCV2IEN,"IT",PRCVI)) Q:PRCVI'>0!(+PRCVI=0) D
65 . N PRCVAR
66 . S PRCVFLDS="2;3;4;5;6;7;17"
67 . D GETS^DIQ(410.02,PRCVI_","_PRCV2IEN_",",PRCVFLDS,"","PRCVAR")
68 . S PRCVDNB=$$GET1^DIQ(410.02,PRCVI_","_PRCV2IEN_",",18,"I")
69 . D SETUP ; DO a setup in XTMP struct
70 . Q
71 Q
72 ;
73 ;
74SETUP ;set up XTMP ITEM node(S) & UPDATE audit file for each item on a RIL
75 ;Order Control code^Item ien^Qty^Vendor ien^^Cost^DynaMed doc ID^Date Needed By^Unit of Purchase^Vendor Stock Number^Packaging Mult.^BOC^Nif #
76 ;
77 S PRCVOCD="NW" ; order control code for 2237 approval
78 S PRCVQTY=PRCVAR(410.02,PRCVI_","_PRCV2IEN_",",2) ; qty N0P2
79 S PRCVUOP=PRCVAR(410.02,PRCVI_","_PRCV2IEN_",",3) ; unit of purchase N0P3
80 S PRCVBOC=PRCVAR(410.02,PRCVI_","_PRCV2IEN_",",4) ; BOC w descr N0P4
81 S PRCVITN=PRCVAR(410.02,PRCVI_","_PRCV2IEN_",",5) ; item ien N0P5
82 S PRCVSTK=PRCVAR(410.02,PRCVI_","_PRCV2IEN_",",6) ; stock # N0P6
83 S PRCVCST=PRCVAR(410.02,PRCVI_","_PRCV2IEN_",",7) ; unit cost N0P7
84 S PRCVDID=PRCVAR(410.02,PRCVI_","_PRCV2IEN_",",17) ; DM doc id N4P1
85 I PRCVDID="" D Q ; if DM doc id is missing, send a bulletin
86 . S XMB(1)="doing an approval of the 2237 #: "_PRCVEXTN
87 . S XMB(2)=" ...None Found"
88 . S XMB(3)="The line item ien: "_$G(PRCVITN)_" is missing it's DM DOC ID."
89 . K ^TMP($J,"PRCVTAP") S PRCVTMG="PRCVTAP"
90 . S ^TMP($J,"PRCVTAP",1,0)=""
91 . S ^TMP($J,"PRCVTAP",2,0)="2237 #: "_$G(PRCVEXTN)
92 . S ^TMP($J,"PRCVTAP",3,0)="Item's IEN: "_$G(PRCVITN)
93 . D DMERXMB^PRCVLIC(PRCVTMG,PRCVSTA,PRCVFCP)
94 . Q
95 ;S PRCVDNB=PRCVAR(410.02,PRCVI_","_PRCV2IEN_",",18) ; dt needed in external FM format N4P2
96 ;S PRCVDT=$$HLDATE^HLFNC(PRCVDNB,"DT") ; YYYYMMDD -- hl7 format
97 ;S PRCVDT=$$FMTE^XLFDT(PRCVDNB,"7D") ; YYYY/M/D or YYYY/MM/DD
98 S PRCVPKG=$$GET1^DIQ(441.01,PRCVIEN_","_PRCVITN_",",1.6) ; pkg mult F441.01N0P8
99 S PRCVNIF=$$GET1^DIQ(441,PRCVITN_",",51) ; nif no F441N0P15
100 ;
101 ;
102 S CNT=CNT+1
103 S $P(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",1)=PRCVOCD
104 S $P(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",2)=PRCVITN
105 S $P(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",3)=PRCVQTY
106 S $P(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",4)=PRCVIEN
107 S $P(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",5)=PRCVFMS
108 S $P(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",6)=PRCVCST
109 S $P(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",7)=PRCVDID
110 S $P(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",8)=PRCVDNB
111 S $P(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",9)=PRCVUOP
112 S $P(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",10)=PRCVSTK
113 S $P(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",11)=PRCVPKG
114 S $P(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",12)=+PRCVBOC
115 S $P(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",13)=PRCVNIF
116 QUIT
117 ;
118 ;*****************************************************************
119 ;UPDATE to Audit File 414.02 is NOT needed at this time, however
120 ;leaving the code in as commented lines for future use.
121 ;*****************************************************************
122 ;update Audit File 414.02 for 2237 approval
123 ;audit file field numbers #1/#2/#3/#7/#12
124 ;
125 N PRCVZ,PRCVARR
126 ;S PRCVZ=""
127 ;S PRCVZ=$O(^PRCV(414.02,"B",PRCVDID,PRCVZ))
128 ;I +$G(PRCVZ)'>0 D BULLET Q ;if record is missing fr 414.02 file
129 ;S PRCVARR(414.02,PRCVZ_",",1)=PRCVITN
130 ;S PRCVARR(414.02,PRCVZ_",",2)=PRCVIEN
131 ;S PRCVARR(414.02,PRCVZ_",",3)=PRCVDUZ
132 ;S PRCVARR(414.02,PRCVZ_",",7)=PRCVEXTN
133 ;S PRCVARR(414.02,PRCVZ_",",12)=PRCVDNB
134 ;D UPDATE^DIE("","PRCVARR")
135 ;I $D(^TMP("DIERR",$J)) D Q
136 ;.S XMB(1)="processing an approval of 2237 #: "_$G(PRCVEXTN)
137 ;.S XMB(2)=$G(PRCVDID)
138 ;.S XMB(3)="ERROR while updating AUDIT FILE #414.02"
139 ;.K ^TMP($J,"PRCVTAP") S PRCVTMG="PRCVTAP"
140 ;.S ^TMP($J,"PRCVTAP",1,0)=""
141 ;.S ^TMP($J,"PRCVTAP",2,0)="2237 #: "_$G(PRCVEXTN)
142 ;.S ^TMP($J,"PRCVTAP",3,0)="Item's IEN: "_$G(PRCVITN)
143 ;.S ^TMP($J,"PRCVTAP",4,0)="DM DOC ID: "_$G(PRCVDID)
144 ;.S ^TMP($J,"PRCVTAP",5,0)="Error Text: "_$G(^TMP("DIERR",$J,1,"TEXT",1))
145 ;.D DMERXMB^PRCVLIC(PRCVTMG,PRCVSTA,PRCVFCP)
146 ;QUIT
147 ;
148SETUP0 ;set up XTMP 0 node
149 ;Termination Date^Entry Date^Descriptive Text_Time in ext format
150 ;D NOW^%DTC,YX^%DTC
151 ;S PRCVTM=Y ;date/time in ext format MAR 07, 2005@16:08
152 S PRCVCRDT=DT ; DT is FM internal dt 3050307
153 S PRCVPGDT=$$FMADD^XLFDT(DT,5) ; purge XTMP global in 5 days
154 ;adding extra 0 node to comply w SACC std 4/28/05
155 S ^XTMP(PRCVNO,0)=PRCVPGDT_"^"_PRCVCRDT_"^"_"Transmit message to DynaMed for updates"
156 S $P(^XTMP(PRCVNO,PRCVTIME,0),"^",1)=PRCVPGDT
157 S $P(^XTMP(PRCVNO,PRCVTIME,0),"^",2)=PRCVCRDT
158 S $P(^XTMP(PRCVNO,PRCVTIME,0),"^",3)="2237 Approval Update to DynaMed: "_PRCVTM
159 Q
160 ;
161SETUP1 ;set up XTMP 1 node
162 ;Number of records^Site^DUZ^Entered By Last Name^Entered By First Name^IEN of 2237
163 ;
164 I $D(PRCVNAME),PRCVNAME]"" D NAMECOMP^XLFNAME(.PRCVNAME)
165 S $P(^XTMP(PRCVNO,PRCVTIME,1),"^")=CNT ; total no of items
166 S $P(^XTMP(PRCVNO,PRCVTIME,1),"^",2)=PRCVSTA ; Sta
167 ;S $P(^XTMP(PRCVNO,PRCVTIME,1),"^",3)=PRCVDTCR ; dt/time created
168 S $P(^XTMP(PRCVNO,PRCVTIME,1),"^",3)=PRCVDUZ ; DUZ
169 S $P(^XTMP(PRCVNO,PRCVTIME,1),"^",4)=PRCVNAME("FAMILY")
170 S $P(^XTMP(PRCVNO,PRCVTIME,1),"^",5)=PRCVNAME("GIVEN")
171 S $P(^XTMP(PRCVNO,PRCVTIME,1),"^",6)=PRCV2IEN ; ien of 2237
172 Q
173 ;
174 ;PRCVZ - record in Audit File
175BULLET ;Send a bulletin if record is missing from audit file
176 I PRCVZ="" D Q
177 .S XMB(1)="processing an approval of 2237 #: "_$G(PRCVEXTN)
178 .S XMB(2)=$G(PRCVDID)
179 .S XMB(3)="the record related to DM DOC ID is missing in AUDIT FILE #414.02"
180 .K ^TMP($J,"PRCVTAP") S PRCVTMG="PRCVTAP"
181 .S ^TMP($J,"PRCVTAP",1,0)=""
182 .S ^TMP($J,"PRCVTAP",2,0)="2237 #: "_$G(PRCVEXTN)
183 .S ^TMP($J,"PRCVTAP",3,0)="DM DOC ID: "_$G(PRCVDID)
184 .S ^TMP($J,"PRCVTAP",4,0)="Item's IEN: "_$G(PRCVITN)
185 .D DMERXMB^PRCVLIC(PRCVTMG,PRCVSTA,PRCVFCP)
186 Q
187 ;
188 ;
189EXIT ;kill variables and quit
190 K %,X,Y
191 Q
192 ;
193 ;
Note: See TracBrowser for help on using the repository browser.