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

IBY696PO.m

Go to the documentation of this file.
  1. IBY696PO ;EDE/WCJ - POST-INSTALL FOR IB*2.0*696 ;07-FEB-2021
  1. ;;2.0;INTEGRATED BILLING;**696**;21-MAR-94;Build 3
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; IA# 10141 - MES^XPDUTL
  1. ;
  1. EN ;Entry Point
  1. N IBA
  1. S IBA(2)="IB*2*696 Post-Install...",(IBA(1),IBA(3))=" "
  1. D MES^XPDUTL(.IBA) K IBA
  1. ;
  1. N IBSITE,IBFAC
  1. D SITE^IBAUTL
  1. ;
  1. ;If site doing the billing is not the main site
  1. I $$STA^XUAF4(IBFAC)'=IBSITE D ZERO($$IEN^XUAF4(IBSITE)) ; fix the zero problem
  1. ;
  1. N SITEINFO
  1. S SITEINFO=$$SITE^VASITE ; returns pointer^name^external
  1. ;
  1. ;If IEN to file 4 is not the same as site number.
  1. I +SITEINFO'=+$P(SITEINFO,U,3) D FIXIT(SITEINFO)
  1. ;
  1. S IBA(2)="IB*2*696 Post-Install Complete.",(IBA(1),IBA(3))=" "
  1. D MES^XPDUTL(.IBA) K IBA
  1. Q
  1. ;
  1. ZERO(IENF4) ;
  1. ; IENF4 - IEN file 4
  1. N IBUCIEN
  1. S IBUCIEN=0 F S IBUCIEN=$O(^IBUC(351.82,IBUCIEN)) Q:'+IBUCIEN D
  1. . N ZNODE
  1. . S ZNODE=$G(^IBUC(351.82,IBUCIEN,0))
  1. . Q:$P(ZNODE,U,2)'=0 ; quit if this not the site=0 problem
  1. . ; update site (#.02) and set the UPDATED flag and get out. Let the daily push to the rest.
  1. . D UPDATE(IBUCIEN,".02////"_IENF4_";")
  1. .Q
  1. Q
  1. ;
  1. FIXIT(SITE) ;
  1. ; SITE - IEN File 4^Site Name^Station #
  1. N IBUCIEN
  1. S IBUCIEN=0 F S IBUCIEN=$O(^IBUC(351.82,IBUCIEN)) Q:'+IBUCIEN D
  1. . N ZNODE
  1. . S ZNODE=$G(^IBUC(351.82,IBUCIEN,0))
  1. . Q:$P(ZNODE,U,2)'=+SITE ; quit if this is not the originating site
  1. . ; set the UPDATED flag and get out. Let the daily push to the rest.
  1. . D UPDATE(IBUCIEN,"")
  1. .Q
  1. Q
  1. ;
  1. UPDATE(IBUCIEN,INDR) ;update UPDATED field
  1. ; IBUCIEN - File 351.82 ien
  1. ; INDR - Incoming DR String
  1. N DIE,DA,DR,D0,DIC
  1. S DIE="^IBUC(351.82,"
  1. S DA=IBUCIEN,DR=INDR_"1.01////1"
  1. D ^DIE
  1. Q