IB20P486.m

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 ---IB20P486   1313     printed  Apr 09, 2024@21:06:36                                                                                                                                                                                                    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