IB20P646 ;SAB/Albany - IB*2.0*646 POST INSTALL;12/11/17 2:10pm
;;2.0;Integrated Billing;**646**;Mar 20, 1995;Build 5
;Per VA Directive 6402, this routine should not be modified.
Q
;
POSTINIT ;Post Install for IB*2.0*618
D BMES^XPDUTL(" >> Starting the Post-Initialization routine for IB*2.0*618 ")
; Adding AR CATEGORIES and REVENUE SOURCE CODES
D IBUPD
D BMES^XPDUTL(" >> End of the Post-Initialization routine for IB*2.0*618")
Q
;
IBUPD ; Inactivate FEE Service Entries
;
N LOOP,LIEN,IBDATA
N X,Y,DIE,DA,DR,DTOUT,DATA
;
; Grab all of the entries to update
D MES^XPDUTL(" -> Activating DG FEE SERVICE (OPT) Action Types (350.1).")
F LOOP=1:1:3 D
. ;Extract the new ACTION TYPE to be added.
. S IBDATA=$T(IBDDAT+LOOP)
. S IBDATA=$P(IBDATA,";;",2)
. ;Store in array for adding to the file (#350.1).
. Q:IBDATA="" ;go to next entry if Category is not to be updated.
. S LIEN=$O(^IBE(350.1,"B",IBDATA,"")) ; find ACTION TYPE entry
. Q:LIEN=""
. ;
. ; File the update along with inactivate the ACTION TYPE
. S DR=".12////0"
. I IBDATA="DG FEE SERVICE (OPT) NEW" S DR=DR_";.08////CC URGENT CARE;20////S IBDESC="_$C(34)_"CC URGENT CARE"_$C(34)
. S DIE="^IBE(350.1,",DA=LIEN
. D ^DIE
. K DR ;Clear update array before next use
;
S DR=""
Q
;
IBDDAT ; Fee Service to inactivate
;;DG FEE SERVICE (OPT) CANCEL
;;DG FEE SERVICE (OPT) NEW
;;DG FEE SERVICE (OPT) UPDATE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P646 1453 printed Dec 13, 2024@02:04:17 Page 2
IB20P646 ;SAB/Albany - IB*2.0*646 POST INSTALL;12/11/17 2:10pm
+1 ;;2.0;Integrated Billing;**646**;Mar 20, 1995;Build 5
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
POSTINIT ;Post Install for IB*2.0*618
+1 DO BMES^XPDUTL(" >> Starting the Post-Initialization routine for IB*2.0*618 ")
+2 ; Adding AR CATEGORIES and REVENUE SOURCE CODES
+3 DO IBUPD
+4 DO BMES^XPDUTL(" >> End of the Post-Initialization routine for IB*2.0*618")
+5 QUIT
+6 ;
IBUPD ; Inactivate FEE Service Entries
+1 ;
+2 NEW LOOP,LIEN,IBDATA
+3 NEW X,Y,DIE,DA,DR,DTOUT,DATA
+4 ;
+5 ; Grab all of the entries to update
+6 DO MES^XPDUTL(" -> Activating DG FEE SERVICE (OPT) Action Types (350.1).")
+7 FOR LOOP=1:1:3
Begin DoDot:1
+8 ;Extract the new ACTION TYPE to be added.
+9 SET IBDATA=$TEXT(IBDDAT+LOOP)
+10 SET IBDATA=$PIECE(IBDATA,";;",2)
+11 ;Store in array for adding to the file (#350.1).
+12 ;go to next entry if Category is not to be updated.
if IBDATA=""
QUIT
+13 ; find ACTION TYPE entry
SET LIEN=$ORDER(^IBE(350.1,"B",IBDATA,""))
+14 if LIEN=""
QUIT
+15 ;
+16 ; File the update along with inactivate the ACTION TYPE
+17 SET DR=".12////0"
+18 IF IBDATA="DG FEE SERVICE (OPT) NEW"
SET DR=DR_";.08////CC URGENT CARE;20////S IBDESC="_$CHAR(34)_"CC URGENT CARE"_$CHAR(34)
+19 SET DIE="^IBE(350.1,"
SET DA=LIEN
+20 DO ^DIE
+21 ;Clear update array before next use
KILL DR
End DoDot:1
+22 ;
+23 SET DR=""
+24 QUIT
+25 ;
IBDDAT ; Fee Service to inactivate
+1 ;;DG FEE SERVICE (OPT) CANCEL
+2 ;;DG FEE SERVICE (OPT) NEW
+3 ;;DG FEE SERVICE (OPT) UPDATE
+4 QUIT
