- 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 Jan 18, 2025@03:17:28 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