- PRCVTCA ;WOIFO/SC-2237 CANCEL TO DYNAMED ; 5/31/05 2:31pm
- ;;5.1;IFCAP;**81**;Oct 20, 2000
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- Q
- ;PRCVTCA is called by routine PRCSEA
- ;This routine is extracting 2237 data when a user enters thru an
- ;option Cancel a Permanent Transaction [PRCSCT] 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,PRCVTMP,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,node10,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="CA" ; order control code for entire 2237 cancellation
- 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)="processing a CANCEL 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,"PRCVTCA") S PRCVTMP="PRCVTCA"
- . S ^TMP($J,"PRCVTCA",1,0)=""
- . S ^TMP($J,"PRCVTCA",2,0)="2237 #: "_$G(PRCVEXTN)
- . S ^TMP($J,"PRCVTCA",3,0)="Item's IEN: "_$G(PRCVITN)
- . D DMERXMB^PRCVLIC(PRCVTMP,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
- ;
- ;update Audit File 414.02 for 2237 CANCEL fields 8 and 9
- ;#8 date/time removed from IFCAP #9 who deleted
- D NOW^%DTC
- 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_",",8)=% ; int dt/time for removing
- S PRCVARR(414.02,PRCVZ_",",9)=PRCVDUZ ; who deleted
- D UPDATE^DIE("","PRCVARR")
- I $D(^TMP("DIERR",$J)) D Q
- .S XMB(1)="processing CANCEL of a 2237 #: "_$G(PRCVEXTN)
- .S XMB(2)=$G(PRCVDID)
- .S XMB(3)="ERROR while updating AUDIT FILE #414.02"
- .K ^TMP($J,"PRCVTCA") S PRCVTMP="PRCVTCA"
- .S ^TMP($J,"PRCVTCA",1,0)=""
- .S ^TMP($J,"PRCVTCA",2,0)="2237 #: "_$G(PRCVEXTN)
- .S ^TMP($J,"PRCVTCA",3,0)="Item's IEN: "_$G(PRCVITN)
- .S ^TMP($J,"PRCVTCA",4,0)="DM DOC ID: "_$G(PRCVDID)
- .S ^TMP($J,"PRCVTCA",5,0)="Deleted By: "_$G(PRCVNAME)_" (DUZ: "_$G(PRCVDUZ)_")"
- .S ^TMP($J,"PRCVTCA",6,0)="Error Text: "_$G(^TMP("DIERR",$J,1,"TEXT",1))
- .D DMERXMB^PRCVLIC(PRCVTMP,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 Cancellation 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 CANCEL 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,"PRCVTCA") S PRCVTMP="PRCVTCA"
- .S ^TMP($J,"PRCVTCA",1,0)=""
- .S ^TMP($J,"PRCVTCA",2,0)="2237 #: "_$G(PRCVEXTN)
- .S ^TMP($J,"PRCVTCA",3,0)="DM DOC ID: "_$G(PRCVDID)
- .S ^TMP($J,"PRCVTCA",4,0)="Item's IEN: "_$G(PRCVITN)
- .D DMERXMB^PRCVLIC(PRCVTMP,PRCVSTA,PRCVFCP)
- Q
- ;
- ;
- EXIT ;kill variables and quit
- K %,X,Y
- Q
- ;
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCVTCA 8004 printed Feb 18, 2025@23:46:43 Page 2
- PRCVTCA ;WOIFO/SC-2237 CANCEL TO DYNAMED ; 5/31/05 2:31pm
- +1 ;;5.1;IFCAP;**81**;Oct 20, 2000
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 QUIT
- +4 ;PRCVTCA is called by routine PRCSEA
- +5 ;This routine is extracting 2237 data when a user enters thru an
- +6 ;option Cancel a Permanent Transaction [PRCSCT] and passing that
- +7 ;info to routine PRCVEE1 which formats data into HL7 Message and
- +8 ;then sends data to DynaMed. It also updates relevant info in Audit
- +9 ;File #414.02. A bulletin is send if DM DOC ID is missing from an
- +10 ;item or if record doesn't get updated properly in Audit File.
- +11 ;
- 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,PRCVTMP,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,node10,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 entire 2237 cancellation
- SET PRCVOCD="CA"
- +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)="processing a CANCEL 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,"PRCVTCA")
- SET PRCVTMP="PRCVTCA"
- +16 SET ^TMP($JOB,"PRCVTCA",1,0)=""
- +17 SET ^TMP($JOB,"PRCVTCA",2,0)="2237 #: "_$GET(PRCVEXTN)
- +18 SET ^TMP($JOB,"PRCVTCA",3,0)="Item's IEN: "_$GET(PRCVITN)
- +19 DO DMERXMB^PRCVLIC(PRCVTMP,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 ;
- +43 ;update Audit File 414.02 for 2237 CANCEL fields 8 and 9
- +44 ;#8 date/time removed from IFCAP #9 who deleted
- +45 DO NOW^%DTC
- +46 NEW PRCVZ,PRCVARR
- +47 SET PRCVZ=""
- +48 SET PRCVZ=$ORDER(^PRCV(414.02,"B",PRCVDID,PRCVZ))
- +49 ;if record is missing fr 414.02 file
- IF +$GET(PRCVZ)'>0
- DO BULLET
- QUIT
- +50 ; int dt/time for removing
- SET PRCVARR(414.02,PRCVZ_",",8)=%
- +51 ; who deleted
- SET PRCVARR(414.02,PRCVZ_",",9)=PRCVDUZ
- +52 DO UPDATE^DIE("","PRCVARR")
- +53 IF $DATA(^TMP("DIERR",$JOB))
- Begin DoDot:1
- +54 SET XMB(1)="processing CANCEL of a 2237 #: "_$GET(PRCVEXTN)
- +55 SET XMB(2)=$GET(PRCVDID)
- +56 SET XMB(3)="ERROR while updating AUDIT FILE #414.02"
- +57 KILL ^TMP($JOB,"PRCVTCA")
- SET PRCVTMP="PRCVTCA"
- +58 SET ^TMP($JOB,"PRCVTCA",1,0)=""
- +59 SET ^TMP($JOB,"PRCVTCA",2,0)="2237 #: "_$GET(PRCVEXTN)
- +60 SET ^TMP($JOB,"PRCVTCA",3,0)="Item's IEN: "_$GET(PRCVITN)
- +61 SET ^TMP($JOB,"PRCVTCA",4,0)="DM DOC ID: "_$GET(PRCVDID)
- +62 SET ^TMP($JOB,"PRCVTCA",5,0)="Deleted By: "_$GET(PRCVNAME)_" (DUZ: "_$GET(PRCVDUZ)_")"
- +63 SET ^TMP($JOB,"PRCVTCA",6,0)="Error Text: "_$GET(^TMP("DIERR",$JOB,1,"TEXT",1))
- +64 DO DMERXMB^PRCVLIC(PRCVTMP,PRCVSTA,PRCVFCP)
- End DoDot:1
- QUIT
- +65 QUIT
- +66 ;
- 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 Cancellation 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 CANCEL 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,"PRCVTCA")
- SET PRCVTMP="PRCVTCA"
- +6 SET ^TMP($JOB,"PRCVTCA",1,0)=""
- +7 SET ^TMP($JOB,"PRCVTCA",2,0)="2237 #: "_$GET(PRCVEXTN)
- +8 SET ^TMP($JOB,"PRCVTCA",3,0)="DM DOC ID: "_$GET(PRCVDID)
- +9 SET ^TMP($JOB,"PRCVTCA",4,0)="Item's IEN: "_$GET(PRCVITN)
- +10 DO DMERXMB^PRCVLIC(PRCVTMP,PRCVSTA,PRCVFCP)
- End DoDot:1
- QUIT
- +11 QUIT
- +12 ;
- +13 ;
- EXIT ;kill variables and quit
- +1 KILL %,X,Y
- +2 QUIT
- +3 ;
- +4 ;