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
Q
POST ;
D REASON
Q
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
Q
MESSAGE(IBMSG) ;
D BMES^XPDUTL(IBMSG)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P614 645 printed Dec 13, 2024@02:04:05 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
