DGBTCSL ;ALB/MRY- Local Vendor additions (COREFLS) ; 07/15/02@0900 AM
;;1.0;Beneficiary Travel;**2,3**;September 25, 2001
Q
;
CSLASK() ; ask CoreFLS query
; output: Y ( 1 := "YES", 0 := "NO", <1 := ABORT )
N DIR,Y
S DIR("A")="DO YOU WANT TO QUERY CoreFLS FOR A VENDOR"
S DIR(0)="Y",DIR("B")="NO"
D ^DIR Q:$D(DIRUT) -1
Q +Y
;
CSLIEN() ; make CoreFLS query call returning IEN
; output: Y ( <1 := invalid IEN, >0 := IEN )
N OUT,DGBTI,DGBTLINE,DGBTFLD,DIERR
ASK S OUT=""
D VENQ^CSLVQ(.OUT)
I OUT="",$O(OUT(""))="" Q -1 ; assuming ^abort response
I $D(OUT("ERROR")) K OUT G ASK
I $G(OUT("NAME"))=""!($G(OUT("NUMBER"))="")!($G(OUT("SITE_CODE"))="") G BAD
D FLDBLD
; verify KEY fields sent in OUT array
N FDA,FDAIEN F DGBTI="NUMBER","SITE_CODE" D
. S FDA(392.31,"+1,",DGBTFLD(DGBTI))=$G(OUT(DGBTI))
S Y=$$KEYVAL^DIE("","FDA","DIERR")
; only process new entries or edit duplicate entries
I 'Y,(DIERR("DIERR",1)'=740) G BAD
D CLEAN^DILF
NEW ; process new entries
I Y D G:$D(DIERR) BAD Q +FDAIEN(1)
. S DGBTI="" F S DGBTI=$O(DGBTFLD(DGBTI)) Q:DGBTI="" D
. . S FDA(392.31,"+1,",DGBTFLD(DGBTI))=$G(OUT(DGBTI))
. D UPDATE^DIE("EK","FDA","FDAIEN","DIERR")
EDIT ; edit existing entries
N VAL
;S VAL(1)=FDA(392.31,"+1,",.01)
S VAL(1)=FDA(392.31,"+1,",.03)
S VAL(2)=FDA(392.31,"+1,",.02)
S Y=$$FIND1^DIC(392.31,"","KQ",.VAL,"","","")
I Y<1 G BAD
K VAL S DGBTI="" F S DGBTI=$O(DGBTFLD(DGBTI)) Q:DGBTI="" D
. S VAL(392.31,+Y_",",DGBTFLD(DGBTI))=$G(OUT(DGBTI))
D FILE^DIE("","VAL","DIERR")
I $D(DIERR) G BAD
Q +Y
;
FLDBLD ; build helpful field array DGBTFLD(field name) = field number
F DGBTI=1:1 S DGBTLINE=$T(FLDS+DGBTI) Q:$P(DGBTLINE,";",3)="END" D
. S DGBTFLD($P(DGBTLINE,";",3))=$P(DGBTLINE,";",4)
Q
;
STAND ; Standalone Query call
N Y,X
S X="CSLVQ" X ^%ZOSF("TEST") I '$T D Q
. W !,"** COMMUNICATIONS SERVICE LIBRARY (CSL) PACKAGE NOT INSTALLED **"
W !!,"** CoreFLS national database query **"
ASKS S Y=$$CSLIEN W ! Q:Y<1
I +Y>0 W !,"** LOCAL VENDOR (#392.31) File updated. **"
G ASKS
;
FLDS ;
;;NAME;.01
;;NUMBER;.02
;;SITE_CODE;.03
;;TAXID;.04
;;AREA_CODE;.05
;;PHONE;.06
;;FAX_AREA_CODE;.07
;;FAX;.08
;;ADDRESS1;1.01
;;ADDRESS2;1.02
;;ADDRESS3;1.03
;;CITY;2.01
;;STATE;2.02
;;ZIP;2.03
;;SITE_CODE;.03
;;LAST_UPDATED;3.01
;;INACTIVE;3.02
;;END
;
BAD ; unsuccessful query
W !,"Unsuccessful Query!"
D CLEAN^DILF
Q -1
;
;-----------------------------------------------
;
PREV(Y) ; called from OUTPUT TRANSFORM
; input: Y := internal value
; output: Y ;= converted to external value
; DGBTV:= internal value
N DGBTV
I '$D(^DGBT(392.31,+Y,0)) Q -1
S DGBTV=Y,Y=$P(^DGBT(392.31,+Y,0),U)
Q +DGBTV
;
AFTER(FILE,IEN,DGBTX,DGBTV) ; called from template, or DR string
; input: IEN := Dzero variable
; DGBTX := entered response (X) from call
; DGBTV := previous value of entry
; output: -1 := no success with entry
; >0 := vendor updated
I DGBTX'=DGBTV Q 1 ; change was made, don't prompt for CoreFLS query
N DIR,Y,X,FDATA,DIERR
; if equal, null, or vendor wasn't in local vendor file, prompt for CoreFLS query
ASK2 S Y=$$CSLASK()
I DGBTX,(DGBTX=DGBTV),'Y Q 1
Q:Y<1 +Y
;
; make CoreFLS query call
W !,"** CoreFLS Query **"
S Y=$$CSLIEN() I +Y<1 G ASK2
Q:+Y<1 +Y
;
; Y = IEN of vendor, file vendor in Bene Travel field
;
I FILE=392 D
. S FDATA(392,IEN_",",14)=+Y
I FILE=680 D
. S FDATA(680,IEN_",",2.6)=+Y
I FILE="680.6" D
. S FDATA(680.6,IEN_",",.09)=+Y
I FILE=681 D
. S FDATA(681,IEN_",",3.01)=+Y
D FILE^DIE("","FDATA","DIERR")
I '$D(DIERR) W !,"** LOCAL VENDOR (#392.31) File updated. **" Q +Y
Q -1
;
ADD ; Standalone query
I '$P($G(^DG(43,1,"BT")),"^",4) D Q
. W !,"**COREFLS Vendor interface is not active."
D STAND
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGBTCSL 3916 printed Apr 09, 2024@20:45:33 Page 2
DGBTCSL ;ALB/MRY- Local Vendor additions (COREFLS) ; 07/15/02@0900 AM
+1 ;;1.0;Beneficiary Travel;**2,3**;September 25, 2001
+2 QUIT
+3 ;
CSLASK() ; ask CoreFLS query
+1 ; output: Y ( 1 := "YES", 0 := "NO", <1 := ABORT )
+2 NEW DIR,Y
+3 SET DIR("A")="DO YOU WANT TO QUERY CoreFLS FOR A VENDOR"
+4 SET DIR(0)="Y"
SET DIR("B")="NO"
+5 DO ^DIR
if $DATA(DIRUT)
QUIT -1
+6 QUIT +Y
+7 ;
CSLIEN() ; make CoreFLS query call returning IEN
+1 ; output: Y ( <1 := invalid IEN, >0 := IEN )
+2 NEW OUT,DGBTI,DGBTLINE,DGBTFLD,DIERR
ASK SET OUT=""
+1 DO VENQ^CSLVQ(.OUT)
+2 ; assuming ^abort response
IF OUT=""
IF $ORDER(OUT(""))=""
QUIT -1
+3 IF $DATA(OUT("ERROR"))
KILL OUT
GOTO ASK
+4 IF $GET(OUT("NAME"))=""!($GET(OUT("NUMBER"))="")!($GET(OUT("SITE_CODE"))="")
GOTO BAD
+5 DO FLDBLD
+6 ; verify KEY fields sent in OUT array
+7 NEW FDA,FDAIEN
FOR DGBTI="NUMBER","SITE_CODE"
Begin DoDot:1
+8 SET FDA(392.31,"+1,",DGBTFLD(DGBTI))=$GET(OUT(DGBTI))
End DoDot:1
+9 SET Y=$$KEYVAL^DIE("","FDA","DIERR")
+10 ; only process new entries or edit duplicate entries
+11 IF 'Y
IF (DIERR("DIERR",1)'=740)
GOTO BAD
+12 DO CLEAN^DILF
NEW ; process new entries
+1 IF Y
Begin DoDot:1
+2 SET DGBTI=""
FOR
SET DGBTI=$ORDER(DGBTFLD(DGBTI))
if DGBTI=""
QUIT
Begin DoDot:2
+3 SET FDA(392.31,"+1,",DGBTFLD(DGBTI))=$GET(OUT(DGBTI))
End DoDot:2
+4 DO UPDATE^DIE("EK","FDA","FDAIEN","DIERR")
End DoDot:1
if $DATA(DIERR)
GOTO BAD
QUIT +FDAIEN(1)
EDIT ; edit existing entries
+1 NEW VAL
+2 ;S VAL(1)=FDA(392.31,"+1,",.01)
+3 SET VAL(1)=FDA(392.31,"+1,",.03)
+4 SET VAL(2)=FDA(392.31,"+1,",.02)
+5 SET Y=$$FIND1^DIC(392.31,"","KQ",.VAL,"","","")
+6 IF Y<1
GOTO BAD
+7 KILL VAL
SET DGBTI=""
FOR
SET DGBTI=$ORDER(DGBTFLD(DGBTI))
if DGBTI=""
QUIT
Begin DoDot:1
+8 SET VAL(392.31,+Y_",",DGBTFLD(DGBTI))=$GET(OUT(DGBTI))
End DoDot:1
+9 DO FILE^DIE("","VAL","DIERR")
+10 IF $DATA(DIERR)
GOTO BAD
+11 QUIT +Y
+12 ;
FLDBLD ; build helpful field array DGBTFLD(field name) = field number
+1 FOR DGBTI=1:1
SET DGBTLINE=$TEXT(FLDS+DGBTI)
if $PIECE(DGBTLINE,";",3)="END"
QUIT
Begin DoDot:1
+2 SET DGBTFLD($PIECE(DGBTLINE,";",3))=$PIECE(DGBTLINE,";",4)
End DoDot:1
+3 QUIT
+4 ;
STAND ; Standalone Query call
+1 NEW Y,X
+2 SET X="CSLVQ"
XECUTE ^%ZOSF("TEST")
IF '$TEST
Begin DoDot:1
+3 WRITE !,"** COMMUNICATIONS SERVICE LIBRARY (CSL) PACKAGE NOT INSTALLED **"
End DoDot:1
QUIT
+4 WRITE !!,"** CoreFLS national database query **"
ASKS SET Y=$$CSLIEN
WRITE !
if Y<1
QUIT
+1 IF +Y>0
WRITE !,"** LOCAL VENDOR (#392.31) File updated. **"
+2 GOTO ASKS
+3 ;
FLDS ;
+1 ;;NAME;.01
+2 ;;NUMBER;.02
+3 ;;SITE_CODE;.03
+4 ;;TAXID;.04
+5 ;;AREA_CODE;.05
+6 ;;PHONE;.06
+7 ;;FAX_AREA_CODE;.07
+8 ;;FAX;.08
+9 ;;ADDRESS1;1.01
+10 ;;ADDRESS2;1.02
+11 ;;ADDRESS3;1.03
+12 ;;CITY;2.01
+13 ;;STATE;2.02
+14 ;;ZIP;2.03
+15 ;;SITE_CODE;.03
+16 ;;LAST_UPDATED;3.01
+17 ;;INACTIVE;3.02
+18 ;;END
+19 ;
BAD ; unsuccessful query
+1 WRITE !,"Unsuccessful Query!"
+2 DO CLEAN^DILF
+3 QUIT -1
+4 ;
+5 ;-----------------------------------------------
+6 ;
PREV(Y) ; called from OUTPUT TRANSFORM
+1 ; input: Y := internal value
+2 ; output: Y ;= converted to external value
+3 ; DGBTV:= internal value
+4 NEW DGBTV
+5 IF '$DATA(^DGBT(392.31,+Y,0))
QUIT -1
+6 SET DGBTV=Y
SET Y=$PIECE(^DGBT(392.31,+Y,0),U)
+7 QUIT +DGBTV
+8 ;
AFTER(FILE,IEN,DGBTX,DGBTV) ; called from template, or DR string
+1 ; input: IEN := Dzero variable
+2 ; DGBTX := entered response (X) from call
+3 ; DGBTV := previous value of entry
+4 ; output: -1 := no success with entry
+5 ; >0 := vendor updated
+6 ; change was made, don't prompt for CoreFLS query
IF DGBTX'=DGBTV
QUIT 1
+7 NEW DIR,Y,X,FDATA,DIERR
+8 ; if equal, null, or vendor wasn't in local vendor file, prompt for CoreFLS query
ASK2 SET Y=$$CSLASK()
+1 IF DGBTX
IF (DGBTX=DGBTV)
IF 'Y
QUIT 1
+2 if Y<1
QUIT +Y
+3 ;
+4 ; make CoreFLS query call
+5 WRITE !,"** CoreFLS Query **"
+6 SET Y=$$CSLIEN()
IF +Y<1
GOTO ASK2
+7 if +Y<1
QUIT +Y
+8 ;
+9 ; Y = IEN of vendor, file vendor in Bene Travel field
+10 ;
+11 IF FILE=392
Begin DoDot:1
+12 SET FDATA(392,IEN_",",14)=+Y
End DoDot:1
+13 IF FILE=680
Begin DoDot:1
+14 SET FDATA(680,IEN_",",2.6)=+Y
End DoDot:1
+15 IF FILE="680.6"
Begin DoDot:1
+16 SET FDATA(680.6,IEN_",",.09)=+Y
End DoDot:1
+17 IF FILE=681
Begin DoDot:1
+18 SET FDATA(681,IEN_",",3.01)=+Y
End DoDot:1
+19 DO FILE^DIE("","FDATA","DIERR")
+20 IF '$DATA(DIERR)
WRITE !,"** LOCAL VENDOR (#392.31) File updated. **"
QUIT +Y
+21 QUIT -1
+22 ;
ADD ; Standalone query
+1 IF '$PIECE($GET(^DG(43,1,"BT")),"^",4)
Begin DoDot:1
+2 WRITE !,"**COREFLS Vendor interface is not active."
End DoDot:1
QUIT
+3 DO STAND
+4 QUIT
