IBECECU2 ;ALB/CLT - SECONDARY INPUT OF DSP DATA ; 08 Jul 2022 9:25 AM
;;2.0;INTEGRATED BILLING;**704**;21-MAR-94;Build 49
;Per VA Directive 6402, this routine should not be modified.
;
;
Q
EN(IBCLDT1,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)=""
S IB351DA=$O(^IBE(351,"AIVDT",DFN,-IBCLDT1,";"),-1) Q:'IB351DA
S IBREFNUM=$P(^IBE(351,IB351DA,0),U)
S DA=$O(^IBE(351.3,"B",IBREFNUM,0))
I +DA=0 S X=IBREFNUM 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"
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)=IBISITE
D UPDATE^DIE(,"IBFDA","IBERR")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBECECU2 1370 printed Dec 13, 2024@02:21:39 Page 2
IBECECU2 ;ALB/CLT - SECONDARY INPUT OF DSP DATA ; 08 Jul 2022 9:25 AM
+1 ;;2.0;INTEGRATED BILLING;**704**;21-MAR-94;Build 49
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;
+5 QUIT
EN(IBCLDT1,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)=""
+4 SET IB351DA=$ORDER(^IBE(351,"AIVDT",DFN,-IBCLDT1,";"),-1)
if 'IB351DA
QUIT
+5 SET IBREFNUM=$PIECE(^IBE(351,IB351DA,0),U)
+6 SET DA=$ORDER(^IBE(351.3,"B",IBREFNUM,0))
+7 IF +DA=0
SET X=IBREFNUM
DO FILE^DICN
SET DA=$PIECE(Y,U,1)
+8 SET DIE=DIC
SET DR=".02////^S X=DFN"
DO ^DIE
+9 DO NEWSUB
+10 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 IF IBISTAT=1
SET IBISTAT="CU"
+7 SET IBIENS="+1,"_DA_","
+8 SET IBFDA(351.31,IBIENS,.01)=IBCLDA
+9 if $GET(IBICLDT)'=""
SET IBFDA(351.31,IBIENS,.02)=IBICLDT
+10 if $GET(IBISTAT)'=""
SET IBFDA(351.31,IBIENS,.03)=IBISTAT
+11 if $GET(IBI901)'=""
SET IBFDA(351.31,IBIENS,.04)=IBI901
+12 if $GET(IBI902)=""
SET IBFDA(351.31,IBIENS,.05)=IBI902
+13 if $GET(IBI903)'=""
SET IBFDA(351.31,IBIENS,.06)=IBI903
+14 if $GET(IBI904)'=""
SET IBFDA(351.31,IBIENS,.07)=IBI904
+15 if $GET(IBICLDAY)'=""
SET IBFDA(351.31,IBIENS,.08)=IBICLDAY
+16 if $GET(IBICKDT)'=""
SET IBFDA(351.31,IBIENS,.09)=IBICKDT
+17 if $GET(IBISITE)'=""
SET IBFDA(351.31,IBIENS,10)=IBISITE
+18 DO UPDATE^DIE(,"IBFDA","IBERR")
+19 QUIT
