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

IBY595PO.m

Go to the documentation of this file.
  1. IBY595PO ;EDE/DM - Post-Installation for IB patch 595 ; 01-APR-2018
  1. ;;2.0;INTEGRATED BILLING;**595**;21-MAR-94;Build 29
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. POST ; POST ROUTINE(S)
  1. N IBXPD,XPDIDTOT
  1. S XPDIDTOT=2
  1. ;
  1. ; Add new Source of Information
  1. D ADDSOI(1)
  1. ;
  1. ; Make sure the "AUTOUPDATE,IBEIV" PERSON exists
  1. D CHKAU(2)
  1. ;
  1. D MES^XPDUTL("")
  1. D MES^XPDUTL("POST-Install Completed.")
  1. Q
  1. ;
  1. ADDSOI(IBXPD) ; Add new Source of Information.
  1. N IBLN,IBPCE,IBDATA,IBERR,IBIEN,IBSTR
  1. D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
  1. D MES^XPDUTL("-------------")
  1. D MES^XPDUTL("Adding new Source of Information Codes ... ")
  1. F IBLN=2:1 S IBSTR=$P($T(EN35512+IBLN),";;",2) Q:IBSTR="" D
  1. . F IBPCE=1:1:3 S IBDATA(IBPCE/100)=$P(IBSTR,U,IBPCE)
  1. . I $D(^IBE(355.12,"C",IBDATA(.02))) D Q
  1. .. D MES^XPDUTL(" "_IBDATA(.02)_" ALEADY EXISTS IN THE SOURCE OF INFORMATION TABLE (#355.12)") Q
  1. . S IBIEN=$$ADD^IBDFDBS(355.12,,.IBDATA,.IBERR)
  1. . I IBERR D Q
  1. .. D BMES^XPDUTL("*** ERROR ADDING "_IBDATA(.02)_" CODE TO THE SOURCE OF INFORMATION TABLE (#355.12) ***")
  1. . D BMES^XPDUTL(" "_$$GET1^DIQ(355.12,IBIEN_",",.02)_" CODE ADDED TO THE SOURCE OF INFORMATION TABLE (#355.12)")
  1. D MES^XPDUTL("STEP "_IBXPD_" of "_XPDIDTOT_" COMPLETE")
  1. Q
  1. ;
  1. CHKAU(IBXPD) ; Make sure the "AUTOUPDATE,IBEIV" PERSON exists in #200
  1. N IEN200,IBAUNAME
  1. S IBAUNAME="AUTOUPDATE,IBEIV"
  1. D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
  1. D MES^XPDUTL("-------------")
  1. D MES^XPDUTL("Checking for "_IBAUNAME_" in the New Person file (#200) ... ")
  1. ; Supported by IA#4677.
  1. S IEN200=$$CREATE^XUSAP(IBAUNAME,"")
  1. I +IEN200=0 D MES^XPDUTL(" "_IBAUNAME_" exists.")
  1. I +IEN200>0 D MES^XPDUTL(" "_IBAUNAME_" added.")
  1. I IEN200<0 D MES^XPDUTL("*(ERROR) "_IBAUNAME_" NOT added.")
  1. D MES^XPDUTL("STEP "_IBXPD_" of "_XPDIDTOT_" COMPLETE")
  1. Q
  1. ;
  1. EN35512 ; Add Source of Information Codes
  1. ;
  1. ;;20^MYVA HEALTH JOURNAL^MVAH