source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNRFM1.m@ 1201

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

initial load of WorldVistAEHR
File size: 3.9 KB
RevLine 
[613]1IBCNRFM1 ;DAOU/DMK - Perform FileMan API Calls ;05-NOV-2003
2 ;;2.0;INTEGRATED BILLING;**251**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; Description
6 ;
7 ; Perform FileMan Add, Delete, File, and Lookup API calls
8 ;
9 Q
10 ;
11ADD1(FILENO,X) ; Add file entry via FILE^DICN
12 ; FILENO = file #
13 ; X = file .01 field internal value
14 ;
15 K DO
16 N DA,DIC,DIE,DINUM,DLAYGO,DTOUT,DUOUT,Y
17 S DIC=$$ROOT^DILFD(FILENO),DIC(0)="L"
18 S DLAYGO=FILENO
19 D FILE^DICN
20 Q +Y
21 ;
22ADD2(FILENO,IEN1,FIELDNO,X) ; Add subfile entry via FILE^DICN
23 ; FILENO = file #
24 ; IEN1 = file level internal entry number
25 ; FIELDNO = subfile field #
26 ; X = subfile .01 field internal value
27 ;
28 ; FILENO_FIELDNO must = subfile #
29 ; ","_IEN1_"," = IENS = internal entry number string
30 ;
31 K DO
32 N DA,DIC,DIE,DINUM,DLAYGO,DTOUT,DUOUT,Y
33 S DA(1)=IEN1
34 S DIC=$$ROOT^DILFD(FILENO_FIELDNO,","_IEN1_",")
35 S DIC(0)="L",DIC("P")=$P(^DD(FILENO,FIELDNO,0),"^",2)
36 S DLAYGO=FILENO
37 D FILE^DICN
38 Q +Y
39 ;
40DELETE1(FILENO,IEN) ; Delete file entry via DIK
41 ; FILENO = file #
42 ; IEN = file level internal entry number
43 ;
44 N %,DA,DIC,DIK,X,Y
45 S DA=IEN
46 S DIK=$$ROOT^DILFD(FILENO)
47 D ^DIK
48 Q
49 ;
50DELETE2(FILENO,IEN1,FIELDNO,IEN) ; Delete subfile entry via DIK
51 ; FILENO = file #
52 ; IEN1 = file level internal entry number
53 ; FIELDNO = subfile field #
54 ; IEN = subfile level internal entry number
55 ;
56 ; FILENO_FIELDNO must = subfile #
57 ; ","_IEN_"," = IENS = internal entry number string
58 ;
59 N %,DA,DIC,DIK,X,Y
60 S DA(1)=IEN1,DA=IEN
61 S DIK=$$ROOT^DILFD(FILENO_FIELDNO,","_IEN1_",")
62 D ^DIK
63 Q
64 ;
65FILE1(FILENO,IEN,DATA) ; File data via DIE
66 ; FILENO = file #
67 ; IEN = file level internal entry number
68 ; DATA = array reflecting field numbers and values
69 ; (DATA(FIELDNO)=VALUE)
70 ;
71 N DA,DIC,DIDEL,DIE,DLAYGO,DR,DTOUT,X,Y
72 N FIELDNO,I
73 S DA=IEN
74 S DIE=$$ROOT^DILFD(FILENO)
75 S FIELDNO=$O(DATA(""))
76 S DR=FIELDNO_"////^S X=DATA("_FIELDNO_")"
77 F I=1:1 S FIELDNO=$O(DATA(FIELDNO)) Q:FIELDNO="" D
78 . S DR(1,FILENO,I)=FIELDNO_"////^S X=DATA("_FIELDNO_")"
79 D ^DIE
80 Q
81 ;
82FILE2(FILENO,IEN1,FIELDNO1,IEN,DATA) ; File subfile data via DIE
83 ; FILENO = file #
84 ; IEN1 = file level internal entry number
85 ; FIELDNO1 = file field #
86 ; IEN = subfile level internal entry number
87 ; DATA = array reflecting subfile field numbers and
88 ; values (DATA(FIELDNO)=VALUE)
89 ;
90 ; FILENO_FIELDNO must = subfile #
91 ; ","_IEN_"," = IENS = internal entry number string
92 ;
93 N DA,DIDEL,DIC,DIE,DLAYGO,DR,DTOUT,X,Y
94 N FIELDNO,I
95 S DA=IEN,DA(1)=IEN1
96 ;S DIE=$$ROOT^DILFD(FILENO)_IEN1_","_FIELDNO1_","
97 S DIE=$$ROOT^DILFD(FILENO_FIELDNO1,","_IEN1_",")
98 S FIELDNO=$O(DATA(""))
99 S DR=FIELDNO_"////^S X=DATA("_FIELDNO_")"
100 F I=1:1 S FIELDNO=$O(DATA(FIELDNO)) Q:FIELDNO="" D
101 . S DR(1,FILENO_FIELDNO1,I)=FIELDNO_"////^S X=DATA("_FIELDNO_")"
102 D ^DIE
103 Q
104 ;
105LOOKUP1(FILENO,X) ; Lookup file entry via DIC
106 ; FILENO = file #
107 ; X = lookup value
108 ;
109 N DA,DIC,DIE,DINUM,DLAYGO,DTOUT,DUOUT,Y
110 S DIC=$$ROOT^DILFD(FILENO),DIC(0)="X"
111 D ^DIC
112 Q +Y
113 ;
114LOOKUP2(FILENO,IEN1,FIELDNO,X) ; Lookup subfile entry via DIC
115 ; FILENO = file #
116 ; IEN1 = file level internal entry number
117 ; FIELDNO = subfile field #
118 ; X = lookup value
119 ;
120 ; FILENO_FIELDNO must = subfile #
121 ; ","_IEN1_"," = IENS = internal entry number string
122 ;
123 N DA,DIC,DIE,DINUM,DLAYGO,DTOUT,DUOUT,Y
124 I IEN1'=-1 D
125 . S DIC=$$ROOT^DILFD(FILENO_FIELDNO,","_IEN1_","),DIC(0)="X"
126 . D ^DIC
127 I IEN1=-1 S Y=-1
128 Q +Y
129 ;
130LOOKUP3(FILENO,D,X) ; Lookup file entry via IX^DIC
131 ; FILENO = file #
132 ; D = cross-reference to use
133 ; X = lookup value
134 ;
135 N DA,DIC,DIE,DINUM,DLAYGO,DTOUT,DUOUT,Y
136 S DIC=$$ROOT^DILFD(FILENO),DIC(0)="X"
137 D IX^DIC
138 Q +Y
139 ;
140SELECT1(FILENO,PROMPT) ; Select file entry via DIC
141 ; FILENO = file #
142 ; PROMPT = prompt (optional)
143 ;
144 N DIC,DTOUT,DUOUT,X,Y
145 S DIC=$$ROOT^DILFD(FILENO)
146 S DIC(0)="ABEMQ"
147 I $G(PROMPT)]"" S DIC("A")=PROMPT
148 D ^DIC
149 I $D(DTOUT)!$D(DUOUT) S Y=-1
150 Q +Y
Note: See TracBrowser for help on using the repository browser.