PRCVTAP ;WOIFO/SC-2237 APPROVAL TO DYNAMED ; 5/31/05 2:30pm
;;5.1;IFCAP;**81**;Oct 20, 2000
;;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;PRCVTAP is called by routine PRCSAPP2
;This routine is extracting 2237 APPROVED data and passing that info
;to routine PRCVEE1 which formats data into HL7 Message and then
;sends data to DynaMed. It also updates relevant info in Audit File
;#414.02. A bulletin is send if DM DOC ID is missing from an item
;or if record doesn't get updated properly in Audit File.
;
EN(PRCVDA) ;
; Input PRCVDA = ien of top entry of the file
;Quit if system parameter is not set to DynaMed
N PRCVSYS
S PRCVSYS=$$GET^XPAR("SYS","PRCV COTS INVENTORY",1,"Q")
Q:PRCVSYS'=1
;
N PRCVRIEN,PRCVDUZ,PRCVNO,PRCVIT,PRCVEXTN,PRCVV,PRCVFLDS
N PRCVSTA,CNT,PRCVTM,K,PRCVCRDT,PRCVPGDT,PRCVL,PRCVDT
N PRCVI,PRCVJ,PRCVK,PRCVDID,PRCVITN,PRCVQTY,PRCVCST,PRCVDNB
N PRCVDTCR,PRCVNAME,PRCVIEN,PRCVTIME,PRCVOCD,PRCV2IEN
N PRCVAR,PRCVFMS,PRCVUOP,PRCVSTK,PRCVPKG,PRCVBOC,PRCVNIF
N PRCVFCP,PRCVTMG,PRCVTT
;
S PRCVDUZ=DUZ
S PRCV2IEN=PRCVDA ; ien of the 2237 trx.
S PRCVTIME=$H
S PRCVEXTN=$$GET1^DIQ(410,PRCV2IEN_",",.01) ;.01 value of 2237 trx
;
;Quit if DM 2237 .01 value is not found in Audit file 414.02 'D' xref
;And check if child 2237 that was split has a parent 2237 (in
;file 410, node 10, piece 2, fld51) is recorded in Audit File 414.02
;'D' x-ref.
S PRCVTT=$$CHKDM^PRCVLIC(PRCVEXTN) Q:PRCVTT'=1
;
D NOW^%DTC,YX^%DTC
S PRCVTM=Y ;date/time in ext format MAR 07, 2005@16:08
S PRCVFCP=$P($G(PRCVEXTN),"-",4)
S PRCVNO="PRCVUP*"_PRCVEXTN ; .01 val in the XTMP subscript
;S PRCVNO="PRCVUP*"_PRCV2IEN ; ien in the XTMP subscript
S PRCVSTA=$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99)
S PRCVNAME=$$GET1^DIQ(200,PRCVDUZ_",",.01,"E")
;
S CNT=0
K ^XTMP(PRCVNO,PRCVTIME)
D SETUP0 ; set up XTMP global's zero node
D ITEM ; process all of the items
I CNT>0 D SETUP1 ; if there is a line item then set Node 1
I CNT'>0 K ^XTMP(PRCVNO,PRCVTIME)
;Call HL7 Message builder/transmitter routine
;PRCVNO is comprised of "PRCVUP*Trx#" & Trx# is Sta-fy-Qtr-FCP-seq#
;PRCVTIME is time stamp in $H format
I CNT>0 D BEGIN^PRCVEE1(PRCVNO,PRCVTIME)
D EXIT
Q
;
ITEM ;
;N PRCVAR
S (PRCVI,PRCVJ,PRCVL)=0
S PRCVIEN=$$GET1^DIQ(410,PRCV2IEN_",",12,"I") ;vendor ien F410N3P4
S PRCVFMS=$$GET1^DIQ(440,PRCVIEN_",",34,"I") ;FMS vendor ien F440N3P4
;
F S PRCVI=$O(^PRCS(410,PRCV2IEN,"IT",PRCVI)) Q:PRCVI'>0!(+PRCVI=0) D
. N PRCVAR
. S PRCVFLDS="2;3;4;5;6;7;17"
. D GETS^DIQ(410.02,PRCVI_","_PRCV2IEN_",",PRCVFLDS,"","PRCVAR")
. S PRCVDNB=$$GET1^DIQ(410.02,PRCVI_","_PRCV2IEN_",",18,"I")
. D SETUP ; DO a setup in XTMP struct
. Q
Q
;
;
SETUP ;set up XTMP ITEM node(S) & UPDATE audit file for each item on a RIL
;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 #
;
S PRCVOCD="NW" ; order control code for 2237 approval
S PRCVQTY=PRCVAR(410.02,PRCVI_","_PRCV2IEN_",",2) ; qty N0P2
S PRCVUOP=PRCVAR(410.02,PRCVI_","_PRCV2IEN_",",3) ; unit of purchase N0P3
S PRCVBOC=PRCVAR(410.02,PRCVI_","_PRCV2IEN_",",4) ; BOC w descr N0P4
S PRCVITN=PRCVAR(410.02,PRCVI_","_PRCV2IEN_",",5) ; item ien N0P5
S PRCVSTK=PRCVAR(410.02,PRCVI_","_PRCV2IEN_",",6) ; stock # N0P6
S PRCVCST=PRCVAR(410.02,PRCVI_","_PRCV2IEN_",",7) ; unit cost N0P7
S PRCVDID=PRCVAR(410.02,PRCVI_","_PRCV2IEN_",",17) ; DM doc id N4P1
I PRCVDID="" D Q ; if DM doc id is missing, send a bulletin
. S XMB(1)="doing an approval of the 2237 #: "_PRCVEXTN
. S XMB(2)=" ...None Found"
. S XMB(3)="The line item ien: "_$G(PRCVITN)_" is missing it's DM DOC ID."
. K ^TMP($J,"PRCVTAP") S PRCVTMG="PRCVTAP"
. S ^TMP($J,"PRCVTAP",1,0)=""
. S ^TMP($J,"PRCVTAP",2,0)="2237 #: "_$G(PRCVEXTN)
. S ^TMP($J,"PRCVTAP",3,0)="Item's IEN: "_$G(PRCVITN)
. D DMERXMB^PRCVLIC(PRCVTMG,PRCVSTA,PRCVFCP)
. Q
;S PRCVDNB=PRCVAR(410.02,PRCVI_","_PRCV2IEN_",",18) ; dt needed in external FM format N4P2
;S PRCVDT=$$HLDATE^HLFNC(PRCVDNB,"DT") ; YYYYMMDD -- hl7 format
;S PRCVDT=$$FMTE^XLFDT(PRCVDNB,"7D") ; YYYY/M/D or YYYY/MM/DD
S PRCVPKG=$$GET1^DIQ(441.01,PRCVIEN_","_PRCVITN_",",1.6) ; pkg mult F441.01N0P8
S PRCVNIF=$$GET1^DIQ(441,PRCVITN_",",51) ; nif no F441N0P15
;
;
S CNT=CNT+1
S $P(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",1)=PRCVOCD
S $P(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",2)=PRCVITN
S $P(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",3)=PRCVQTY
S $P(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",4)=PRCVIEN
S $P(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",5)=PRCVFMS
S $P(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",6)=PRCVCST
S $P(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",7)=PRCVDID
S $P(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",8)=PRCVDNB
S $P(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",9)=PRCVUOP
S $P(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",10)=PRCVSTK
S $P(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",11)=PRCVPKG
S $P(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",12)=+PRCVBOC
S $P(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",13)=PRCVNIF
QUIT
;
;*****************************************************************
;UPDATE to Audit File 414.02 is NOT needed at this time, however
;leaving the code in as commented lines for future use.
;*****************************************************************
;update Audit File 414.02 for 2237 approval
;audit file field numbers #1/#2/#3/#7/#12
;
N PRCVZ,PRCVARR
;S PRCVZ=""
;S PRCVZ=$O(^PRCV(414.02,"B",PRCVDID,PRCVZ))
;I +$G(PRCVZ)'>0 D BULLET Q ;if record is missing fr 414.02 file
;S PRCVARR(414.02,PRCVZ_",",1)=PRCVITN
;S PRCVARR(414.02,PRCVZ_",",2)=PRCVIEN
;S PRCVARR(414.02,PRCVZ_",",3)=PRCVDUZ
;S PRCVARR(414.02,PRCVZ_",",7)=PRCVEXTN
;S PRCVARR(414.02,PRCVZ_",",12)=PRCVDNB
;D UPDATE^DIE("","PRCVARR")
;I $D(^TMP("DIERR",$J)) D Q
;.S XMB(1)="processing an approval of 2237 #: "_$G(PRCVEXTN)
;.S XMB(2)=$G(PRCVDID)
;.S XMB(3)="ERROR while updating AUDIT FILE #414.02"
;.K ^TMP($J,"PRCVTAP") S PRCVTMG="PRCVTAP"
;.S ^TMP($J,"PRCVTAP",1,0)=""
;.S ^TMP($J,"PRCVTAP",2,0)="2237 #: "_$G(PRCVEXTN)
;.S ^TMP($J,"PRCVTAP",3,0)="Item's IEN: "_$G(PRCVITN)
;.S ^TMP($J,"PRCVTAP",4,0)="DM DOC ID: "_$G(PRCVDID)
;.S ^TMP($J,"PRCVTAP",5,0)="Error Text: "_$G(^TMP("DIERR",$J,1,"TEXT",1))
;.D DMERXMB^PRCVLIC(PRCVTMG,PRCVSTA,PRCVFCP)
;QUIT
;
SETUP0 ;set up XTMP 0 node
;Termination Date^Entry Date^Descriptive Text_Time in ext format
;D NOW^%DTC,YX^%DTC
;S PRCVTM=Y ;date/time in ext format MAR 07, 2005@16:08
S PRCVCRDT=DT ; DT is FM internal dt 3050307
S PRCVPGDT=$$FMADD^XLFDT(DT,5) ; purge XTMP global in 5 days
;adding extra 0 node to comply w SACC std 4/28/05
S ^XTMP(PRCVNO,0)=PRCVPGDT_"^"_PRCVCRDT_"^"_"Transmit message to DynaMed for updates"
S $P(^XTMP(PRCVNO,PRCVTIME,0),"^",1)=PRCVPGDT
S $P(^XTMP(PRCVNO,PRCVTIME,0),"^",2)=PRCVCRDT
S $P(^XTMP(PRCVNO,PRCVTIME,0),"^",3)="2237 Approval Update to DynaMed: "_PRCVTM
Q
;
SETUP1 ;set up XTMP 1 node
;Number of records^Site^DUZ^Entered By Last Name^Entered By First Name^IEN of 2237
;
I $D(PRCVNAME),PRCVNAME]"" D NAMECOMP^XLFNAME(.PRCVNAME)
S $P(^XTMP(PRCVNO,PRCVTIME,1),"^")=CNT ; total no of items
S $P(^XTMP(PRCVNO,PRCVTIME,1),"^",2)=PRCVSTA ; Sta
;S $P(^XTMP(PRCVNO,PRCVTIME,1),"^",3)=PRCVDTCR ; dt/time created
S $P(^XTMP(PRCVNO,PRCVTIME,1),"^",3)=PRCVDUZ ; DUZ
S $P(^XTMP(PRCVNO,PRCVTIME,1),"^",4)=PRCVNAME("FAMILY")
S $P(^XTMP(PRCVNO,PRCVTIME,1),"^",5)=PRCVNAME("GIVEN")
S $P(^XTMP(PRCVNO,PRCVTIME,1),"^",6)=PRCV2IEN ; ien of 2237
Q
;
;PRCVZ - record in Audit File
BULLET ;Send a bulletin if record is missing from audit file
I PRCVZ="" D Q
.S XMB(1)="processing an approval of 2237 #: "_$G(PRCVEXTN)
.S XMB(2)=$G(PRCVDID)
.S XMB(3)="the record related to DM DOC ID is missing in AUDIT FILE #414.02"
.K ^TMP($J,"PRCVTAP") S PRCVTMG="PRCVTAP"
.S ^TMP($J,"PRCVTAP",1,0)=""
.S ^TMP($J,"PRCVTAP",2,0)="2237 #: "_$G(PRCVEXTN)
.S ^TMP($J,"PRCVTAP",3,0)="DM DOC ID: "_$G(PRCVDID)
.S ^TMP($J,"PRCVTAP",4,0)="Item's IEN: "_$G(PRCVITN)
.D DMERXMB^PRCVLIC(PRCVTMG,PRCVSTA,PRCVFCP)
Q
;
;
EXIT ;kill variables and quit
K %,X,Y
Q
;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCVTAP 8204 printed Dec 13, 2024@02:20:20 Page 2
PRCVTAP ;WOIFO/SC-2237 APPROVAL TO DYNAMED ; 5/31/05 2:30pm
+1 ;;5.1;IFCAP;**81**;Oct 20, 2000
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;PRCVTAP is called by routine PRCSAPP2
+5 ;This routine is extracting 2237 APPROVED data and passing that info
+6 ;to routine PRCVEE1 which formats data into HL7 Message and then
+7 ;sends data to DynaMed. It also updates relevant info in Audit File
+8 ;#414.02. A bulletin is send if DM DOC ID is missing from an item
+9 ;or if record doesn't get updated properly in Audit File.
+10 ;
EN(PRCVDA) ;
+1 ; Input PRCVDA = ien of top entry of the file
+2 ;Quit if system parameter is not set to DynaMed
+3 NEW PRCVSYS
+4 SET PRCVSYS=$$GET^XPAR("SYS","PRCV COTS INVENTORY",1,"Q")
+5 if PRCVSYS'=1
QUIT
+6 ;
+7 NEW PRCVRIEN,PRCVDUZ,PRCVNO,PRCVIT,PRCVEXTN,PRCVV,PRCVFLDS
+8 NEW PRCVSTA,CNT,PRCVTM,K,PRCVCRDT,PRCVPGDT,PRCVL,PRCVDT
+9 NEW PRCVI,PRCVJ,PRCVK,PRCVDID,PRCVITN,PRCVQTY,PRCVCST,PRCVDNB
+10 NEW PRCVDTCR,PRCVNAME,PRCVIEN,PRCVTIME,PRCVOCD,PRCV2IEN
+11 NEW PRCVAR,PRCVFMS,PRCVUOP,PRCVSTK,PRCVPKG,PRCVBOC,PRCVNIF
+12 NEW PRCVFCP,PRCVTMG,PRCVTT
+13 ;
+14 SET PRCVDUZ=DUZ
+15 ; ien of the 2237 trx.
SET PRCV2IEN=PRCVDA
+16 SET PRCVTIME=$HOROLOG
+17 ;.01 value of 2237 trx
SET PRCVEXTN=$$GET1^DIQ(410,PRCV2IEN_",",.01)
+18 ;
+19 ;Quit if DM 2237 .01 value is not found in Audit file 414.02 'D' xref
+20 ;And check if child 2237 that was split has a parent 2237 (in
+21 ;file 410, node 10, piece 2, fld51) is recorded in Audit File 414.02
+22 ;'D' x-ref.
+23 SET PRCVTT=$$CHKDM^PRCVLIC(PRCVEXTN)
if PRCVTT'=1
QUIT
+24 ;
+25 DO NOW^%DTC
DO YX^%DTC
+26 ;date/time in ext format MAR 07, 2005@16:08
SET PRCVTM=Y
+27 SET PRCVFCP=$PIECE($GET(PRCVEXTN),"-",4)
+28 ; .01 val in the XTMP subscript
SET PRCVNO="PRCVUP*"_PRCVEXTN
+29 ;S PRCVNO="PRCVUP*"_PRCV2IEN ; ien in the XTMP subscript
+30 SET PRCVSTA=$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99)
+31 SET PRCVNAME=$$GET1^DIQ(200,PRCVDUZ_",",.01,"E")
+32 ;
+33 SET CNT=0
+34 KILL ^XTMP(PRCVNO,PRCVTIME)
+35 ; set up XTMP global's zero node
DO SETUP0
+36 ; process all of the items
DO ITEM
+37 ; if there is a line item then set Node 1
IF CNT>0
DO SETUP1
+38 IF CNT'>0
KILL ^XTMP(PRCVNO,PRCVTIME)
+39 ;Call HL7 Message builder/transmitter routine
+40 ;PRCVNO is comprised of "PRCVUP*Trx#" & Trx# is Sta-fy-Qtr-FCP-seq#
+41 ;PRCVTIME is time stamp in $H format
+42 IF CNT>0
DO BEGIN^PRCVEE1(PRCVNO,PRCVTIME)
+43 DO EXIT
+44 QUIT
+45 ;
ITEM ;
+1 ;N PRCVAR
+2 SET (PRCVI,PRCVJ,PRCVL)=0
+3 ;vendor ien F410N3P4
SET PRCVIEN=$$GET1^DIQ(410,PRCV2IEN_",",12,"I")
+4 ;FMS vendor ien F440N3P4
SET PRCVFMS=$$GET1^DIQ(440,PRCVIEN_",",34,"I")
+5 ;
+6 FOR
SET PRCVI=$ORDER(^PRCS(410,PRCV2IEN,"IT",PRCVI))
if PRCVI'>0!(+PRCVI=0)
QUIT
Begin DoDot:1
+7 NEW PRCVAR
+8 SET PRCVFLDS="2;3;4;5;6;7;17"
+9 DO GETS^DIQ(410.02,PRCVI_","_PRCV2IEN_",",PRCVFLDS,"","PRCVAR")
+10 SET PRCVDNB=$$GET1^DIQ(410.02,PRCVI_","_PRCV2IEN_",",18,"I")
+11 ; DO a setup in XTMP struct
DO SETUP
+12 QUIT
End DoDot:1
+13 QUIT
+14 ;
+15 ;
SETUP ;set up XTMP ITEM node(S) & UPDATE audit file for each item on a RIL
+1 ;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 #
+2 ;
+3 ; order control code for 2237 approval
SET PRCVOCD="NW"
+4 ; qty N0P2
SET PRCVQTY=PRCVAR(410.02,PRCVI_","_PRCV2IEN_",",2)
+5 ; unit of purchase N0P3
SET PRCVUOP=PRCVAR(410.02,PRCVI_","_PRCV2IEN_",",3)
+6 ; BOC w descr N0P4
SET PRCVBOC=PRCVAR(410.02,PRCVI_","_PRCV2IEN_",",4)
+7 ; item ien N0P5
SET PRCVITN=PRCVAR(410.02,PRCVI_","_PRCV2IEN_",",5)
+8 ; stock # N0P6
SET PRCVSTK=PRCVAR(410.02,PRCVI_","_PRCV2IEN_",",6)
+9 ; unit cost N0P7
SET PRCVCST=PRCVAR(410.02,PRCVI_","_PRCV2IEN_",",7)
+10 ; DM doc id N4P1
SET PRCVDID=PRCVAR(410.02,PRCVI_","_PRCV2IEN_",",17)
+11 ; if DM doc id is missing, send a bulletin
IF PRCVDID=""
Begin DoDot:1
+12 SET XMB(1)="doing an approval of the 2237 #: "_PRCVEXTN
+13 SET XMB(2)=" ...None Found"
+14 SET XMB(3)="The line item ien: "_$GET(PRCVITN)_" is missing it's DM DOC ID."
+15 KILL ^TMP($JOB,"PRCVTAP")
SET PRCVTMG="PRCVTAP"
+16 SET ^TMP($JOB,"PRCVTAP",1,0)=""
+17 SET ^TMP($JOB,"PRCVTAP",2,0)="2237 #: "_$GET(PRCVEXTN)
+18 SET ^TMP($JOB,"PRCVTAP",3,0)="Item's IEN: "_$GET(PRCVITN)
+19 DO DMERXMB^PRCVLIC(PRCVTMG,PRCVSTA,PRCVFCP)
+20 QUIT
End DoDot:1
QUIT
+21 ;S PRCVDNB=PRCVAR(410.02,PRCVI_","_PRCV2IEN_",",18) ; dt needed in external FM format N4P2
+22 ;S PRCVDT=$$HLDATE^HLFNC(PRCVDNB,"DT") ; YYYYMMDD -- hl7 format
+23 ;S PRCVDT=$$FMTE^XLFDT(PRCVDNB,"7D") ; YYYY/M/D or YYYY/MM/DD
+24 ; pkg mult F441.01N0P8
SET PRCVPKG=$$GET1^DIQ(441.01,PRCVIEN_","_PRCVITN_",",1.6)
+25 ; nif no F441N0P15
SET PRCVNIF=$$GET1^DIQ(441,PRCVITN_",",51)
+26 ;
+27 ;
+28 SET CNT=CNT+1
+29 SET $PIECE(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",1)=PRCVOCD
+30 SET $PIECE(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",2)=PRCVITN
+31 SET $PIECE(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",3)=PRCVQTY
+32 SET $PIECE(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",4)=PRCVIEN
+33 SET $PIECE(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",5)=PRCVFMS
+34 SET $PIECE(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",6)=PRCVCST
+35 SET $PIECE(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",7)=PRCVDID
+36 SET $PIECE(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",8)=PRCVDNB
+37 SET $PIECE(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",9)=PRCVUOP
+38 SET $PIECE(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",10)=PRCVSTK
+39 SET $PIECE(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",11)=PRCVPKG
+40 SET $PIECE(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",12)=+PRCVBOC
+41 SET $PIECE(^XTMP(PRCVNO,PRCVTIME,2,CNT),"^",13)=PRCVNIF
+42 QUIT
+43 ;
+44 ;*****************************************************************
+45 ;UPDATE to Audit File 414.02 is NOT needed at this time, however
+46 ;leaving the code in as commented lines for future use.
+47 ;*****************************************************************
+48 ;update Audit File 414.02 for 2237 approval
+49 ;audit file field numbers #1/#2/#3/#7/#12
+50 ;
+51 NEW PRCVZ,PRCVARR
+52 ;S PRCVZ=""
+53 ;S PRCVZ=$O(^PRCV(414.02,"B",PRCVDID,PRCVZ))
+54 ;I +$G(PRCVZ)'>0 D BULLET Q ;if record is missing fr 414.02 file
+55 ;S PRCVARR(414.02,PRCVZ_",",1)=PRCVITN
+56 ;S PRCVARR(414.02,PRCVZ_",",2)=PRCVIEN
+57 ;S PRCVARR(414.02,PRCVZ_",",3)=PRCVDUZ
+58 ;S PRCVARR(414.02,PRCVZ_",",7)=PRCVEXTN
+59 ;S PRCVARR(414.02,PRCVZ_",",12)=PRCVDNB
+60 ;D UPDATE^DIE("","PRCVARR")
+61 ;I $D(^TMP("DIERR",$J)) D Q
+62 ;.S XMB(1)="processing an approval of 2237 #: "_$G(PRCVEXTN)
+63 ;.S XMB(2)=$G(PRCVDID)
+64 ;.S XMB(3)="ERROR while updating AUDIT FILE #414.02"
+65 ;.K ^TMP($J,"PRCVTAP") S PRCVTMG="PRCVTAP"
+66 ;.S ^TMP($J,"PRCVTAP",1,0)=""
+67 ;.S ^TMP($J,"PRCVTAP",2,0)="2237 #: "_$G(PRCVEXTN)
+68 ;.S ^TMP($J,"PRCVTAP",3,0)="Item's IEN: "_$G(PRCVITN)
+69 ;.S ^TMP($J,"PRCVTAP",4,0)="DM DOC ID: "_$G(PRCVDID)
+70 ;.S ^TMP($J,"PRCVTAP",5,0)="Error Text: "_$G(^TMP("DIERR",$J,1,"TEXT",1))
+71 ;.D DMERXMB^PRCVLIC(PRCVTMG,PRCVSTA,PRCVFCP)
+72 ;QUIT
+73 ;
SETUP0 ;set up XTMP 0 node
+1 ;Termination Date^Entry Date^Descriptive Text_Time in ext format
+2 ;D NOW^%DTC,YX^%DTC
+3 ;S PRCVTM=Y ;date/time in ext format MAR 07, 2005@16:08
+4 ; DT is FM internal dt 3050307
SET PRCVCRDT=DT
+5 ; purge XTMP global in 5 days
SET PRCVPGDT=$$FMADD^XLFDT(DT,5)
+6 ;adding extra 0 node to comply w SACC std 4/28/05
+7 SET ^XTMP(PRCVNO,0)=PRCVPGDT_"^"_PRCVCRDT_"^"_"Transmit message to DynaMed for updates"
+8 SET $PIECE(^XTMP(PRCVNO,PRCVTIME,0),"^",1)=PRCVPGDT
+9 SET $PIECE(^XTMP(PRCVNO,PRCVTIME,0),"^",2)=PRCVCRDT
+10 SET $PIECE(^XTMP(PRCVNO,PRCVTIME,0),"^",3)="2237 Approval Update to DynaMed: "_PRCVTM
+11 QUIT
+12 ;
SETUP1 ;set up XTMP 1 node
+1 ;Number of records^Site^DUZ^Entered By Last Name^Entered By First Name^IEN of 2237
+2 ;
+3 IF $DATA(PRCVNAME)
IF PRCVNAME]""
DO NAMECOMP^XLFNAME(.PRCVNAME)
+4 ; total no of items
SET $PIECE(^XTMP(PRCVNO,PRCVTIME,1),"^")=CNT
+5 ; Sta
SET $PIECE(^XTMP(PRCVNO,PRCVTIME,1),"^",2)=PRCVSTA
+6 ;S $P(^XTMP(PRCVNO,PRCVTIME,1),"^",3)=PRCVDTCR ; dt/time created
+7 ; DUZ
SET $PIECE(^XTMP(PRCVNO,PRCVTIME,1),"^",3)=PRCVDUZ
+8 SET $PIECE(^XTMP(PRCVNO,PRCVTIME,1),"^",4)=PRCVNAME("FAMILY")
+9 SET $PIECE(^XTMP(PRCVNO,PRCVTIME,1),"^",5)=PRCVNAME("GIVEN")
+10 ; ien of 2237
SET $PIECE(^XTMP(PRCVNO,PRCVTIME,1),"^",6)=PRCV2IEN
+11 QUIT
+12 ;
+13 ;PRCVZ - record in Audit File
BULLET ;Send a bulletin if record is missing from audit file
+1 IF PRCVZ=""
Begin DoDot:1
+2 SET XMB(1)="processing an approval of 2237 #: "_$GET(PRCVEXTN)
+3 SET XMB(2)=$GET(PRCVDID)
+4 SET XMB(3)="the record related to DM DOC ID is missing in AUDIT FILE #414.02"
+5 KILL ^TMP($JOB,"PRCVTAP")
SET PRCVTMG="PRCVTAP"
+6 SET ^TMP($JOB,"PRCVTAP",1,0)=""
+7 SET ^TMP($JOB,"PRCVTAP",2,0)="2237 #: "_$GET(PRCVEXTN)
+8 SET ^TMP($JOB,"PRCVTAP",3,0)="DM DOC ID: "_$GET(PRCVDID)
+9 SET ^TMP($JOB,"PRCVTAP",4,0)="Item's IEN: "_$GET(PRCVITN)
+10 DO DMERXMB^PRCVLIC(PRCVTMG,PRCVSTA,PRCVFCP)
End DoDot:1
QUIT
+11 QUIT
+12 ;
+13 ;
EXIT ;kill variables and quit
+1 KILL %,X,Y
+2 QUIT
+3 ;
+4 ;
