Routine: IBY399P

IBY399P ;ALB/ARH - IB*2*399 POST-INSTALL ; 2/27/09

 ;;2.0;INTEGRATED BILLING;**399**;21-MAR-94;Build 8

 ;;Per VHA Directive 2004-038, this routine should not be modified.

POST ;

 N IBA S IBA="IB*2*399 Post-Install .....",IBA(3)="" D MSG(IBA) K IBA

 D RIDER ; add LTC rider (#355.6)

 D CV ;    add LTC coverage (#355.31)

 D FTF^IBY399P3 ;   add and convert FTFs (#355.13)

 D RNB^IBY399P1 ;   add and update RNBs (#356.8)

 D XREF ; index new AE xref (#362.5,.04)

 S IBA="IB*2*399 Post-Install Complete",IBA(3)="" D MSG(IBA) K IBA

RIDER ; add LONG TERM CARE Insurance Rider (#355.6)

 N IBA,IBNAME,DD,DO,DLAYGO,DIC,X,Y,IBDA,IBARR,IBX

 S IBNAME="LONG TERM CARE COVERAGE"

 I $O(^IBE(355.6,"B",IBNAME,0)) S IBA=">> "_IBNAME_" Insurance Rider (355.6) exists, no change" D MSG(IBA) Q

 K DD,DO S DLAYGO=355.6,DIC="^IBE(355.6,",DIC(0)="L",X=IBNAME D FILE^DICN K DIC S IBDA=+Y I Y<1 K X,Y Q

 S IBA=">> "_IBNAME_" Insurance Rider (#355.6) added" D MSG(IBA)

CV ; add LONG TERM CARE Coverage (#355.31)

 N IBA,IBNAME,IBRIDER,IBRDA,IBX,DD,DO,DLAYGO,DIC,X,Y,IBDA,DIE,DA,DR,IBFILE

 S IBFILE=" Plan Limitation Category (#355.31) "

 S IBNAME="LONG TERM CARE",IBRIDER="LONG TERM CARE COVERAGE"

 S IBRDA=$O(^IBE(355.6,"B",IBRIDER,0)) I 'IBRDA S IBA="=> "_IBNAME_IBFILE_"Not Added, Rider Missing" D MSG(IBA) Q

 I $O(^IBE(355.31,"B",IBNAME,0)) S IBA=">> "_IBNAME_IBFILE_"exists, no change" D MSG(IBA) Q

 K DD,DO S DLAYGO=355.31,DIC="^IBE(355.31,",DIC(0)="L",X=IBNAME D FILE^DICN K DIC S IBDA=+Y I Y<1 K X,Y Q

 S DIE="^IBE(355.31,",DA=+IBDA,DR=".02////Long Term Care coverage;.03////"_IBRDA D ^DIE K DIE,DA,DR,X,Y

 S IBA=">> "_IBNAME_IBFILE_"added" D MSG(IBA)

XREF ; re-index new AE cross reference on IB BILL/CLAIMS PROSTHETICS (#362.5), RECORD (.04)

 N DIK,DIC,X,Y D MSG(">> Indexing new 'AE' xref IB BILL/CLAIMS PROSTHETICS, RECORD (#362.5,.04)")

 S DIK="^IBA(362.5,",DIK(1)=".04^AE" D ENALL^DIK

MSG(IBA) ;

 N IBM S IBM(1)="     ",IBM(2)="     "_$G(IBA)

 D MES^XPDUTL(.IBM)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY399P   2091     printed  Apr 23, 2025@18:48:35                                                                                                                                                                                                     Page 2

IBY399P   ;ALB/ARH - IB*2*399 POST-INSTALL ; 2/27/09

 +1       ;;2.0;INTEGRATED BILLING;**399**;21-MAR-94;Build 8

 +2       ;;Per VHA Directive 2004-038, this routine should not be modified.

 +3       ;

 +4        QUIT

POST      ;

 +1        NEW IBA

           SET IBA="IB*2*399 Post-Install ....."

           SET IBA(3)=""

           DO MSG(IBA)

           KILL IBA

 +2       ;

 +3       ; add LTC rider (#355.6)

           DO RIDER

 +4       ;    add LTC coverage (#355.31)

           DO CV

 +5       ;

 +6       ;   add and convert FTFs (#355.13)

           DO FTF^IBY399P3

 +7       ;

 +8       ;   add and update RNBs (#356.8)

           DO RNB^IBY399P1

 +9       ;

 +10      ; index new AE xref (#362.5,.04)

           DO XREF

 +11      ;

 +12       SET IBA="IB*2*399 Post-Install Complete"

           SET IBA(3)=""

           DO MSG(IBA)

           KILL IBA

 +13       QUIT

 +14      ;

 +15      ;

RIDER     ; add LONG TERM CARE Insurance Rider (#355.6)

 +1        NEW IBA,IBNAME,DD,DO,DLAYGO,DIC,X,Y,IBDA,IBARR,IBX

 +2       ;

 +3        SET IBNAME="LONG TERM CARE COVERAGE"

 +4        IF $ORDER(^IBE(355.6,"B",IBNAME,0))

               SET IBA=">> "_IBNAME_" Insurance Rider (355.6) exists, no change"

               DO MSG(IBA)

               QUIT

 +5       ;

 +6        KILL DD,DO

           SET DLAYGO=355.6

           SET DIC="^IBE(355.6,"

           SET DIC(0)="L"

           SET X=IBNAME

           DO FILE^DICN

           KILL DIC

           SET IBDA=+Y

           IF Y<1

               KILL X,Y

               QUIT

 +7       ;

 +8        SET IBA=">> "_IBNAME_" Insurance Rider (#355.6) added"

           DO MSG(IBA)

 +9        QUIT

 +10      ;

 +11      ;

CV        ; add LONG TERM CARE Coverage (#355.31)

 +1        NEW IBA,IBNAME,IBRIDER,IBRDA,IBX,DD,DO,DLAYGO,DIC,X,Y,IBDA,DIE,DA,DR,IBFILE

 +2        SET IBFILE=" Plan Limitation Category (#355.31) "

 +3       ;

 +4        SET IBNAME="LONG TERM CARE"

           SET IBRIDER="LONG TERM CARE COVERAGE"

 +5        SET IBRDA=$ORDER(^IBE(355.6,"B",IBRIDER,0))

           IF 'IBRDA

               SET IBA="=> "_IBNAME_IBFILE_"Not Added, Rider Missing"

               DO MSG(IBA)

               QUIT

 +6       ;

 +7        IF $ORDER(^IBE(355.31,"B",IBNAME,0))

               SET IBA=">> "_IBNAME_IBFILE_"exists, no change"

               DO MSG(IBA)

               QUIT

 +8       ;

 +9        KILL DD,DO

           SET DLAYGO=355.31

           SET DIC="^IBE(355.31,"

           SET DIC(0)="L"

           SET X=IBNAME

           DO FILE^DICN

           KILL DIC

           SET IBDA=+Y

           IF Y<1

               KILL X,Y

               QUIT

 +10      ;

 +11       SET DIE="^IBE(355.31,"

           SET DA=+IBDA

           SET DR=".02////Long Term Care coverage;.03////"_IBRDA

           DO ^DIE

           KILL DIE,DA,DR,X,Y

 +12      ;

 +13       SET IBA=">> "_IBNAME_IBFILE_"added"

           DO MSG(IBA)

 +14      ;

 +15       QUIT

 +16      ;

XREF      ; re-index new AE cross reference on IB BILL/CLAIMS PROSTHETICS (#362.5), RECORD (.04)

 +1        NEW DIK,DIC,X,Y

           DO MSG(">> Indexing new 'AE' xref IB BILL/CLAIMS PROSTHETICS, RECORD (#362.5,.04)")

 +2        SET DIK="^IBA(362.5,"

           SET DIK(1)=".04^AE"

           DO ENALL^DIK

 +3        QUIT

 +4       ;

MSG(IBA)  ;

 +1        NEW IBM

           SET IBM(1)="     "

           SET IBM(2)="     "_$GET(IBA)

 +2        DO MES^XPDUTL(.IBM)

 +3        QUIT

IBY399P.m