IB20P486 ;ALB/RRA POST INIT ACTION ;24-JUN-2003
;;2.0;INTEGRATED BILLING;**486**;21-MAR-94;Build 3
;;Per VHA Directive 2004-038, this routine should not be modified.
;
;
; Post Init Description: Add CAMP LEJEUNE TREATMENT as a new RNB
;
Q
;
;
EN ;
D BMES^XPDUTL(">>> UPDATING CLAIMS TRACKING NON-BILLABLE REASONS file #356.8")
D MES^XPDUTL(" ")
D BMES^XPDUTL(">>> Adding CAMP LEJEUNE TREATMENT .......")
D MES^XPDUTL(" ")
D NEWNBR
;
Q
;
NEWNBR ; Add CAMP LEJEUNE TREATMENT IB non-billable reasons #356.8
N IBMES,IBNAME,IBJ,IBNX,IBEFLAG,IBEPFLAG,IBCODE,DINUM
S IBNAME="CAMP LEJEUNE TREATMENT"
I $D(^IBE(356.8,"B",IBNAME)) D BMES^XPDUTL("CAMP LEJEUNE TREATMENT already on file....nothing updated") Q
I '$D(^IBE(356.8,"B",IBNAME)) D
. F IBJ=100:1 S IBNX=$G(^IBE(356.8,IBJ,0)) I IBNX="" S DINUM=IBJ Q
. S IBEFLAG=1,IBEPFLAG=0,IBCODE="VA11"
. S DLAYGO=356.8,DIC="^IBE(356.8,",DIC(0)="L",X=IBNAME
. S DIC("DR")=".01///^S X=IBNAME;.02///^S X=IBEFLAG;.03///^S X=IBEPFLAG;.04///^S X=IBCODE"
. D FILE^DICN
.I +Y>0 D
..D MES^XPDUTL(" ")
..D BMES^XPDUTL("CAMP LEJEUNE TREATMENT.....successfully added.")
.I Y=-1 D
..D MES^XPDUTL(" ")
..D BMES^XPDUTL("****ERROR when attempting to add CAMP LEJEUNE TREATMENT")
.K Y
K DIC("DR"),DLAYGO,DIC,DIC(0),X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P486 1313 printed Dec 13, 2024@02:03:12 Page 2
IB20P486 ;ALB/RRA POST INIT ACTION ;24-JUN-2003
+1 ;;2.0;INTEGRATED BILLING;**486**;21-MAR-94;Build 3
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;
+5 ; Post Init Description: Add CAMP LEJEUNE TREATMENT as a new RNB
+6 ;
+7 QUIT
+8 ;
+9 ;
EN ;
+1 DO BMES^XPDUTL(">>> UPDATING CLAIMS TRACKING NON-BILLABLE REASONS file #356.8")
+2 DO MES^XPDUTL(" ")
+3 DO BMES^XPDUTL(">>> Adding CAMP LEJEUNE TREATMENT .......")
+4 DO MES^XPDUTL(" ")
+5 DO NEWNBR
+6 ;
+7 QUIT
+8 ;
NEWNBR ; Add CAMP LEJEUNE TREATMENT IB non-billable reasons #356.8
+1 NEW IBMES,IBNAME,IBJ,IBNX,IBEFLAG,IBEPFLAG,IBCODE,DINUM
+2 SET IBNAME="CAMP LEJEUNE TREATMENT"
+3 IF $DATA(^IBE(356.8,"B",IBNAME))
DO BMES^XPDUTL("CAMP LEJEUNE TREATMENT already on file....nothing updated")
QUIT
+4 IF '$DATA(^IBE(356.8,"B",IBNAME))
Begin DoDot:1
+5 FOR IBJ=100:1
SET IBNX=$GET(^IBE(356.8,IBJ,0))
IF IBNX=""
SET DINUM=IBJ
QUIT
+6 SET IBEFLAG=1
SET IBEPFLAG=0
SET IBCODE="VA11"
+7 SET DLAYGO=356.8
SET DIC="^IBE(356.8,"
SET DIC(0)="L"
SET X=IBNAME
+8 SET DIC("DR")=".01///^S X=IBNAME;.02///^S X=IBEFLAG;.03///^S X=IBEPFLAG;.04///^S X=IBCODE"
+9 DO FILE^DICN
+10 IF +Y>0
Begin DoDot:2
+11 DO MES^XPDUTL(" ")
+12 DO BMES^XPDUTL("CAMP LEJEUNE TREATMENT.....successfully added.")
End DoDot:2
+13 IF Y=-1
Begin DoDot:2
+14 DO MES^XPDUTL(" ")
+15 DO BMES^XPDUTL("****ERROR when attempting to add CAMP LEJEUNE TREATMENT")
End DoDot:2
+16 KILL Y
End DoDot:1
+17 KILL DIC("DR"),DLAYGO,DIC,DIC(0),X
+18 QUIT
