IB20P627 ;OAK/ELZ - POST INIT FOR PATCH;06/20/2018 ; 31 Jan 2019 3:24 PM
;;2.0;INTEGRATED BILLING;**627**;21-MAR-94;Build 21
;;Per VA Directive 6402, this routine should not be modified.
;
;
POST ; post init entry point
;
D MES^XPDUTL(" Starting post-init for IB*2.0*627")
;
D 3542
D 3503
;
D MES^XPDUTL(" Finished post-init for IB*2.0*627")
;
Q
;
3542 ; add entry to exemption file 354.2 if not there
I $O(^IBE(354.2,"B","MEDAL OF HONOR",0)) D Q
. D MES^XPDUTL(" - MEDAL OF HONOR already exists, nothing to add to 354.2.")
;
N DO,X,Y,DIC
;
S X="MEDAL OF HONOR",DIC="^IBE(354.2,",DIC(0)=""
S DIC("DR")=".02///Patient awarded Medal of Honor;.03///1;.04///1;.05///50"
D FILE^DICN
;
D MES^XPDUTL($S(Y>1:" - MEDAL OF HONOR Exemption Reason (#354.2) added.",1:"*** ERROR: COULD NOT CREATE NEW MOH ENTRY IN 354.2 ***"))
;
Q
;
3503 ; add entry to Charge Removal Reason file if not there
;
N IBX,DO,DIC,X,Y
;
D MES^XPDUTL(" - Adding entry to Charge Removal Reason (#350.3) file.")
S IBX="MEDAL OF HONOR^MOH" 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
. D MES^XPDUTL($S(Y>1:" - "_$P(IBX,"^")_" entry added.",1:"*** ERROR: COULD NOT CREATE NEW "_$P(IBX,"^",2)_" ENTRY IN 350.3 ***"))
;
D MES^XPDUTL(" - Done adding entry in Charge Removal Reason (#350.3) file.")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P627 1506 printed Dec 13, 2024@02:04:11 Page 2
IB20P627 ;OAK/ELZ - POST INIT FOR PATCH;06/20/2018 ; 31 Jan 2019 3:24 PM
+1 ;;2.0;INTEGRATED BILLING;**627**;21-MAR-94;Build 21
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;
POST ; post init entry point
+1 ;
+2 DO MES^XPDUTL(" Starting post-init for IB*2.0*627")
+3 ;
+4 DO 3542
+5 DO 3503
+6 ;
+7 DO MES^XPDUTL(" Finished post-init for IB*2.0*627")
+8 ;
+9 QUIT
+10 ;
3542 ; add entry to exemption file 354.2 if not there
+1 IF $ORDER(^IBE(354.2,"B","MEDAL OF HONOR",0))
Begin DoDot:1
+2 DO MES^XPDUTL(" - MEDAL OF HONOR already exists, nothing to add to 354.2.")
End DoDot:1
QUIT
+3 ;
+4 NEW DO,X,Y,DIC
+5 ;
+6 SET X="MEDAL OF HONOR"
SET DIC="^IBE(354.2,"
SET DIC(0)=""
+7 SET DIC("DR")=".02///Patient awarded Medal of Honor;.03///1;.04///1;.05///50"
+8 DO FILE^DICN
+9 ;
+10 DO MES^XPDUTL($SELECT(Y>1:" - MEDAL OF HONOR Exemption Reason (#354.2) added.",1:"*** ERROR: COULD NOT CREATE NEW MOH ENTRY IN 354.2 ***"))
+11 ;
+12 QUIT
+13 ;
3503 ; add entry to Charge Removal Reason file if not there
+1 ;
+2 NEW IBX,DO,DIC,X,Y
+3 ;
+4 DO MES^XPDUTL(" - Adding entry to Charge Removal Reason (#350.3) file.")
+5 SET IBX="MEDAL OF HONOR^MOH"
Begin DoDot:1
+6 SET DIC="^IBE(350.3,"
SET DIC(0)=""
SET X=$PIECE(IBX,"^")
+7 SET DIC("DR")=".02///^S X=$P(IBX,U,2);.03///3"
+8 IF $ORDER(^IBE(350.3,"B",X,0))
DO MES^XPDUTL(" - "_X_" already exists.")
QUIT
+9 DO FILE^DICN
+10 DO MES^XPDUTL($SELECT(Y>1:" - "_$PIECE(IBX,"^")_" entry added.",1:"*** ERROR: COULD NOT CREATE NEW "_$PIECE(IBX,"^",2)_" ENTRY IN 350.3 ***"))
End DoDot:1
+11 ;
+12 DO MES^XPDUTL(" - Done adding entry in Charge Removal Reason (#350.3) file.")
+13 QUIT
+14 ;
