Routine: IB20P614

IB20P614 ;SLC/RED-PATCH 614 POST INSTALL ; 8-MAR-18

 ;;2.0;INTEGRATED BILLING;**614**;21-MAR-18;Build 25

 ;Post install for IB*2.0*614

 ; IA:  FILE^DICN  - #10009

POST ;

 D REASON

REASON ; entry added to file #350.3  - IB CHARGE REMOVE REASON

 N DIC,X,IBX

 D MES^XPDUTL(" >>- Adding entry 'HRFS FLAGGED' to IB Charge Removal Reason (#350.3) file.")

 S IBX="HRFS FLAGGED^HRFS" D

 . S DIC="^IBE(350.3,",DIC(0)="",X=$P(IBX,"^")

 . S DIC("DR")=".02///^S X=$P(IBX,U,2);.03///3"

 . I $O(^IBE(350.3,"B",X,0)) D MES^XPDUTL("      - "_X_" already exists.") Q

 . D FILE^DICN

MESSAGE(IBMSG) ;

 D BMES^XPDUTL(IBMSG)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P614   645     printed  Mar 13, 2025@21:08:51                                                                                                                                                                                                     Page 2

IB20P614  ;SLC/RED-PATCH 614 POST INSTALL ; 8-MAR-18

 +1       ;;2.0;INTEGRATED BILLING;**614**;21-MAR-18;Build 25

 +2       ;

 +3       ;Post install for IB*2.0*614

 +4       ; IA:  FILE^DICN  - #10009

 +5        QUIT

POST      ;

 +1        DO REASON

 +2        QUIT

REASON    ; entry added to file #350.3  - IB CHARGE REMOVE REASON

 +1       ;

 +2        NEW DIC,X,IBX

 +3        DO MES^XPDUTL(" >>- Adding entry 'HRFS FLAGGED' to IB Charge Removal Reason (#350.3) file.")

 +4        SET IBX="HRFS FLAGGED^HRFS"

           Begin DoDot:1

 +5            SET DIC="^IBE(350.3,"

               SET DIC(0)=""

               SET X=$PIECE(IBX,"^")

 +6            SET DIC("DR")=".02///^S X=$P(IBX,U,2);.03///3"

 +7            IF $ORDER(^IBE(350.3,"B",X,0))

                   DO MES^XPDUTL("      - "_X_" already exists.")

                   QUIT

 +8            DO FILE^DICN

           End DoDot:1

 +9        QUIT

MESSAGE(IBMSG) ;

 +1        DO BMES^XPDUTL(IBMSG)

 +2        QUIT

IB20P614.m