Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBY764PO

IBY764PO.m

Go to the documentation of this file.
  1. IBY764PO ;SAB/EDE - IB*2.0*764 POST INSTALL;03/31/22 12:35pm
  1. ;;2.0;Integrated Billing;**764**;Mar 20, 1995;Build 2
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. Q
  1. ;
  1. EN ;Post Install for IB*2.0*764
  1. D BMES^XPDUTL(" >> Starting the Post-Initialization routine for IB*2.0*764")
  1. D NEWCREAS
  1. D BMES^XPDUTL(" >> End of the Post-Initialization routine for IB*2.0*764")
  1. Q
  1. ;
  1. NEWCREAS ; New Cancellation Reasons
  1. N LOOP,LIEN,IBDATA,IBCNNM
  1. N X,Y,DIE,DA,DR,DTOUT,DATA,IBDATAB,DIK
  1. ;
  1. N CANIEN,UPDIEN,SVCIEN,CHGIEN
  1. ;
  1. ; Grab all of the entries to update
  1. D MES^XPDUTL(" -> Adding new Cancellation Reason to the IB CHARGE REMOVE REASON file (350.3).")
  1. S Y=-1
  1. F LOOP=1:1 S IBDATA=$T(REASDAT+LOOP) Q:$P(IBDATA,";",3)="END" D
  1. . S DR=""
  1. . ;Extract the new ACTION TYPE to be added.
  1. . ;Store in array for adding to the file (#350.1).
  1. . Q:IBDATA="" ;go to next entry if Category is not to be updated.
  1. . ;
  1. . S IBCNNM=$P(IBDATA,";",3)
  1. . S LIEN=$O(^IBE(350.3,"B",IBCNNM,""))
  1. . ; File the update along with inactivate the ACTION TYPE
  1. . S DLAYGO=350.3,DIC="^IBE(350.3,",DIC(0)="L",X=IBCNNM
  1. . I '+LIEN D FILE^DICN S LIEN=+Y K DIC,DINUM,DLAYGO
  1. . S DR=".02////"_$P(IBDATA,";",4) ; ABBREVIATION
  1. . S DR=DR_";.03////"_$P(IBDATA,";",5) ; LIMIT
  1. . S DR=DR_";.04///"_$P(IBDATA,";",6) ; Can Cancel UC
  1. . S DR=DR_";.05///"_$P(IBDATA,";",7) ; Can Cancel UC
  1. . ;Not needed for this round of Cancellation Reason Creations.
  1. . ;S DR=DR_";.05////"_$P(IBDATA,";",7) ; UC Visit Processing
  1. . ;
  1. . S DIE="^IBE(350.3,",DA=LIEN
  1. . D ^DIE
  1. . K DR
  1. Q
  1. ;
  1. REASDAT ; Cleland Dole
  1. ;;CLELAND-DOLE;C-D;3;Y;2
  1. ;;END
  1. Q
  1. ;