IBECECU2 ;ALB/CLT - SECONDARY INPUT OF DSP DATA ; 08 Jul 2022 9:25 AM
;;2.0;INTEGRATED BILLING;**704,769**;21-MAR-94;Build 42
;Per VA Directive 6402, this routine should not be modified.
;
;
Q
EN(IB351IEN,DFN) ;ENTRY POINT FOR ADDING ENTRIES TO 351.3
;Create a new entry in file 351.3
N DIC,IBFDA,IEN,IBIENS,X,Y,IEN3513,IBERR,IB351DA,DIE,DA,DR,IBREFNUM
S DIC="^IBE(351.3,",DIC(0)="",DA=$O(^IBE(351.3,"B",IB351IEN,0))
I +DA=0 S X=IB351IEN D FILE^DICN S DA=$P(Y,U,1)
S DIE=DIC,DR=".02////^S X=DFN" D ^DIE
D NEWSUB
Q
NEWSUB ;Create and Load new sub-file entry
;S DA(1)=DA
;S DIC=DIC_DA(1)_",1,"
;S DIC(0)="L"
;S X=IBCLDA
;D ^DIC S DA=+Y
;I IBISTAT=1 S IBISTAT="CU"
I $G(IBISTAT)'=2 S IBISTAT=$S('$G(IBICLNDT):"CU",$G(IBICLNDT)<=DT:"CL",1:"CU")
S IBIENS="+1,"_DA_","
S IBFDA(351.31,IBIENS,.01)=IBCLDA
S:$G(IBICLDT)'="" IBFDA(351.31,IBIENS,.02)=IBICLDT
S:$G(IBISTAT)'="" IBFDA(351.31,IBIENS,.03)=IBISTAT
S:$G(IBI901)'="" IBFDA(351.31,IBIENS,.04)=IBI901
S:$G(IBI902)'="" IBFDA(351.31,IBIENS,.05)=IBI902
S:$G(IBI903)'="" IBFDA(351.31,IBIENS,.06)=IBI903
S:$G(IBI904)'="" IBFDA(351.31,IBIENS,.07)=IBI904
S:$G(IBICLDAY)'="" IBFDA(351.31,IBIENS,.08)=IBICLDAY
S:$G(IBICKDT)'="" IBFDA(351.31,IBIENS,.09)=IBICKDT
S:$G(IBISITE)'="" IBFDA(351.31,IBIENS,10)=$$IEN^XUAF4(IBISITE) ;IB*2.0*769 - Use IEN to store Institution
S:$G(IBFVRSN1)'=0 IBFDA(351.31,IBIENS,11)=IBFVRSN1
S IB3513(DA_"^"_IBISITE_"^"_IBFVRSN1)=""
D UPDATE^DIE(,"IBFDA","IBERR")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBECECU2 1502 printed Sep 23, 2025@19:57:55 Page 2
IBECECU2 ;ALB/CLT - SECONDARY INPUT OF DSP DATA ; 08 Jul 2022 9:25 AM
+1 ;;2.0;INTEGRATED BILLING;**704,769**;21-MAR-94;Build 42
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;
+5 QUIT
EN(IB351IEN,DFN) ;ENTRY POINT FOR ADDING ENTRIES TO 351.3
+1 ;Create a new entry in file 351.3
+2 NEW DIC,IBFDA,IEN,IBIENS,X,Y,IEN3513,IBERR,IB351DA,DIE,DA,DR,IBREFNUM
+3 SET DIC="^IBE(351.3,"
SET DIC(0)=""
SET DA=$ORDER(^IBE(351.3,"B",IB351IEN,0))
+4 IF +DA=0
SET X=IB351IEN
DO FILE^DICN
SET DA=$PIECE(Y,U,1)
+5 SET DIE=DIC
SET DR=".02////^S X=DFN"
DO ^DIE
+6 DO NEWSUB
+7 QUIT
NEWSUB ;Create and Load new sub-file entry
+1 ;S DA(1)=DA
+2 ;S DIC=DIC_DA(1)_",1,"
+3 ;S DIC(0)="L"
+4 ;S X=IBCLDA
+5 ;D ^DIC S DA=+Y
+6 ;I IBISTAT=1 S IBISTAT="CU"
+7 IF $GET(IBISTAT)'=2
SET IBISTAT=$SELECT('$GET(IBICLNDT):"CU",$GET(IBICLNDT)<=DT:"CL",1:"CU")
+8 SET IBIENS="+1,"_DA_","
+9 SET IBFDA(351.31,IBIENS,.01)=IBCLDA
+10 if $GET(IBICLDT)'=""
SET IBFDA(351.31,IBIENS,.02)=IBICLDT
+11 if $GET(IBISTAT)'=""
SET IBFDA(351.31,IBIENS,.03)=IBISTAT
+12 if $GET(IBI901)'=""
SET IBFDA(351.31,IBIENS,.04)=IBI901
+13 if $GET(IBI902)'=""
SET IBFDA(351.31,IBIENS,.05)=IBI902
+14 if $GET(IBI903)'=""
SET IBFDA(351.31,IBIENS,.06)=IBI903
+15 if $GET(IBI904)'=""
SET IBFDA(351.31,IBIENS,.07)=IBI904
+16 if $GET(IBICLDAY)'=""
SET IBFDA(351.31,IBIENS,.08)=IBICLDAY
+17 if $GET(IBICKDT)'=""
SET IBFDA(351.31,IBIENS,.09)=IBICKDT
+18 ;IB*2.0*769 - Use IEN to store Institution
if $GET(IBISITE)'=""
SET IBFDA(351.31,IBIENS,10)=$$IEN^XUAF4(IBISITE)
+19 if $GET(IBFVRSN1)'=0
SET IBFDA(351.31,IBIENS,11)=IBFVRSN1
+20 SET IB3513(DA_"^"_IBISITE_"^"_IBFVRSN1)=""
+21 DO UPDATE^DIE(,"IBFDA","IBERR")
+22 QUIT
