source: FOIAVistA/trunk/r/BENEFICIARY_TRAVEL-DGBT/DGBTCSL.m@ 1549

Last change on this file since 1549 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.7 KB
Line 
1DGBTCSL ;ALB/MRY- Local Vendor additions (COREFLS) ; 07/15/02@0900 AM
2 ;;1.0;Beneficiary Travel;**2,3**;September 25, 2001
3 Q
4 ;
5CSLASK() ; ask CoreFLS query
6 ; output: Y ( 1 := "YES", 0 := "NO", <1 := ABORT )
7 N DIR,Y
8 S DIR("A")="DO YOU WANT TO QUERY CoreFLS FOR A VENDOR"
9 S DIR(0)="Y",DIR("B")="NO"
10 D ^DIR Q:$D(DIRUT) -1
11 Q +Y
12 ;
13CSLIEN() ; make CoreFLS query call returning IEN
14 ; output: Y ( <1 := invalid IEN, >0 := IEN )
15 N OUT,DGBTI,DGBTLINE,DGBTFLD,DIERR
16ASK S OUT=""
17 D VENQ^CSLVQ(.OUT)
18 I OUT="",$O(OUT(""))="" Q -1 ; assuming ^abort response
19 I $D(OUT("ERROR")) K OUT G ASK
20 I $G(OUT("NAME"))=""!($G(OUT("NUMBER"))="")!($G(OUT("SITE_CODE"))="") G BAD
21 D FLDBLD
22 ; verify KEY fields sent in OUT array
23 N FDA,FDAIEN F DGBTI="NUMBER","SITE_CODE" D
24 . S FDA(392.31,"+1,",DGBTFLD(DGBTI))=$G(OUT(DGBTI))
25 S Y=$$KEYVAL^DIE("","FDA","DIERR")
26 ; only process new entries or edit duplicate entries
27 I 'Y,(DIERR("DIERR",1)'=740) G BAD
28 D CLEAN^DILF
29NEW ; process new entries
30 I Y D G:$D(DIERR) BAD Q +FDAIEN(1)
31 . S DGBTI="" F S DGBTI=$O(DGBTFLD(DGBTI)) Q:DGBTI="" D
32 . . S FDA(392.31,"+1,",DGBTFLD(DGBTI))=$G(OUT(DGBTI))
33 . D UPDATE^DIE("EK","FDA","FDAIEN","DIERR")
34EDIT ; edit existing entries
35 N VAL
36 ;S VAL(1)=FDA(392.31,"+1,",.01)
37 S VAL(1)=FDA(392.31,"+1,",.03)
38 S VAL(2)=FDA(392.31,"+1,",.02)
39 S Y=$$FIND1^DIC(392.31,"","KQ",.VAL,"","","")
40 I Y<1 G BAD
41 K VAL S DGBTI="" F S DGBTI=$O(DGBTFLD(DGBTI)) Q:DGBTI="" D
42 . S VAL(392.31,+Y_",",DGBTFLD(DGBTI))=$G(OUT(DGBTI))
43 D FILE^DIE("","VAL","DIERR")
44 I $D(DIERR) G BAD
45 Q +Y
46 ;
47FLDBLD ; build helpful field array DGBTFLD(field name) = field number
48 F DGBTI=1:1 S DGBTLINE=$T(FLDS+DGBTI) Q:$P(DGBTLINE,";",3)="END" D
49 . S DGBTFLD($P(DGBTLINE,";",3))=$P(DGBTLINE,";",4)
50 Q
51 ;
52STAND ; Standalone Query call
53 N Y,X
54 S X="CSLVQ" X ^%ZOSF("TEST") I '$T D Q
55 . W !,"** COMMUNICATIONS SERVICE LIBRARY (CSL) PACKAGE NOT INSTALLED **"
56 W !!,"** CoreFLS national database query **"
57ASKS S Y=$$CSLIEN W ! Q:Y<1
58 I +Y>0 W !,"** LOCAL VENDOR (#392.31) File updated. **"
59 G ASKS
60 ;
61FLDS ;
62 ;;NAME;.01
63 ;;NUMBER;.02
64 ;;SITE_CODE;.03
65 ;;TAXID;.04
66 ;;AREA_CODE;.05
67 ;;PHONE;.06
68 ;;FAX_AREA_CODE;.07
69 ;;FAX;.08
70 ;;ADDRESS1;1.01
71 ;;ADDRESS2;1.02
72 ;;ADDRESS3;1.03
73 ;;CITY;2.01
74 ;;STATE;2.02
75 ;;ZIP;2.03
76 ;;SITE_CODE;.03
77 ;;LAST_UPDATED;3.01
78 ;;INACTIVE;3.02
79 ;;END
80 ;
81BAD ; unsuccessful query
82 W !,"Unsuccessful Query!"
83 D CLEAN^DILF
84 Q -1
85 ;
86 ;-----------------------------------------------
87 ;
88PREV(Y) ; called from OUTPUT TRANSFORM
89 ; input: Y := internal value
90 ; output: Y ;= converted to external value
91 ; DGBTV:= internal value
92 N DGBTV
93 I '$D(^DGBT(392.31,+Y,0)) Q -1
94 S DGBTV=Y,Y=$P(^DGBT(392.31,+Y,0),U)
95 Q +DGBTV
96 ;
97AFTER(FILE,IEN,DGBTX,DGBTV) ; called from template, or DR string
98 ; input: IEN := Dzero variable
99 ; DGBTX := entered response (X) from call
100 ; DGBTV := previous value of entry
101 ; output: -1 := no success with entry
102 ; >0 := vendor updated
103 I DGBTX'=DGBTV Q 1 ; change was made, don't prompt for CoreFLS query
104 N DIR,Y,X,FDATA,DIERR
105 ; if equal, null, or vendor wasn't in local vendor file, prompt for CoreFLS query
106ASK2 S Y=$$CSLASK()
107 I DGBTX,(DGBTX=DGBTV),'Y Q 1
108 Q:Y<1 +Y
109 ;
110 ; make CoreFLS query call
111 W !,"** CoreFLS Query **"
112 S Y=$$CSLIEN() I +Y<1 G ASK2
113 Q:+Y<1 +Y
114 ;
115 ; Y = IEN of vendor, file vendor in Bene Travel field
116 ;
117 I FILE=392 D
118 . S FDATA(392,IEN_",",14)=+Y
119 I FILE=680 D
120 . S FDATA(680,IEN_",",2.6)=+Y
121 I FILE="680.6" D
122 . S FDATA(680.6,IEN_",",.09)=+Y
123 I FILE=681 D
124 . S FDATA(681,IEN_",",3.01)=+Y
125 D FILE^DIE("","FDATA","DIERR")
126 I '$D(DIERR) W !,"** LOCAL VENDOR (#392.31) File updated. **" Q +Y
127 Q -1
128 ;
129ADD ; Standalone query
130 I '$P($G(^DG(43,1,"BT")),"^",4) D Q
131 . W !,"**COREFLS Vendor interface is not active."
132 D STAND
133 Q
Note: See TracBrowser for help on using the repository browser.