151 lines
3.9 KiB
Mathematica
151 lines
3.9 KiB
Mathematica
IBCNRFM1 ;DAOU/DMK - Perform FileMan API Calls ;05-NOV-2003
|
|
;;2.0;INTEGRATED BILLING;**251**;21-MAR-94
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;
|
|
; Description
|
|
;
|
|
; Perform FileMan Add, Delete, File, and Lookup API calls
|
|
;
|
|
Q
|
|
;
|
|
ADD1(FILENO,X) ; Add file entry via FILE^DICN
|
|
; FILENO = file #
|
|
; X = file .01 field internal value
|
|
;
|
|
K DO
|
|
N DA,DIC,DIE,DINUM,DLAYGO,DTOUT,DUOUT,Y
|
|
S DIC=$$ROOT^DILFD(FILENO),DIC(0)="L"
|
|
S DLAYGO=FILENO
|
|
D FILE^DICN
|
|
Q +Y
|
|
;
|
|
ADD2(FILENO,IEN1,FIELDNO,X) ; Add subfile entry via FILE^DICN
|
|
; FILENO = file #
|
|
; IEN1 = file level internal entry number
|
|
; FIELDNO = subfile field #
|
|
; X = subfile .01 field internal value
|
|
;
|
|
; FILENO_FIELDNO must = subfile #
|
|
; ","_IEN1_"," = IENS = internal entry number string
|
|
;
|
|
K DO
|
|
N DA,DIC,DIE,DINUM,DLAYGO,DTOUT,DUOUT,Y
|
|
S DA(1)=IEN1
|
|
S DIC=$$ROOT^DILFD(FILENO_FIELDNO,","_IEN1_",")
|
|
S DIC(0)="L",DIC("P")=$P(^DD(FILENO,FIELDNO,0),"^",2)
|
|
S DLAYGO=FILENO
|
|
D FILE^DICN
|
|
Q +Y
|
|
;
|
|
DELETE1(FILENO,IEN) ; Delete file entry via DIK
|
|
; FILENO = file #
|
|
; IEN = file level internal entry number
|
|
;
|
|
N %,DA,DIC,DIK,X,Y
|
|
S DA=IEN
|
|
S DIK=$$ROOT^DILFD(FILENO)
|
|
D ^DIK
|
|
Q
|
|
;
|
|
DELETE2(FILENO,IEN1,FIELDNO,IEN) ; Delete subfile entry via DIK
|
|
; FILENO = file #
|
|
; IEN1 = file level internal entry number
|
|
; FIELDNO = subfile field #
|
|
; IEN = subfile level internal entry number
|
|
;
|
|
; FILENO_FIELDNO must = subfile #
|
|
; ","_IEN_"," = IENS = internal entry number string
|
|
;
|
|
N %,DA,DIC,DIK,X,Y
|
|
S DA(1)=IEN1,DA=IEN
|
|
S DIK=$$ROOT^DILFD(FILENO_FIELDNO,","_IEN1_",")
|
|
D ^DIK
|
|
Q
|
|
;
|
|
FILE1(FILENO,IEN,DATA) ; File data via DIE
|
|
; FILENO = file #
|
|
; IEN = file level internal entry number
|
|
; DATA = array reflecting field numbers and values
|
|
; (DATA(FIELDNO)=VALUE)
|
|
;
|
|
N DA,DIC,DIDEL,DIE,DLAYGO,DR,DTOUT,X,Y
|
|
N FIELDNO,I
|
|
S DA=IEN
|
|
S DIE=$$ROOT^DILFD(FILENO)
|
|
S FIELDNO=$O(DATA(""))
|
|
S DR=FIELDNO_"////^S X=DATA("_FIELDNO_")"
|
|
F I=1:1 S FIELDNO=$O(DATA(FIELDNO)) Q:FIELDNO="" D
|
|
. S DR(1,FILENO,I)=FIELDNO_"////^S X=DATA("_FIELDNO_")"
|
|
D ^DIE
|
|
Q
|
|
;
|
|
FILE2(FILENO,IEN1,FIELDNO1,IEN,DATA) ; File subfile data via DIE
|
|
; FILENO = file #
|
|
; IEN1 = file level internal entry number
|
|
; FIELDNO1 = file field #
|
|
; IEN = subfile level internal entry number
|
|
; DATA = array reflecting subfile field numbers and
|
|
; values (DATA(FIELDNO)=VALUE)
|
|
;
|
|
; FILENO_FIELDNO must = subfile #
|
|
; ","_IEN_"," = IENS = internal entry number string
|
|
;
|
|
N DA,DIDEL,DIC,DIE,DLAYGO,DR,DTOUT,X,Y
|
|
N FIELDNO,I
|
|
S DA=IEN,DA(1)=IEN1
|
|
;S DIE=$$ROOT^DILFD(FILENO)_IEN1_","_FIELDNO1_","
|
|
S DIE=$$ROOT^DILFD(FILENO_FIELDNO1,","_IEN1_",")
|
|
S FIELDNO=$O(DATA(""))
|
|
S DR=FIELDNO_"////^S X=DATA("_FIELDNO_")"
|
|
F I=1:1 S FIELDNO=$O(DATA(FIELDNO)) Q:FIELDNO="" D
|
|
. S DR(1,FILENO_FIELDNO1,I)=FIELDNO_"////^S X=DATA("_FIELDNO_")"
|
|
D ^DIE
|
|
Q
|
|
;
|
|
LOOKUP1(FILENO,X) ; Lookup file entry via DIC
|
|
; FILENO = file #
|
|
; X = lookup value
|
|
;
|
|
N DA,DIC,DIE,DINUM,DLAYGO,DTOUT,DUOUT,Y
|
|
S DIC=$$ROOT^DILFD(FILENO),DIC(0)="X"
|
|
D ^DIC
|
|
Q +Y
|
|
;
|
|
LOOKUP2(FILENO,IEN1,FIELDNO,X) ; Lookup subfile entry via DIC
|
|
; FILENO = file #
|
|
; IEN1 = file level internal entry number
|
|
; FIELDNO = subfile field #
|
|
; X = lookup value
|
|
;
|
|
; FILENO_FIELDNO must = subfile #
|
|
; ","_IEN1_"," = IENS = internal entry number string
|
|
;
|
|
N DA,DIC,DIE,DINUM,DLAYGO,DTOUT,DUOUT,Y
|
|
I IEN1'=-1 D
|
|
. S DIC=$$ROOT^DILFD(FILENO_FIELDNO,","_IEN1_","),DIC(0)="X"
|
|
. D ^DIC
|
|
I IEN1=-1 S Y=-1
|
|
Q +Y
|
|
;
|
|
LOOKUP3(FILENO,D,X) ; Lookup file entry via IX^DIC
|
|
; FILENO = file #
|
|
; D = cross-reference to use
|
|
; X = lookup value
|
|
;
|
|
N DA,DIC,DIE,DINUM,DLAYGO,DTOUT,DUOUT,Y
|
|
S DIC=$$ROOT^DILFD(FILENO),DIC(0)="X"
|
|
D IX^DIC
|
|
Q +Y
|
|
;
|
|
SELECT1(FILENO,PROMPT) ; Select file entry via DIC
|
|
; FILENO = file #
|
|
; PROMPT = prompt (optional)
|
|
;
|
|
N DIC,DTOUT,DUOUT,X,Y
|
|
S DIC=$$ROOT^DILFD(FILENO)
|
|
S DIC(0)="ABEMQ"
|
|
I $G(PROMPT)]"" S DIC("A")=PROMPT
|
|
D ^DIC
|
|
I $D(DTOUT)!$D(DUOUT) S Y=-1
|
|
Q +Y
|