- 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 Feb 18, 2025@23:07:34 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
