Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCNRFM1

IBCNRFM1.m

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