DGBTVUP ;ALB/MRY-UPDATE LOCAL VENDOR FILE W/ COREFLS VENDORS ;7/15/2003
;;1.0;Beneficiary Travel;**2,3**;September 25, 2001
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
; the subroutines in this program are part of the Update Vendor
; File event. It builds a global array of the vendor ids for
; the CoreFLS local vendor file update with CoreFLS Vendor records.
; The vendor IDs are passed to CoreFLS via DGBT software so
; retrieval of CoreFLS Vendor records can be done. The retrieved
; records are sent back to VistA for update to the local vendor
; file (#392.31).
;
EN ; entry point for Update Vendor REcords option
; build temporary global containing CoreFLS vendor ids
N X S X="CSLVQ" X ^%ZOSF("TEST") I '$T W !!," ** COREFLS Package CSL V1.0 not installed. **" Q
I '$D(^DGBT(392.31)) W !!,$C(7),"There are no CoreFLS Vendor IDs stored in the CoreFLS Local Vendor File (392.31)",!,"Vendor File Update cannot occur." Q
W !?5,"Update of the CoreFLS Local Vendor file (#392.31) will begin."
N DGBTDA,DGBTNUM,DGBTSITE,DGBTDATE
S DGBTDA=0 F S DGBTDA=$O(^DGBT(392.31,DGBTDA)) Q:'DGBTDA D
. S DGBTNUM=$$GET1^DIQ(392.31,DGBTDA_",",.02,"I") ; site number
. S DGBTSITE=$$GET1^DIQ(392.31,DGBTDA_",",.03,"I") ; site
. S DGBTDATE=$$GET1^DIQ(392.31,DGBTDA_",",3.01,"I") ; date of last update
. I DGBTNUM="",DGBTSITE="" Q
. S ^TMP("DGBTVUP",$J,DGBTDA)=DGBTNUM_"^"_DGBTSITE_"^"_DGBTDATE
; DGBT API is called to pass list of vendor ids for processing
; The vendor update operates asynchronously using a callback model
; input - 1st argument is Name of an array (local or global)
; containing ID, Site ID and Date of Last Update for each
; vendor to be updated
; 2nd argument is the entry point for the DGBT software to
; call once CoreFLS returns the vendor records. This
; entry point belongs to the API that will perform the
; COREFLS LOCAL VENDOR file (392.31) update.
D UPDATE^CSLVQ($NA(^TMP("DGBTVUP",$J)),"UPD^DGBTVUP")
Q
;
UPD(DGBTARRY) ;
; DGBTARRY is an input and is the name of the global or local arry
; containing the vendor record(s) retrieved from the CoreFLS
; vendor tables via a request from DGBT software
;
N DGBTFDA,DGBTVDA,DGBTIDX
S (DGBTIDX,DGBTVDA,DGBTCNT)=0
F S DGBTIDX=$O(@DGBTARRY@(DGBTIDX)) Q:'DGBTIDX D
. S DGBTVDA=$O(^DGBT(392.31,"BB",@DGBTARRY@(DGBTIDX,"SITE_CODE"),@DGBTARRY@(DGBTIDX,"NUMBER"),""))
. I 'DGBTVDA S DGBTCNT=DGBTCNT+1,^TMP("DGBTUPDERR",$J,DGBTCNT)="No record entry found for CoreFLS Vendor Number and Vendor Site Name "_@DGBTARRY@(DGBTIDX,"NUMBER")_", "_@DGBTARRY@(DGBTIDX,"SITE_CODE") Q
. D FILE
D GETERRM,SMSG
Q
;
FILE ; file into existing entry
L +^DGBT(392.31,DGBTVDA):30
I '$T S DGBTCNT=DGBTCNT+1,^TMP("DGBTUPDERR",$J,DGBTCNT)="Record entry "_DGBTVDA_"could not be locked during COREFLS LOCAL VENDOR file update process. Record entry update with CoreFLS Vendor record not performed." Q
I $D(@DGBTARRY@(DGBTIDX,"NAME")) D
. S DGBTFDA(1,392.31,DGBTVDA_",",.01)=@DGBTARRY@(DGBTIDX,"NAME")
I $D(@DGBTARRY@(DGBTIDX,"NUMBER")) D
. S DGBTFDA(1,392.31,DGBTVDA_",",.02)=@DGBTARRY@(DGBTIDX,"NUMBER")
I $D(@DGBTARRY@(DGBTIDX,"TAXID")) D
. S DGBTFDA(1,392.31,DGBTVDA_",",.04)=@DGBTARRY@(DGBTIDX,"TAXID")
I $D(@DGBTARRY@(DGBTIDX,"AREA_CODE")) D
. S DGBTFDA(1,392.31,DGBTVDA_",",.05)=@DGBTARRY@(DGBTIDX,"AREA_CODE")
I $D(@DGBTARRY@(DGBTIDX,"PHONE")) D
. S DGBTFDA(1,392.31,DGBTVDA_",",.06)=@DGBTARRY@(DGBTIDX,"PHONE")
I $D(@DGBTARRY@(DGBTIDX,"FAX_AREA_CODE")) D
. S DGBTFDA(1,392.31,DGBTVDA_",",.07)=@DGBTARRY@(DGBTIDX,"FAX_AREA_CODE")
I $D(@DGBTARRY@(DGBTIDX,"FAX")) D
. S DGBTFDA(1,392.31,DGBTVDA_",",.08)=@DGBTARRY@(DGBTIDX,"FAX")
I $D(@DGBTARRY@(DGBTIDX,"ADDRESS1")) D
. S DGBTFDA(1,392.31,DGBTVDA_",",1.01)=@DGBTARRY@(DGBTIDX,"ADDRESS1")
I $D(@DGBTARRY@(DGBTIDX,"ADDRESS2")) D
. S DGBTFDA(1,392.31,DGBTVDA_",",1.02)=@DGBTARRY@(DGBTIDX,"ADDRESS2")
I $D(@DGBTARRY@(DGBTIDX,"ADDRESS3")) D
. S DGBTFDA(1,392.31,DGBTVDA_",",1.03)=@DGBTARRY@(DGBTIDX,"ADDRESS3")
I $D(@DGBTARRY@(DGBTIDX,"CITY")) D
. S DGBTFDA(1,392.31,DGBTVDA_",",2.01)=@DGBTARRY@(DGBTIDX,"CITY")
I $D(@DGBTARRY@(DGBTIDX,"STATE")) D
. S DGBTFDA(1,392.31,DGBTVDA_",",2.02)=@DGBTARRY@(DGBTIDX,"STATE")
I $D(@DGBTARRY@(DGBTIDX,"ZIP")) D
. S DGBTFDA(1,392.31,DGBTVDA_",",2.03)=@DGBTARRY@(DGBTIDX,"ZIP")
I $D(@DGBTARRY@(DGBTIDX,"SITE_CODE")) D
. S DGBTFDA(1,392.31,DGBTVDA_",",.03)=@DGBTARRY@(DGBTIDX,"SITE_CODE")
I $D(@DGBTARRY@(DGBTIDX,"LAST_UPDATED")) D
. S DGBTFDA(1,392.31,DGBTVDA_",",3.01)=@DGBTARRY@(DGBTIDX,"LAST_UPDATED")
I $D(@DGBTARRY@(DGBTIDX,"INACTIVE_DATE")) D
. S DGBTFDA(1,392.31,DGBTVDA_",",3.02)=@DGBTARRY@(DGBTIDX,"INACTIVE_DATE")
D FILE^DIE("","DGBTFDA(1)","")
L -^DGBT(392.31,DGBTVDA)
Q
;
GETERRM ; pull any exceptions from FM output array and assign to ^TMP
Q:'$D(DIERR) ; quit if no output array
N DGBTERRC,DGBTERRT,DGBTERRN,DGBTERRP,DGBTCNT,MSGARRY,DGBTERRM
S (DGBTERRC,DGBTERRN)=0,DGBTCNT=1
F S DGBTERRC=$O(^TMP("DIERR",$J,"E",DGBTERRC)) Q:'DGBTERRC F S DGBTERRN=$O(^TMP("DIERR",$J,"E",DGBTERRC,DGBTERRN)) Q:'DGBTERRN D
. S DGBTERRP=0 F S DGBTERRP=$O(^TMP("DIERR",$J,DGBTERRN,"PARAM",DGBTERRP)) Q:DGBTERRP="" S MSGARRY("PARAM"_DGBTERRP)=DGBTERRP_" "_^(DGBTERRP)
. S DGBTERRT=0 F S DGBTERRT=$O(^TMP("DIERR",$J,DGBTERRN,"TEXT",DGBTERRT)) Q:'DGBTERRT S MSGARRY("TEXT"_DGBTERRT)=^(DGBTERRT)
. S DGBTERRM="" F S DGBTERRM=$O(MSGARRY(DGBTERRM)) Q:DGBTERRM="" S DGBTCNT=DGBTCNT+1,^TMP("DGBTUPDERR",$J,DGBTCNT)=MSGARRY(DGBTERRM)
; clean FM error message output array
D CLEAN^DILF
Q
;
SMSG ; necessary assignment of variables for MAILMAN processing
N XMDUZ,XMSUB,XMTEXT,XMY,DGBTSITE
S DGBTSITE=$P($$SITE^VASITE,"^",2)
S X=$T(+0) X ^%ZOSF("RSUM") S ^TMP("DGBTUPDERR",$J,1)="CoreFLS Local Vendor file update run at "_DGBTSITE_" = "_Y
S XMY("YORTY.M@MNTVBB.FO-ALBANY.DOMAIN.EXT")=""
S %DT="T",X="NOW" D ^%DT,DD^LRX S DGBTNOW=Y
S XMSUB="CoreFLS Local Vendor file update at "_DGBTSITE_" at "_DGBTNOW,XMDUZ="UPDATE VENDOR RECORDS post-update message"
S XMTEXT="^TMP(""DGBTUPDERR"",$J,"
D ^XMD
K ^TMP("DGBTUPDERR",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGBTVUP 6229 printed Apr 09, 2024@20:46:05 Page 2
DGBTVUP ;ALB/MRY-UPDATE LOCAL VENDOR FILE W/ COREFLS VENDORS ;7/15/2003
+1 ;;1.0;Beneficiary Travel;**2,3**;September 25, 2001
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ; the subroutines in this program are part of the Update Vendor
+5 ; File event. It builds a global array of the vendor ids for
+6 ; the CoreFLS local vendor file update with CoreFLS Vendor records.
+7 ; The vendor IDs are passed to CoreFLS via DGBT software so
+8 ; retrieval of CoreFLS Vendor records can be done. The retrieved
+9 ; records are sent back to VistA for update to the local vendor
+10 ; file (#392.31).
+11 ;
EN ; entry point for Update Vendor REcords option
+1 ; build temporary global containing CoreFLS vendor ids
+2 NEW X
SET X="CSLVQ"
XECUTE ^%ZOSF("TEST")
IF '$TEST
WRITE !!," ** COREFLS Package CSL V1.0 not installed. **"
QUIT
+3 IF '$DATA(^DGBT(392.31))
WRITE !!,$CHAR(7),"There are no CoreFLS Vendor IDs stored in the CoreFLS Local Vendor File (392.31)",!,"Vendor File Update cannot occur."
QUIT
+4 WRITE !?5,"Update of the CoreFLS Local Vendor file (#392.31) will begin."
+5 NEW DGBTDA,DGBTNUM,DGBTSITE,DGBTDATE
+6 SET DGBTDA=0
FOR
SET DGBTDA=$ORDER(^DGBT(392.31,DGBTDA))
if 'DGBTDA
QUIT
Begin DoDot:1
+7 ; site number
SET DGBTNUM=$$GET1^DIQ(392.31,DGBTDA_",",.02,"I")
+8 ; site
SET DGBTSITE=$$GET1^DIQ(392.31,DGBTDA_",",.03,"I")
+9 ; date of last update
SET DGBTDATE=$$GET1^DIQ(392.31,DGBTDA_",",3.01,"I")
+10 IF DGBTNUM=""
IF DGBTSITE=""
QUIT
+11 SET ^TMP("DGBTVUP",$JOB,DGBTDA)=DGBTNUM_"^"_DGBTSITE_"^"_DGBTDATE
End DoDot:1
+12 ; DGBT API is called to pass list of vendor ids for processing
+13 ; The vendor update operates asynchronously using a callback model
+14 ; input - 1st argument is Name of an array (local or global)
+15 ; containing ID, Site ID and Date of Last Update for each
+16 ; vendor to be updated
+17 ; 2nd argument is the entry point for the DGBT software to
+18 ; call once CoreFLS returns the vendor records. This
+19 ; entry point belongs to the API that will perform the
+20 ; COREFLS LOCAL VENDOR file (392.31) update.
+21 DO UPDATE^CSLVQ($NAME(^TMP("DGBTVUP",$JOB)),"UPD^DGBTVUP")
+22 QUIT
+23 ;
UPD(DGBTARRY) ;
+1 ; DGBTARRY is an input and is the name of the global or local arry
+2 ; containing the vendor record(s) retrieved from the CoreFLS
+3 ; vendor tables via a request from DGBT software
+4 ;
+5 NEW DGBTFDA,DGBTVDA,DGBTIDX
+6 SET (DGBTIDX,DGBTVDA,DGBTCNT)=0
+7 FOR
SET DGBTIDX=$ORDER(@DGBTARRY@(DGBTIDX))
if 'DGBTIDX
QUIT
Begin DoDot:1
+8 SET DGBTVDA=$ORDER(^DGBT(392.31,"BB",@DGBTARRY@(DGBTIDX,"SITE_CODE"),@DGBTARRY@(DGBTIDX,"NUMBER"),""))
+9 IF 'DGBTVDA
SET DGBTCNT=DGBTCNT+1
SET ^TMP("DGBTUPDERR",$JOB,DGBTCNT)="No record entry found for CoreFLS Vendor Number and Vendor Site Name "_@DGBTARRY@(DGBTIDX,"NUMBER")_", "_@DGBTARRY@(DGBTIDX,"SITE_CODE")
QUIT
+10 DO FILE
End DoDot:1
+11 DO GETERRM
DO SMSG
+12 QUIT
+13 ;
FILE ; file into existing entry
+1 LOCK +^DGBT(392.31,DGBTVDA):30
+2 IF '$TEST
SET DGBTCNT=DGBTCNT+1
SET ^TMP("DGBTUPDERR",$JOB,DGBTCNT)="Record entry "_DGBTVDA_"could not be locked during COREFLS LOCAL VENDOR file update process. Record entry update with CoreFLS Vendor record not performed."
QUIT
+3 IF $DATA(@DGBTARRY@(DGBTIDX,"NAME"))
Begin DoDot:1
+4 SET DGBTFDA(1,392.31,DGBTVDA_",",.01)=@DGBTARRY@(DGBTIDX,"NAME")
End DoDot:1
+5 IF $DATA(@DGBTARRY@(DGBTIDX,"NUMBER"))
Begin DoDot:1
+6 SET DGBTFDA(1,392.31,DGBTVDA_",",.02)=@DGBTARRY@(DGBTIDX,"NUMBER")
End DoDot:1
+7 IF $DATA(@DGBTARRY@(DGBTIDX,"TAXID"))
Begin DoDot:1
+8 SET DGBTFDA(1,392.31,DGBTVDA_",",.04)=@DGBTARRY@(DGBTIDX,"TAXID")
End DoDot:1
+9 IF $DATA(@DGBTARRY@(DGBTIDX,"AREA_CODE"))
Begin DoDot:1
+10 SET DGBTFDA(1,392.31,DGBTVDA_",",.05)=@DGBTARRY@(DGBTIDX,"AREA_CODE")
End DoDot:1
+11 IF $DATA(@DGBTARRY@(DGBTIDX,"PHONE"))
Begin DoDot:1
+12 SET DGBTFDA(1,392.31,DGBTVDA_",",.06)=@DGBTARRY@(DGBTIDX,"PHONE")
End DoDot:1
+13 IF $DATA(@DGBTARRY@(DGBTIDX,"FAX_AREA_CODE"))
Begin DoDot:1
+14 SET DGBTFDA(1,392.31,DGBTVDA_",",.07)=@DGBTARRY@(DGBTIDX,"FAX_AREA_CODE")
End DoDot:1
+15 IF $DATA(@DGBTARRY@(DGBTIDX,"FAX"))
Begin DoDot:1
+16 SET DGBTFDA(1,392.31,DGBTVDA_",",.08)=@DGBTARRY@(DGBTIDX,"FAX")
End DoDot:1
+17 IF $DATA(@DGBTARRY@(DGBTIDX,"ADDRESS1"))
Begin DoDot:1
+18 SET DGBTFDA(1,392.31,DGBTVDA_",",1.01)=@DGBTARRY@(DGBTIDX,"ADDRESS1")
End DoDot:1
+19 IF $DATA(@DGBTARRY@(DGBTIDX,"ADDRESS2"))
Begin DoDot:1
+20 SET DGBTFDA(1,392.31,DGBTVDA_",",1.02)=@DGBTARRY@(DGBTIDX,"ADDRESS2")
End DoDot:1
+21 IF $DATA(@DGBTARRY@(DGBTIDX,"ADDRESS3"))
Begin DoDot:1
+22 SET DGBTFDA(1,392.31,DGBTVDA_",",1.03)=@DGBTARRY@(DGBTIDX,"ADDRESS3")
End DoDot:1
+23 IF $DATA(@DGBTARRY@(DGBTIDX,"CITY"))
Begin DoDot:1
+24 SET DGBTFDA(1,392.31,DGBTVDA_",",2.01)=@DGBTARRY@(DGBTIDX,"CITY")
End DoDot:1
+25 IF $DATA(@DGBTARRY@(DGBTIDX,"STATE"))
Begin DoDot:1
+26 SET DGBTFDA(1,392.31,DGBTVDA_",",2.02)=@DGBTARRY@(DGBTIDX,"STATE")
End DoDot:1
+27 IF $DATA(@DGBTARRY@(DGBTIDX,"ZIP"))
Begin DoDot:1
+28 SET DGBTFDA(1,392.31,DGBTVDA_",",2.03)=@DGBTARRY@(DGBTIDX,"ZIP")
End DoDot:1
+29 IF $DATA(@DGBTARRY@(DGBTIDX,"SITE_CODE"))
Begin DoDot:1
+30 SET DGBTFDA(1,392.31,DGBTVDA_",",.03)=@DGBTARRY@(DGBTIDX,"SITE_CODE")
End DoDot:1
+31 IF $DATA(@DGBTARRY@(DGBTIDX,"LAST_UPDATED"))
Begin DoDot:1
+32 SET DGBTFDA(1,392.31,DGBTVDA_",",3.01)=@DGBTARRY@(DGBTIDX,"LAST_UPDATED")
End DoDot:1
+33 IF $DATA(@DGBTARRY@(DGBTIDX,"INACTIVE_DATE"))
Begin DoDot:1
+34 SET DGBTFDA(1,392.31,DGBTVDA_",",3.02)=@DGBTARRY@(DGBTIDX,"INACTIVE_DATE")
End DoDot:1
+35 DO FILE^DIE("","DGBTFDA(1)","")
+36 LOCK -^DGBT(392.31,DGBTVDA)
+37 QUIT
+38 ;
GETERRM ; pull any exceptions from FM output array and assign to ^TMP
+1 ; quit if no output array
if '$DATA(DIERR)
QUIT
+2 NEW DGBTERRC,DGBTERRT,DGBTERRN,DGBTERRP,DGBTCNT,MSGARRY,DGBTERRM
+3 SET (DGBTERRC,DGBTERRN)=0
SET DGBTCNT=1
+4 FOR
SET DGBTERRC=$ORDER(^TMP("DIERR",$JOB,"E",DGBTERRC))
if 'DGBTERRC
QUIT
FOR
SET DGBTERRN=$ORDER(^TMP("DIERR",$JOB,"E",DGBTERRC,DGBTERRN))
if 'DGBTERRN
QUIT
Begin DoDot:1
+5 SET DGBTERRP=0
FOR
SET DGBTERRP=$ORDER(^TMP("DIERR",$JOB,DGBTERRN,"PARAM",DGBTERRP))
if DGBTERRP=""
QUIT
SET MSGARRY("PARAM"_DGBTERRP)=DGBTERRP_" "_^(DGBTERRP)
+6 SET DGBTERRT=0
FOR
SET DGBTERRT=$ORDER(^TMP("DIERR",$JOB,DGBTERRN,"TEXT",DGBTERRT))
if 'DGBTERRT
QUIT
SET MSGARRY("TEXT"_DGBTERRT)=^(DGBTERRT)
+7 SET DGBTERRM=""
FOR
SET DGBTERRM=$ORDER(MSGARRY(DGBTERRM))
if DGBTERRM=""
QUIT
SET DGBTCNT=DGBTCNT+1
SET ^TMP("DGBTUPDERR",$JOB,DGBTCNT)=MSGARRY(DGBTERRM)
End DoDot:1
+8 ; clean FM error message output array
+9 DO CLEAN^DILF
+10 QUIT
+11 ;
SMSG ; necessary assignment of variables for MAILMAN processing
+1 NEW XMDUZ,XMSUB,XMTEXT,XMY,DGBTSITE
+2 SET DGBTSITE=$PIECE($$SITE^VASITE,"^",2)
+3 SET X=$TEXT(+0)
XECUTE ^%ZOSF("RSUM")
SET ^TMP("DGBTUPDERR",$JOB,1)="CoreFLS Local Vendor file update run at "_DGBTSITE_" = "_Y
+4 SET XMY("YORTY.M@MNTVBB.FO-ALBANY.DOMAIN.EXT")=""
+5 SET %DT="T"
SET X="NOW"
DO ^%DT
DO DD^LRX
SET DGBTNOW=Y
+6 SET XMSUB="CoreFLS Local Vendor file update at "_DGBTSITE_" at "_DGBTNOW
SET XMDUZ="UPDATE VENDOR RECORDS post-update message"
+7 SET XMTEXT="^TMP(""DGBTUPDERR"",$J,"
+8 DO ^XMD
+9 KILL ^TMP("DGBTUPDERR",$JOB)
+10 QUIT
