source: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCVRCA.m@ 1424

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

initial load of FOIAVistA 6/30/08 version
File size: 7.0 KB
Line 
1PRCVRCA ;WOIFO/SC-SEND RIL CANCELLATION TO DYNAMED ; 5/31/05 2:24pm
2 ;;5.1;IFCAP;**81**;Oct 20, 2000
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;PRCVRCA is called by routine PRCSRIE1.
6 ;This routine is extracting RIL cancellation data and passing it to
7 ;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,PRCVFLDS
20 N PRCVSTA,CNT,PRCVTM,PRCVCRDT,PRCVPGDT,PRCVL,PRCVDT
21 N PRCVI,PRCVJ,PRCVK,PRCVDID,PRCVITN,PRCVQTY,PRCVCOST,PRCVDNB
22 N PRCVDTCR,PRCVNAM,PRCVIEN,PRCVTIME,PRCVOCD,PRCVNAME
23 N PRCVFCP,PRCVTMGL,PRCVDMRL
24 ;
25 S PRCVDUZ=DUZ
26 S PRCVRIEN=PRCVDA
27 S PRCVTIME=$H
28 S PRCVEXTN=$$GET1^DIQ(410.3,PRCVRIEN_",",.01) ;.01 value of RIL trx
29 ;
30 ;Quit if RIL .01 value is not found in Audit File 414.02 'C' x-ref
31 S PRCVDMRL=""
32 S PRCVDMRL=$O(^PRCV(414.02,"C",PRCVEXTN,PRCVDMRL)) Q:PRCVDMRL=""
33 ;
34 S PRCVFCP=$P($G(PRCVEXTN),"-",4)
35 S PRCVNO="PRCVUP*"_PRCVEXTN ; Ext val in XTMP
36 ;S PRCVNO="PRCVUP*"_PRCVRIEN ; IEN in setting up XTMP global
37 S PRCVSTA=$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99)
38 S PRCVNAME=$$GET1^DIQ(200,PRCVDUZ_",",.01,"E")
39 ;
40 S CNT=0
41 K ^XTMP(PRCVNO,PRCVTIME)
42 D SETUP0 ; set up XTMP global's zero node
43 D ITEM ; process all of the items
44 I CNT>0 D SETUP1 ; if there is a line item then set Node 1
45 I CNT'>0 K ^XTMP(PRCVNO,PRCVTIME)
46 ;Call HL7 Message builder routine ONLY if there are DM line items
47 ;PRCVNO is comprised of "PRCVUP*Trx#" & Trx#: Sta-fy-Qtr-FCP-cc-seq#
48 ;PRCVTIME is time stamp in $H format
49 I CNT>0 D BEGIN^PRCVEE1(PRCVNO,PRCVTIME) ; passing EXT value .01
50 D EXIT
51 Q
52 ;
53ITEM ;
54 ;N PRCVARR
55 S PRCVI=0
56 F S PRCVI=$O(^PRCS(410.3,PRCVRIEN,1,PRCVI)) Q:PRCVI'>0!(+PRCVI=0) D
57 . N PRCVARR
58 . S PRCVFLDS=".01;1;2;3;4;6;7"
59 . D GETS^DIQ(410.31,PRCVI_","_PRCVRIEN_",",PRCVFLDS,"I","PRCVARR")
60 . D SETUP ; DO a setup in XTMP struct
61 . Q
62 Q
63 ;
64 ;
65SETUP ;set up XTMP ITEM node(S) & UPDATE audit file for each item on a RIL
66 ;Order Control code^Item ien^Qty^Vendor ien^^Cost^DynaMed doc ID^Date Needed By
67 ;
68 S PRCVOCD="CA" ; order control code ALWAYS=CA for RIL cancel
69 S PRCVITN=PRCVARR(410.31,PRCVI_","_PRCVRIEN_",",.01,"I") ;item ien N0P1
70 S PRCVDID=PRCVARR(410.31,PRCVI_","_PRCVRIEN_",",6,"I") ;DM docId N0P7
71 S PRCVQTY=PRCVARR(410.31,PRCVI_","_PRCVRIEN_",",1,"I") ; qty N0P2
72 S PRCVNAM=PRCVARR(410.31,PRCVI_","_PRCVRIEN_",",2,"I") ;vendor text name N0P3
73 S PRCVCOST=PRCVARR(410.31,PRCVI_","_PRCVRIEN_",",3,"I") ;est unit cost N0P4
74 S PRCVIEN=PRCVARR(410.31,PRCVI_","_PRCVRIEN_",",4,"I") ;vendor ien N0P5
75 S PRCVDNB=PRCVARR(410.31,PRCVI_","_PRCVRIEN_",",7,"I") ;dt needed by N0P8
76 I $G(PRCVDID)="" D IDBULET Q ; I DMdocid is missing send a bulletin
77 ;
78 ;
79 S CNT=CNT+1
80 S $P(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",1)=PRCVOCD
81 S $P(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",2)=PRCVITN
82 S $P(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",3)=PRCVQTY
83 S $P(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",4)=PRCVIEN
84 S $P(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",6)=PRCVCOST
85 S $P(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",7)=PRCVDID
86 S $P(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",8)=PRCVDNB
87 ;
88 ;update Audit File 414.02 for RIL cancel fields 8 and 9
89 ;#8 Date/Time removed from IFCAP #9 Who deleted
90 D NOW^%DTC
91 N PRCVZ,PRCVX
92 S PRCVZ=0
93 S PRCVZ=$O(^PRCV(414.02,"B",PRCVDID,PRCVZ))
94 I +$G(PRCVZ)'>0 D RDBULET Q ; if record is missing fr 414.02 file
95 ;S PRCVX(414.02,PRCVZ_",",1)=PRCVITN ; item ien
96 ;S PRCVX(414.02,PRCVZ_",",2)=PRCVIEN ; vendor ien
97 ;S PRCVX(414.02,PRCVZ_",",4)=PRCVEXTN ; RIL .01 value
98 S PRCVX(414.02,PRCVZ_",",8)=% ; int dt/time for removing
99 S PRCVX(414.02,PRCVZ_",",9)=PRCVDUZ ; who deleted
100 D UPDATE^DIE("","PRCVX")
101 I $D(^TMP("DIERR",$J)) D Q
102 . S XMB(1)="cancelling a Repetitive Item Entry (RIL)#: "_$G(PRCVEXTN)
103 . S XMB(2)=$G(PRCVDID)
104 . S XMB(3)="ERROR while updating the AUDIT FILE #414.02"
105 . K ^TMP($J,"PRCVRCA") S PRCVTMGL="PRCVRCA"
106 . S ^TMP($J,"PRCVRCA",1,0)=""
107 . S ^TMP($J,"PRCVRCA",2,0)="RIL #: "_$G(PRCVEXTN)
108 . S ^TMP($J,"PRCVRCA",3,0)="Item's IEN: "_$G(PRCVITN)
109 . S ^TMP($J,"PRCVRCA",4,0)="DM DOC ID: "_$G(PRCVDID)
110 . S ^TMP($J,"PRCVRCA",5,0)="Deleted By: "_$G(PRCVNAME)_" (DUZ: "_$G(PRCVDUZ)_")"
111 . S ^TMP($J,"PRCVRCA",6,0)="Date/Time of deletion: "_$G(PRCVTM)
112 . S ^TMP($J,"PRCVRCA",7,0)="Error Text: "_$G(^TMP("DIERR",$J,1,"TEXT",1))
113 . D DMERXMB^PRCVLIC(PRCVTMGL,PRCVSTA,PRCVFCP)
114 Q
115 ;
116SETUP0 ;set up XTMP 0 node
117 D NOW^%DTC,YX^%DTC
118 S PRCVTM=Y ;date/time in ext format
119 S PRCVCRDT=DT
120 S PRCVPGDT=$$FMADD^XLFDT(DT,5) ; purge XTMP global in 5 days
121 ;adding this extra 0 node to comply w SACC 4/28/05
122 S ^XTMP(PRCVNO,0)=PRCVPGDT_"^"_PRCVCRDT_"^"_"RIL Cancellation Update to DynaMed"
123 S $P(^XTMP(PRCVNO,PRCVTIME,0),"^",1)=PRCVPGDT
124 S $P(^XTMP(PRCVNO,PRCVTIME,0),"^",2)=PRCVCRDT
125 S $P(^XTMP(PRCVNO,PRCVTIME,0),"^",3)="RIL Cancellation Update to DynaMed: "_PRCVTM
126 Q
127 ;
128SETUP1 ;set up XTMP 1 node
129 ;Number of records^Site^Date/Time msg created^DUZ^Entered By Last Name^Entered By First Name^ien of the record
130 ;
131 S PRCVDTCR=$$GET1^DIQ(410.3,PRCVRIEN_",",4) ; Trx dt/tm in IFCAP
132 I $D(PRCVNAME),PRCVNAME]"" D NAMECOMP^XLFNAME(.PRCVNAME)
133 S $P(^XTMP(PRCVNO,PRCVTIME,1),"^",1)=CNT ; total no of items
134 S $P(^XTMP(PRCVNO,PRCVTIME,1),"^",2)=PRCVSTA ; Sta
135 ;S $P(^XTMP(PRCVNO,PRCVTIME,1),"^",3)=PRCVDTCR ; dt/time created
136 S $P(^XTMP(PRCVNO,PRCVTIME,1),"^",3)=PRCVDUZ ; DUZ
137 S $P(^XTMP(PRCVNO,PRCVTIME,1),"^",4)=PRCVNAME("FAMILY")
138 S $P(^XTMP(PRCVNO,PRCVTIME,1),"^",5)=PRCVNAME("GIVEN")
139 S $P(^XTMP(PRCVNO,PRCVTIME,1),"^",6)=PRCVRIEN ; ien of RIL
140 Q
141 ;
142IDBULET ; send a bulletin if DM DOC ID is missing
143 I PRCVDID="" D Q
144 . S XMB(1)="cancelling a Repetitive Item Entry (RIL)#: "_$G(PRCVEXTN)
145 . S XMB(2)=" ...None Found"
146 . S XMB(3)="The line item ien: "_$G(PRCVITN)_" is missing it's DM DOC ID"
147 . K ^TMP($J,"PRCVRCA") S PRCVTMGL="PRCVRCA"
148 . S ^TMP($J,"PRCVRCA",1,0)=""
149 . S ^TMP($J,"PRCVRCA",2,0)="RIL #: "_$G(PRCVEXTN)
150 . S ^TMP($J,"PRCVRCA",3,0)="Item's IEN: "_$G(PRCVITN)
151 . S ^TMP($J,"PRCVRCA",4,0)="Vendor Name: "_$G(PRCVNAM)
152 . S ^TMP($J,"PRCVRCA",5,0)="Deleted By: "_$G(PRCVNAME)_" (DUZ: "_$G(PRCVDUZ)_")"
153 . S ^TMP($J,"PRCVRCA",6,0)="Date/Time of deletion: "_$G(PRCVTM)
154 . D DMERXMB^PRCVLIC(PRCVTMGL,PRCVSTA,PRCVFCP)
155 Q
156 ;
157 ;PRCVZ - record in Audit File
158RDBULET ;if record is missing from file 414.02
159 I PRCVZ']"" D Q
160 . S XMB(1)="processing a cancel of a Repetitive Item Entry (RIL)#: "_$G(PRCVEXTN)
161 . S XMB(2)=$G(PRCVDID)
162 . S XMB(3)="the record related to DM DOC ID is missing in AUDIT FILE #414.02"
163 . K ^TMP($J,"PRCVRCA") S PRCVTMGL="PRCVRCA"
164 . S ^TMP($J,"PRCVRCA",1,0)=""
165 . S ^TMP($J,"PRCVRCA",2,0)="RIL #: "_$G(PRCVEXTN)
166 . S ^TMP($J,"PRCVRCA",3,0)="DM DOC ID: "_$G(PRCVDID)
167 . S ^TMP($J,"PRCVRCA",4,0)="Item's IEN: "_$G(PRCVITN)
168 . D DMERXMB^PRCVLIC(PRCVTMGL,PRCVSTA,PRCVFCP)
169 Q
170 ;
171EXIT ;kill variables and quit
172 K %,X,Y
173 Q
174 ;
175 ;
Note: See TracBrowser for help on using the repository browser.