IB20P459.m

IB20P459 ;ALB/CXW - IB V2.0 POST INIT, IB Action Type Update; 12-SEP-2011

 ;;2.0;INTEGRATED BILLING;**459**;21-MAR-94;Build 16

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

 Q

 ;

POST ; 

 D MSG("    IB*2*459 Post-Install .....")

 D UPACT

 D MSG("    IB*2*459 Post-Install Complete")

 Q

 ;

UPACT ;Update to file #350.1

 N IBI,IBY,IBCR,IBAT,IBCEN,IBNCC,DIE,DA,DR,X

 S IBNCC="HOSPITAL CARE (NSC)"

 S IBCEN=$O(^PRCA(430.2,"B",IBNCC,0))

 I 'IBCEN D MSG(">>> "_IBNCC_" not defined on file #430.2, no update on file #350.1") Q

 D MSG(">>> Updating Charge Category to file #350.1...")

 F IBI=1:1 S IBCR=$P($T(IBAT+IBI),";;",2) Q:IBCR="QUIT"  D

 . S IBY=$P(IBCR,"^")

 . S IBY=$O(^IBE(350.1,"B",IBY,0))

 . I 'IBY D MSG(" >> "_IBCR_" not defined on file #350.1") Q

 . S DA=+IBY,DIE="^IBE(350.1,",DR=".03///"_IBNCC D ^DIE K DA,DIE,DR

 . D MSG(" >> "_IBNCC_" updated to the "_IBCR_" type")

 Q

 ;

MSG(X) ;

 D MES^XPDUTL(X)

 Q

 ;

IBAT ; Name

 ;;DG FEE SERVICE (INPT) NEW

 ;;DG FEE SERVICE (INPT) UPDATE

 ;;DG FEE SERVICE (INPT) CANCEL

 ;;QUIT

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IB20P459   1088     printed  Apr 09, 2024@21:37:45                                                                                                                                                                                                    Page 2

IB20P459  ;ALB/CXW - IB V2.0 POST INIT, IB Action Type Update; 12-SEP-2011

 +1       ;;2.0;INTEGRATED BILLING;**459**;21-MAR-94;Build 16

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

 +3        QUIT 

 +4       ;

POST      ; 

 +1        DO MSG("    IB*2*459 Post-Install .....")

 +2        DO UPACT

 +3        DO MSG("    IB*2*459 Post-Install Complete")

 +4        QUIT 

 +5       ;

UPACT     ;Update to file #350.1

 +1        NEW IBI,IBY,IBCR,IBAT,IBCEN,IBNCC,DIE,DA,DR,X

 +2        SET IBNCC="HOSPITAL CARE (NSC)"

 +3        SET IBCEN=$ORDER(^PRCA(430.2,"B",IBNCC,0))

 +4        IF 'IBCEN

               DO MSG(">>> "_IBNCC_" not defined on file #430.2, no update on file #350.1")

               QUIT 

 +5        DO MSG(">>> Updating Charge Category to file #350.1...")

 +6        FOR IBI=1:1

               SET IBCR=$PIECE($TEXT(IBAT+IBI),";;",2)

               if IBCR="QUIT"

                   QUIT 

               Begin DoDot:1

 +7                SET IBY=$PIECE(IBCR,"^")

 +8                SET IBY=$ORDER(^IBE(350.1,"B",IBY,0))

 +9                IF 'IBY

                       DO MSG(" >> "_IBCR_" not defined on file #350.1")

                       QUIT 

 +10               SET DA=+IBY

                   SET DIE="^IBE(350.1,"

                   SET DR=".03///"_IBNCC

                   DO ^DIE

                   KILL DA,DIE,DR

 +11               DO MSG(" >> "_IBNCC_" updated to the "_IBCR_" type")

               End DoDot:1

 +12       QUIT 

 +13      ;

MSG(X)    ;

 +1        DO MES^XPDUTL(X)

 +2        QUIT 

 +3       ;

IBAT      ; Name

 +1       ;;DG FEE SERVICE (INPT) NEW

 +2       ;;DG FEE SERVICE (INPT) UPDATE

 +3       ;;DG FEE SERVICE (INPT) CANCEL

 +4       ;;QUIT

 +5       ;