[613] | 1 | DGBTVUP ;ALB/MRY-UPDATE LOCAL VENDOR FILE W/ COREFLS VENDORS ;7/15/2003
|
---|
| 2 | ;;1.0;Beneficiary Travel;**2,3**;September 25, 2001
|
---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
| 4 | ;
|
---|
| 5 | ; the subroutines in this program are part of the Update Vendor
|
---|
| 6 | ; File event. It builds a global array of the vendor ids for
|
---|
| 7 | ; the CoreFLS local vendor file update with CoreFLS Vendor records.
|
---|
| 8 | ; The vendor IDs are passed to CoreFLS via DGBT software so
|
---|
| 9 | ; retrieval of CoreFLS Vendor records can be done. The retrieved
|
---|
| 10 | ; records are sent back to VistA for update to the local vendor
|
---|
| 11 | ; file (#392.31).
|
---|
| 12 | ;
|
---|
| 13 | EN ; entry point for Update Vendor REcords option
|
---|
| 14 | ; build temporary global containing CoreFLS vendor ids
|
---|
| 15 | N X S X="CSLVQ" X ^%ZOSF("TEST") I '$T W !!," ** COREFLS Package CSL V1.0 not installed. **" Q
|
---|
| 16 | 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
|
---|
| 17 | W !?5,"Update of the CoreFLS Local Vendor file (#392.31) will begin."
|
---|
| 18 | N DGBTDA,DGBTNUM,DGBTSITE,DGBTDATE
|
---|
| 19 | S DGBTDA=0 F S DGBTDA=$O(^DGBT(392.31,DGBTDA)) Q:'DGBTDA D
|
---|
| 20 | . S DGBTNUM=$$GET1^DIQ(392.31,DGBTDA_",",.02,"I") ; site number
|
---|
| 21 | . S DGBTSITE=$$GET1^DIQ(392.31,DGBTDA_",",.03,"I") ; site
|
---|
| 22 | . S DGBTDATE=$$GET1^DIQ(392.31,DGBTDA_",",3.01,"I") ; date of last update
|
---|
| 23 | . I DGBTNUM="",DGBTSITE="" Q
|
---|
| 24 | . S ^TMP("DGBTVUP",$J,DGBTDA)=DGBTNUM_"^"_DGBTSITE_"^"_DGBTDATE
|
---|
| 25 | ; DGBT API is called to pass list of vendor ids for processing
|
---|
| 26 | ; The vendor update operates asynchronously using a callback model
|
---|
| 27 | ; input - 1st argument is Name of an array (local or global)
|
---|
| 28 | ; containing ID, Site ID and Date of Last Update for each
|
---|
| 29 | ; vendor to be updated
|
---|
| 30 | ; 2nd argument is the entry point for the DGBT software to
|
---|
| 31 | ; call once CoreFLS returns the vendor records. This
|
---|
| 32 | ; entry point belongs to the API that will perform the
|
---|
| 33 | ; COREFLS LOCAL VENDOR file (392.31) update.
|
---|
| 34 | D UPDATE^CSLVQ($NA(^TMP("DGBTVUP",$J)),"UPD^DGBTVUP")
|
---|
| 35 | Q
|
---|
| 36 | ;
|
---|
| 37 | UPD(DGBTARRY) ;
|
---|
| 38 | ; DGBTARRY is an input and is the name of the global or local arry
|
---|
| 39 | ; containing the vendor record(s) retrieved from the CoreFLS
|
---|
| 40 | ; vendor tables via a request from DGBT software
|
---|
| 41 | ;
|
---|
| 42 | N DGBTFDA,DGBTVDA,DGBTIDX
|
---|
| 43 | S (DGBTIDX,DGBTVDA,DGBTCNT)=0
|
---|
| 44 | F S DGBTIDX=$O(@DGBTARRY@(DGBTIDX)) Q:'DGBTIDX D
|
---|
| 45 | . S DGBTVDA=$O(^DGBT(392.31,"BB",@DGBTARRY@(DGBTIDX,"SITE_CODE"),@DGBTARRY@(DGBTIDX,"NUMBER"),""))
|
---|
| 46 | . 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
|
---|
| 47 | . D FILE
|
---|
| 48 | D GETERRM,SMSG
|
---|
| 49 | Q
|
---|
| 50 | ;
|
---|
| 51 | FILE ; file into existing entry
|
---|
| 52 | L +^DGBT(392.31,DGBTVDA):30
|
---|
| 53 | 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
|
---|
| 54 | I $D(@DGBTARRY@(DGBTIDX,"NAME")) D
|
---|
| 55 | . S DGBTFDA(1,392.31,DGBTVDA_",",.01)=@DGBTARRY@(DGBTIDX,"NAME")
|
---|
| 56 | I $D(@DGBTARRY@(DGBTIDX,"NUMBER")) D
|
---|
| 57 | . S DGBTFDA(1,392.31,DGBTVDA_",",.02)=@DGBTARRY@(DGBTIDX,"NUMBER")
|
---|
| 58 | I $D(@DGBTARRY@(DGBTIDX,"TAXID")) D
|
---|
| 59 | . S DGBTFDA(1,392.31,DGBTVDA_",",.04)=@DGBTARRY@(DGBTIDX,"TAXID")
|
---|
| 60 | I $D(@DGBTARRY@(DGBTIDX,"AREA_CODE")) D
|
---|
| 61 | . S DGBTFDA(1,392.31,DGBTVDA_",",.05)=@DGBTARRY@(DGBTIDX,"AREA_CODE")
|
---|
| 62 | I $D(@DGBTARRY@(DGBTIDX,"PHONE")) D
|
---|
| 63 | . S DGBTFDA(1,392.31,DGBTVDA_",",.06)=@DGBTARRY@(DGBTIDX,"PHONE")
|
---|
| 64 | I $D(@DGBTARRY@(DGBTIDX,"FAX_AREA_CODE")) D
|
---|
| 65 | . S DGBTFDA(1,392.31,DGBTVDA_",",.07)=@DGBTARRY@(DGBTIDX,"FAX_AREA_CODE")
|
---|
| 66 | I $D(@DGBTARRY@(DGBTIDX,"FAX")) D
|
---|
| 67 | . S DGBTFDA(1,392.31,DGBTVDA_",",.08)=@DGBTARRY@(DGBTIDX,"FAX")
|
---|
| 68 | I $D(@DGBTARRY@(DGBTIDX,"ADDRESS1")) D
|
---|
| 69 | . S DGBTFDA(1,392.31,DGBTVDA_",",1.01)=@DGBTARRY@(DGBTIDX,"ADDRESS1")
|
---|
| 70 | I $D(@DGBTARRY@(DGBTIDX,"ADDRESS2")) D
|
---|
| 71 | . S DGBTFDA(1,392.31,DGBTVDA_",",1.02)=@DGBTARRY@(DGBTIDX,"ADDRESS2")
|
---|
| 72 | I $D(@DGBTARRY@(DGBTIDX,"ADDRESS3")) D
|
---|
| 73 | . S DGBTFDA(1,392.31,DGBTVDA_",",1.03)=@DGBTARRY@(DGBTIDX,"ADDRESS3")
|
---|
| 74 | I $D(@DGBTARRY@(DGBTIDX,"CITY")) D
|
---|
| 75 | . S DGBTFDA(1,392.31,DGBTVDA_",",2.01)=@DGBTARRY@(DGBTIDX,"CITY")
|
---|
| 76 | I $D(@DGBTARRY@(DGBTIDX,"STATE")) D
|
---|
| 77 | . S DGBTFDA(1,392.31,DGBTVDA_",",2.02)=@DGBTARRY@(DGBTIDX,"STATE")
|
---|
| 78 | I $D(@DGBTARRY@(DGBTIDX,"ZIP")) D
|
---|
| 79 | . S DGBTFDA(1,392.31,DGBTVDA_",",2.03)=@DGBTARRY@(DGBTIDX,"ZIP")
|
---|
| 80 | I $D(@DGBTARRY@(DGBTIDX,"SITE_CODE")) D
|
---|
| 81 | . S DGBTFDA(1,392.31,DGBTVDA_",",.03)=@DGBTARRY@(DGBTIDX,"SITE_CODE")
|
---|
| 82 | I $D(@DGBTARRY@(DGBTIDX,"LAST_UPDATED")) D
|
---|
| 83 | . S DGBTFDA(1,392.31,DGBTVDA_",",3.01)=@DGBTARRY@(DGBTIDX,"LAST_UPDATED")
|
---|
| 84 | I $D(@DGBTARRY@(DGBTIDX,"INACTIVE_DATE")) D
|
---|
| 85 | . S DGBTFDA(1,392.31,DGBTVDA_",",3.02)=@DGBTARRY@(DGBTIDX,"INACTIVE_DATE")
|
---|
| 86 | D FILE^DIE("","DGBTFDA(1)","")
|
---|
| 87 | L -^DGBT(392.31,DGBTVDA)
|
---|
| 88 | Q
|
---|
| 89 | ;
|
---|
| 90 | GETERRM ; pull any exceptions from FM output array and assign to ^TMP
|
---|
| 91 | Q:'$D(DIERR) ; quit if no output array
|
---|
| 92 | N DGBTERRC,DGBTERRT,DGBTERRN,DGBTERRP,DGBTCNT,MSGARRY,DGBTERRM
|
---|
| 93 | S (DGBTERRC,DGBTERRN)=0,DGBTCNT=1
|
---|
| 94 | F S DGBTERRC=$O(^TMP("DIERR",$J,"E",DGBTERRC)) Q:'DGBTERRC F S DGBTERRN=$O(^TMP("DIERR",$J,"E",DGBTERRC,DGBTERRN)) Q:'DGBTERRN D
|
---|
| 95 | . S DGBTERRP=0 F S DGBTERRP=$O(^TMP("DIERR",$J,DGBTERRN,"PARAM",DGBTERRP)) Q:DGBTERRP="" S MSGARRY("PARAM"_DGBTERRP)=DGBTERRP_" "_^(DGBTERRP)
|
---|
| 96 | . S DGBTERRT=0 F S DGBTERRT=$O(^TMP("DIERR",$J,DGBTERRN,"TEXT",DGBTERRT)) Q:'DGBTERRT S MSGARRY("TEXT"_DGBTERRT)=^(DGBTERRT)
|
---|
| 97 | . S DGBTERRM="" F S DGBTERRM=$O(MSGARRY(DGBTERRM)) Q:DGBTERRM="" S DGBTCNT=DGBTCNT+1,^TMP("DGBTUPDERR",$J,DGBTCNT)=MSGARRY(DGBTERRM)
|
---|
| 98 | ; clean FM error message output array
|
---|
| 99 | D CLEAN^DILF
|
---|
| 100 | Q
|
---|
| 101 | ;
|
---|
| 102 | SMSG ; necessary assignment of variables for MAILMAN processing
|
---|
| 103 | N XMDUZ,XMSUB,XMTEXT,XMY,DGBTSITE
|
---|
| 104 | S DGBTSITE=$P($$SITE^VASITE,"^",2)
|
---|
| 105 | S X=$T(+0) X ^%ZOSF("RSUM") S ^TMP("DGBTUPDERR",$J,1)="CoreFLS Local Vendor file update run at "_DGBTSITE_" = "_Y
|
---|
| 106 | S XMY("YORTY.M@MNTVBB.FO-ALBANY.MED.VA.GOV")=""
|
---|
| 107 | S %DT="T",X="NOW" D ^%DT,DD^LRX S DGBTNOW=Y
|
---|
| 108 | S XMSUB="CoreFLS Local Vendor file update at "_DGBTSITE_" at "_DGBTNOW,XMDUZ="UPDATE VENDOR RECORDS post-update message"
|
---|
| 109 | S XMTEXT="^TMP(""DGBTUPDERR"",$J,"
|
---|
| 110 | D ^XMD
|
---|
| 111 | K ^TMP("DGBTUPDERR",$J)
|
---|
| 112 | Q
|
---|