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

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