| 1 | IBCNRFM1 ;DAOU/DMK - Perform FileMan API Calls ;05-NOV-2003
|
---|
| 2 | ;;2.0;INTEGRATED BILLING;**251**;21-MAR-94
|
---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
| 4 | ;
|
---|
| 5 | ; Description
|
---|
| 6 | ;
|
---|
| 7 | ; Perform FileMan Add, Delete, File, and Lookup API calls
|
---|
| 8 | ;
|
---|
| 9 | Q
|
---|
| 10 | ;
|
---|
| 11 | ADD1(FILENO,X) ; Add file entry via FILE^DICN
|
---|
| 12 | ; FILENO = file #
|
---|
| 13 | ; X = file .01 field internal value
|
---|
| 14 | ;
|
---|
| 15 | K DO
|
---|
| 16 | N DA,DIC,DIE,DINUM,DLAYGO,DTOUT,DUOUT,Y
|
---|
| 17 | S DIC=$$ROOT^DILFD(FILENO),DIC(0)="L"
|
---|
| 18 | S DLAYGO=FILENO
|
---|
| 19 | D FILE^DICN
|
---|
| 20 | Q +Y
|
---|
| 21 | ;
|
---|
| 22 | ADD2(FILENO,IEN1,FIELDNO,X) ; Add subfile entry via FILE^DICN
|
---|
| 23 | ; FILENO = file #
|
---|
| 24 | ; IEN1 = file level internal entry number
|
---|
| 25 | ; FIELDNO = subfile field #
|
---|
| 26 | ; X = subfile .01 field internal value
|
---|
| 27 | ;
|
---|
| 28 | ; FILENO_FIELDNO must = subfile #
|
---|
| 29 | ; ","_IEN1_"," = IENS = internal entry number string
|
---|
| 30 | ;
|
---|
| 31 | K DO
|
---|
| 32 | N DA,DIC,DIE,DINUM,DLAYGO,DTOUT,DUOUT,Y
|
---|
| 33 | S DA(1)=IEN1
|
---|
| 34 | S DIC=$$ROOT^DILFD(FILENO_FIELDNO,","_IEN1_",")
|
---|
| 35 | S DIC(0)="L",DIC("P")=$P(^DD(FILENO,FIELDNO,0),"^",2)
|
---|
| 36 | S DLAYGO=FILENO
|
---|
| 37 | D FILE^DICN
|
---|
| 38 | Q +Y
|
---|
| 39 | ;
|
---|
| 40 | DELETE1(FILENO,IEN) ; Delete file entry via DIK
|
---|
| 41 | ; FILENO = file #
|
---|
| 42 | ; IEN = file level internal entry number
|
---|
| 43 | ;
|
---|
| 44 | N %,DA,DIC,DIK,X,Y
|
---|
| 45 | S DA=IEN
|
---|
| 46 | S DIK=$$ROOT^DILFD(FILENO)
|
---|
| 47 | D ^DIK
|
---|
| 48 | Q
|
---|
| 49 | ;
|
---|
| 50 | DELETE2(FILENO,IEN1,FIELDNO,IEN) ; Delete subfile entry via DIK
|
---|
| 51 | ; FILENO = file #
|
---|
| 52 | ; IEN1 = file level internal entry number
|
---|
| 53 | ; FIELDNO = subfile field #
|
---|
| 54 | ; IEN = subfile level internal entry number
|
---|
| 55 | ;
|
---|
| 56 | ; FILENO_FIELDNO must = subfile #
|
---|
| 57 | ; ","_IEN_"," = IENS = internal entry number string
|
---|
| 58 | ;
|
---|
| 59 | N %,DA,DIC,DIK,X,Y
|
---|
| 60 | S DA(1)=IEN1,DA=IEN
|
---|
| 61 | S DIK=$$ROOT^DILFD(FILENO_FIELDNO,","_IEN1_",")
|
---|
| 62 | D ^DIK
|
---|
| 63 | Q
|
---|
| 64 | ;
|
---|
| 65 | FILE1(FILENO,IEN,DATA) ; File data via DIE
|
---|
| 66 | ; FILENO = file #
|
---|
| 67 | ; IEN = file level internal entry number
|
---|
| 68 | ; DATA = array reflecting field numbers and values
|
---|
| 69 | ; (DATA(FIELDNO)=VALUE)
|
---|
| 70 | ;
|
---|
| 71 | N DA,DIC,DIDEL,DIE,DLAYGO,DR,DTOUT,X,Y
|
---|
| 72 | N FIELDNO,I
|
---|
| 73 | S DA=IEN
|
---|
| 74 | S DIE=$$ROOT^DILFD(FILENO)
|
---|
| 75 | S FIELDNO=$O(DATA(""))
|
---|
| 76 | S DR=FIELDNO_"////^S X=DATA("_FIELDNO_")"
|
---|
| 77 | F I=1:1 S FIELDNO=$O(DATA(FIELDNO)) Q:FIELDNO="" D
|
---|
| 78 | . S DR(1,FILENO,I)=FIELDNO_"////^S X=DATA("_FIELDNO_")"
|
---|
| 79 | D ^DIE
|
---|
| 80 | Q
|
---|
| 81 | ;
|
---|
| 82 | FILE2(FILENO,IEN1,FIELDNO1,IEN,DATA) ; File subfile data via DIE
|
---|
| 83 | ; FILENO = file #
|
---|
| 84 | ; IEN1 = file level internal entry number
|
---|
| 85 | ; FIELDNO1 = file field #
|
---|
| 86 | ; IEN = subfile level internal entry number
|
---|
| 87 | ; DATA = array reflecting subfile field numbers and
|
---|
| 88 | ; values (DATA(FIELDNO)=VALUE)
|
---|
| 89 | ;
|
---|
| 90 | ; FILENO_FIELDNO must = subfile #
|
---|
| 91 | ; ","_IEN_"," = IENS = internal entry number string
|
---|
| 92 | ;
|
---|
| 93 | N DA,DIDEL,DIC,DIE,DLAYGO,DR,DTOUT,X,Y
|
---|
| 94 | N FIELDNO,I
|
---|
| 95 | S DA=IEN,DA(1)=IEN1
|
---|
| 96 | ;S DIE=$$ROOT^DILFD(FILENO)_IEN1_","_FIELDNO1_","
|
---|
| 97 | S DIE=$$ROOT^DILFD(FILENO_FIELDNO1,","_IEN1_",")
|
---|
| 98 | S FIELDNO=$O(DATA(""))
|
---|
| 99 | S DR=FIELDNO_"////^S X=DATA("_FIELDNO_")"
|
---|
| 100 | F I=1:1 S FIELDNO=$O(DATA(FIELDNO)) Q:FIELDNO="" D
|
---|
| 101 | . S DR(1,FILENO_FIELDNO1,I)=FIELDNO_"////^S X=DATA("_FIELDNO_")"
|
---|
| 102 | D ^DIE
|
---|
| 103 | Q
|
---|
| 104 | ;
|
---|
| 105 | LOOKUP1(FILENO,X) ; Lookup file entry via DIC
|
---|
| 106 | ; FILENO = file #
|
---|
| 107 | ; X = lookup value
|
---|
| 108 | ;
|
---|
| 109 | N DA,DIC,DIE,DINUM,DLAYGO,DTOUT,DUOUT,Y
|
---|
| 110 | S DIC=$$ROOT^DILFD(FILENO),DIC(0)="X"
|
---|
| 111 | D ^DIC
|
---|
| 112 | Q +Y
|
---|
| 113 | ;
|
---|
| 114 | LOOKUP2(FILENO,IEN1,FIELDNO,X) ; Lookup subfile entry via DIC
|
---|
| 115 | ; FILENO = file #
|
---|
| 116 | ; IEN1 = file level internal entry number
|
---|
| 117 | ; FIELDNO = subfile field #
|
---|
| 118 | ; X = lookup value
|
---|
| 119 | ;
|
---|
| 120 | ; FILENO_FIELDNO must = subfile #
|
---|
| 121 | ; ","_IEN1_"," = IENS = internal entry number string
|
---|
| 122 | ;
|
---|
| 123 | N DA,DIC,DIE,DINUM,DLAYGO,DTOUT,DUOUT,Y
|
---|
| 124 | I IEN1'=-1 D
|
---|
| 125 | . S DIC=$$ROOT^DILFD(FILENO_FIELDNO,","_IEN1_","),DIC(0)="X"
|
---|
| 126 | . D ^DIC
|
---|
| 127 | I IEN1=-1 S Y=-1
|
---|
| 128 | Q +Y
|
---|
| 129 | ;
|
---|
| 130 | LOOKUP3(FILENO,D,X) ; Lookup file entry via IX^DIC
|
---|
| 131 | ; FILENO = file #
|
---|
| 132 | ; D = cross-reference to use
|
---|
| 133 | ; X = lookup value
|
---|
| 134 | ;
|
---|
| 135 | N DA,DIC,DIE,DINUM,DLAYGO,DTOUT,DUOUT,Y
|
---|
| 136 | S DIC=$$ROOT^DILFD(FILENO),DIC(0)="X"
|
---|
| 137 | D IX^DIC
|
---|
| 138 | Q +Y
|
---|
| 139 | ;
|
---|
| 140 | SELECT1(FILENO,PROMPT) ; Select file entry via DIC
|
---|
| 141 | ; FILENO = file #
|
---|
| 142 | ; PROMPT = prompt (optional)
|
---|
| 143 | ;
|
---|
| 144 | N DIC,DTOUT,DUOUT,X,Y
|
---|
| 145 | S DIC=$$ROOT^DILFD(FILENO)
|
---|
| 146 | S DIC(0)="ABEMQ"
|
---|
| 147 | I $G(PROMPT)]"" S DIC("A")=PROMPT
|
---|
| 148 | D ^DIC
|
---|
| 149 | I $D(DTOUT)!$D(DUOUT) S Y=-1
|
---|
| 150 | Q +Y
|
---|