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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNRFM1 4148 printed Apr 09, 2024@21:17:13 Page 2
IBCNRFM1 ;DAOU/DMK - Perform FileMan API Calls ;05-NOV-2003
+1 ;;2.0;INTEGRATED BILLING;**251**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ; Description
+5 ;
+6 ; Perform FileMan Add, Delete, File, and Lookup API calls
+7 ;
+8 QUIT
+9 ;
ADD1(FILENO,X) ; Add file entry via FILE^DICN
+1 ; FILENO = file #
+2 ; X = file .01 field internal value
+3 ;
+4 KILL DO
+5 NEW DA,DIC,DIE,DINUM,DLAYGO,DTOUT,DUOUT,Y
+6 SET DIC=$$ROOT^DILFD(FILENO)
SET DIC(0)="L"
+7 SET DLAYGO=FILENO
+8 DO FILE^DICN
+9 QUIT +Y
+10 ;
ADD2(FILENO,IEN1,FIELDNO,X) ; Add subfile entry via FILE^DICN
+1 ; FILENO = file #
+2 ; IEN1 = file level internal entry number
+3 ; FIELDNO = subfile field #
+4 ; X = subfile .01 field internal value
+5 ;
+6 ; FILENO_FIELDNO must = subfile #
+7 ; ","_IEN1_"," = IENS = internal entry number string
+8 ;
+9 KILL DO
+10 NEW DA,DIC,DIE,DINUM,DLAYGO,DTOUT,DUOUT,Y
+11 SET DA(1)=IEN1
+12 SET DIC=$$ROOT^DILFD(FILENO_FIELDNO,","_IEN1_",")
+13 SET DIC(0)="L"
SET DIC("P")=$PIECE(^DD(FILENO,FIELDNO,0),"^",2)
+14 SET DLAYGO=FILENO
+15 DO FILE^DICN
+16 QUIT +Y
+17 ;
DELETE1(FILENO,IEN) ; Delete file entry via DIK
+1 ; FILENO = file #
+2 ; IEN = file level internal entry number
+3 ;
+4 NEW %,DA,DIC,DIK,X,Y
+5 SET DA=IEN
+6 SET DIK=$$ROOT^DILFD(FILENO)
+7 DO ^DIK
+8 QUIT
+9 ;
DELETE2(FILENO,IEN1,FIELDNO,IEN) ; Delete subfile entry via DIK
+1 ; FILENO = file #
+2 ; IEN1 = file level internal entry number
+3 ; FIELDNO = subfile field #
+4 ; IEN = subfile level internal entry number
+5 ;
+6 ; FILENO_FIELDNO must = subfile #
+7 ; ","_IEN_"," = IENS = internal entry number string
+8 ;
+9 NEW %,DA,DIC,DIK,X,Y
+10 SET DA(1)=IEN1
SET DA=IEN
+11 SET DIK=$$ROOT^DILFD(FILENO_FIELDNO,","_IEN1_",")
+12 DO ^DIK
+13 QUIT
+14 ;
FILE1(FILENO,IEN,DATA) ; File data via DIE
+1 ; FILENO = file #
+2 ; IEN = file level internal entry number
+3 ; DATA = array reflecting field numbers and values
+4 ; (DATA(FIELDNO)=VALUE)
+5 ;
+6 NEW DA,DIC,DIDEL,DIE,DLAYGO,DR,DTOUT,X,Y
+7 NEW FIELDNO,I
+8 SET DA=IEN
+9 SET DIE=$$ROOT^DILFD(FILENO)
+10 SET FIELDNO=$ORDER(DATA(""))
+11 SET DR=FIELDNO_"////^S X=DATA("_FIELDNO_")"
+12 FOR I=1:1
SET FIELDNO=$ORDER(DATA(FIELDNO))
if FIELDNO=""
QUIT
Begin DoDot:1
+13 SET DR(1,FILENO,I)=FIELDNO_"////^S X=DATA("_FIELDNO_")"
End DoDot:1
+14 DO ^DIE
+15 QUIT
+16 ;
FILE2(FILENO,IEN1,FIELDNO1,IEN,DATA) ; File subfile data via DIE
+1 ; FILENO = file #
+2 ; IEN1 = file level internal entry number
+3 ; FIELDNO1 = file field #
+4 ; IEN = subfile level internal entry number
+5 ; DATA = array reflecting subfile field numbers and
+6 ; values (DATA(FIELDNO)=VALUE)
+7 ;
+8 ; FILENO_FIELDNO must = subfile #
+9 ; ","_IEN_"," = IENS = internal entry number string
+10 ;
+11 NEW DA,DIDEL,DIC,DIE,DLAYGO,DR,DTOUT,X,Y
+12 NEW FIELDNO,I
+13 SET DA=IEN
SET DA(1)=IEN1
+14 ;S DIE=$$ROOT^DILFD(FILENO)_IEN1_","_FIELDNO1_","
+15 SET DIE=$$ROOT^DILFD(FILENO_FIELDNO1,","_IEN1_",")
+16 SET FIELDNO=$ORDER(DATA(""))
+17 SET DR=FIELDNO_"////^S X=DATA("_FIELDNO_")"
+18 FOR I=1:1
SET FIELDNO=$ORDER(DATA(FIELDNO))
if FIELDNO=""
QUIT
Begin DoDot:1
+19 SET DR(1,FILENO_FIELDNO1,I)=FIELDNO_"////^S X=DATA("_FIELDNO_")"
End DoDot:1
+20 DO ^DIE
+21 QUIT
+22 ;
LOOKUP1(FILENO,X) ; Lookup file entry via DIC
+1 ; FILENO = file #
+2 ; X = lookup value
+3 ;
+4 NEW DA,DIC,DIE,DINUM,DLAYGO,DTOUT,DUOUT,Y
+5 SET DIC=$$ROOT^DILFD(FILENO)
SET DIC(0)="X"
+6 DO ^DIC
+7 QUIT +Y
+8 ;
LOOKUP2(FILENO,IEN1,FIELDNO,X) ; Lookup subfile entry via DIC
+1 ; FILENO = file #
+2 ; IEN1 = file level internal entry number
+3 ; FIELDNO = subfile field #
+4 ; X = lookup value
+5 ;
+6 ; FILENO_FIELDNO must = subfile #
+7 ; ","_IEN1_"," = IENS = internal entry number string
+8 ;
+9 NEW DA,DIC,DIE,DINUM,DLAYGO,DTOUT,DUOUT,Y
+10 IF IEN1'=-1
Begin DoDot:1
+11 SET DIC=$$ROOT^DILFD(FILENO_FIELDNO,","_IEN1_",")
SET DIC(0)="X"
+12 DO ^DIC
End DoDot:1
+13 IF IEN1=-1
SET Y=-1
+14 QUIT +Y
+15 ;
LOOKUP3(FILENO,D,X) ; Lookup file entry via IX^DIC
+1 ; FILENO = file #
+2 ; D = cross-reference to use
+3 ; X = lookup value
+4 ;
+5 NEW DA,DIC,DIE,DINUM,DLAYGO,DTOUT,DUOUT,Y
+6 SET DIC=$$ROOT^DILFD(FILENO)
SET DIC(0)="X"
+7 DO IX^DIC
+8 QUIT +Y
+9 ;
SELECT1(FILENO,PROMPT) ; Select file entry via DIC
+1 ; FILENO = file #
+2 ; PROMPT = prompt (optional)
+3 ;
+4 NEW DIC,DTOUT,DUOUT,X,Y
+5 SET DIC=$$ROOT^DILFD(FILENO)
+6 SET DIC(0)="ABEMQ"
+7 IF $GET(PROMPT)]""
SET DIC("A")=PROMPT
+8 DO ^DIC
+9 IF $DATA(DTOUT)!$DATA(DUOUT)
SET Y=-1
+10 QUIT +Y
