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

IBY517PO.m

Go to the documentation of this file. 
  1. IBY517PO ;ALB/FA - Post-Install for IB patch 517 ;03-JUN-2014
  1.  ;;2.0;INTEGRATED BILLING;**517**;21-MAR-94;Build 240
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1. EN ; Entry point
  1.  N IBXPD,IBPRD,XPDIDTOT
  1.  S XPDIDTOT=6
  1.  ;
  1.  ; Determine if we're in a TEST or a PRODUCTION environment.
  1.  S IBPRD=$S($$PROD^XUPROD(1)=1:"P",1:"T")
  1.  ;
  1.  ; Set the defaults for the new Health Care Services Review Section of the
  1.  ; Claims Tracking site parameters
  1.  D SETPARMS(1)
  1.  D SETFSC(2,IBPRD)
  1.  D SETNTJB(3,IBPRD)
  1.  D CLEARDUP(4)
  1.  D REINDEX(5)
  1.  D DISPROT(6)
  1.  D DONE
  1.  Q
  1.  ;
  1. SETPARMS(IBXPD) ; Set the defaults for the new Health Care Services
  1.  ; Review Section of the Claims Tracking site parameters
  1.  ; Input:   IBXPD       - Post-Installation step being performed
  1.  ;          XPDIDTOT    - Total Number of Post-Installation steps to perform
  1.  ; Output:  Health Care Services Review site parameter defaults are set
  1.  N IEN,SDATA
  1.  S IEN="1,"
  1.  D BMES^XPDUTL("STEP "_IBXPD_" of "_XPDIDTOT)
  1.  D MES^XPDUTL("-----------")
  1.  D MES^XPDUTL("  Sets HCS Review Site Parameter Defaults ... ")
  1.  ;
  1.  ; Set fields 62.01 - 62.08
  1.  S SDATA(350.9,IEN,62.13)=30        ; CPAC APPT FUTURE DAYS default
  1.  S SDATA(350.9,IEN,62.02)=30        ; CPAC ADM FUTURE DAYS default
  1.  S SDATA(350.9,IEN,62.03)=14        ; CPAC APPT PAST DAYS default
  1.  S SDATA(350.9,IEN,62.04)=14        ; CPAC ADM PAST DAYS default
  1.  S SDATA(350.9,IEN,62.05)=30        ; TRICARE APPT FUTURE DAYS default
  1.  S SDATA(350.9,IEN,62.06)=30        ; TRICARE ADM FUTURE DAYS default
  1.  S SDATA(350.9,IEN,62.07)=14        ; TRICARE APPT PAST DAYS default
  1.  S SDATA(350.9,IEN,62.08)=14        ; TRICARE ADM PAST DAYS default
  1.  S SDATA(350.9,IEN,62.09)=2555      ; PURGE DAYS Default
  1.  S SDATA(350.9,IEN,62.10)=0         ; INQUIRY TRIGGER APPT default
  1.  S SDATA(350.9,IEN,62.11)=0         ; INQUIRY TRIGGER ADM Default
  1.  S SDATA(350.9,IEN,62.12)=20        ; HSCR RESPONSE PURGE DAYS Default
  1.  D FILE^DIE(,"SDATA")
  1.  D MES^XPDUTL("  HCS default site parameters have been updated successfully.")
  1.  D MES^XPDUTL("STEP 1: Done.")
  1.  D MES^XPDUTL("")
  1.  Q
  1.  ;
  1. SETFSC(IBXPD,IBPRD) ; Stuff FSC domain into link.
  1.  ; Input:   IBXPD       - Post-Installation step being performed
  1.  ;          IBPRD       - "T"=Test Environment; "P"=Production Environment.
  1.  N DIC,X,Y,DIE,DR,DA,DLAYGO
  1.  D BMES^XPDUTL("STEP "_IBXPD_" of "_XPDIDTOT)
  1.  D MES^XPDUTL("-----------")
  1.  D MES^XPDUTL("  Stuff FSC domain into the link ... ")
  1.  ;
  1.  ;Stuff FSC domain into link
  1.  S DIC="^HLCS(870,",DLAYGO=870,DIC(0)="LS" S X="HCSR OUT" D ^DIC
  1.  ; For test environments, use the FSC test domain
  1.  I IBPRD="T",Y'=-1 S DIE=DIC,DA=+Y,DR=".08///ECOMMLLPTST.FSC.DOMAIN.EXT;400.02///54469;4.5///1" K DIC D ^DIE
  1.  ; For Production environments, use the FSC PRD domain
  1.  I IBPRD="P",Y'=-1 S DIE=DIC,DA=+Y,DR=".08///ECOMMLLPPRD.FSC.DOMAIN.EXT;400.02///9346;4.5///1" K DIC D ^DIE
  1.  ; Stuff FSC domain into table update link
  1.  S DIC="^HLCS(870,",DLAYGO=870,DIC(0)="LS" S X="IBTUPD OUT" D ^DIC
  1.  I Y'=-1 S DIE=DIC,DA=+Y,DR=".08///Revenue.FSC-EDI.X12CODESUPDATES.DOMAIN.EXT" K DIC D ^DIE
  1.  ;
  1.  D MES^XPDUTL("STEP 2: Done.")
  1.  D MES^XPDUTL("")
  1.  Q
  1.  ;
  1. SETNTJB(IBXPD,IBPRD) ; Schedule the HCSR Patient Events Search Criteria
  1.  ; as a Night Job using TaskMan.
  1.  ; Input:   IBXPD       - Post-Installation step being performed
  1.  ;          IBPRD       - "T"=Test Environment; "P"=Production Environment.
  1.  N DIC,DLAYGO,TSTAMP,X,Y
  1.  D BMES^XPDUTL("STEP "_IBXPD_" of "_XPDIDTOT)
  1.  D MES^XPDUTL("-----------")
  1.  D MES^XPDUTL("  Setting up IBT HCSR NIGHTLY PROCESS ... ")
  1.  I IBPRD'="P" D MES^XPDUTL("  Not a production account. No TaskMan job scheduled.") G SETNTJBX
  1.  ;
  1.  I $$FIND1^DIC(19.2,,"B","IBT HCSR NIGHTLY PROCESS","B") D MES^XPDUTL(" Already scheduled") G SETNTJBX  ; don't overwrite existing schedule
  1.  S (DLAYGO,DIC)=19.2,DIC(0)="L"
  1.  S X="IBT HCSR NIGHTLY PROCESS"
  1.  S TSTAMP=$$FMADD^XLFDT($$NOW^XLFDT(),1),$P(TSTAMP,".",2)="2100"
  1.  S DIC("DR")="2////"_TSTAMP_";6////D@9PM"
  1.  D ^DIC
  1.  D MES^XPDUTL("STEP 3: Done.")
  1.  D MES^XPDUTL("")
  1. SETNTJBX ;
  1.  Q
  1.  ;
  1. CLEARDUP(IBXPD) ; clear duplicate entries in dictionary files
  1.  N CODE,FILE,NEWDESC,NEWIEN,OLDIEN
  1.  N DA,DIE,DIK,DR,X,Y
  1.  D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
  1.  D MES^XPDUTL("-------------")
  1.  D MES^XPDUTL("Cleaning dictionary files ... ")
  1.  F FILE=365.013,365.015,365.016,365.017,365.021,365.022,365.025,365.027 D
  1.  .I '$D(^DIC(FILE)) Q
  1.  .S CODE="" F  S CODE=$O(^IBE(FILE,"B",CODE)) Q:CODE=""  D
  1.  ..S OLDIEN=$O(^IBE(FILE,"B",CODE,"")),NEWIEN=$O(^IBE(FILE,"B",CODE,""),-1)
  1.  ..I OLDIEN=NEWIEN Q  ; only one entry, no duplicates
  1.  ..; replace description in the old entry
  1.  ..S NEWDESC=$P($G(^IBE(FILE,NEWIEN,0)),U,2) I NEWDESC="" Q
  1.  ..S DIE=FILE,DA=OLDIEN,DR=".02///"_NEWDESC D ^DIE
  1.  ..; delete duplicate entry
  1.  ..S DA=NEWIEN,DIK="^IBE("_FILE_"," D ^DIK
  1.  ..Q
  1.  .Q
  1.  D MES^XPDUTL(" Done.")
  1.  D UPDATE^XPDID(IBXPD)
  1.  Q
  1.  ;
  1. REINDEX(IBXPD) ; Run new indices.  This is needed for entries at site not in file coming across.
  1.  N FILE,DIK,X,Y
  1.  D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
  1.  D MES^XPDUTL("-------------")
  1.  D MES^XPDUTL("Running new indices ... ")
  1.  F FILE=365.013,365.015,365.016,365.021,365.022,365.025 D
  1.  .S DIK="^IBE("_FILE_","
  1.  .S DIK(1)=".02^C"
  1.  .D ENALL^DIK
  1.  .Q
  1.  D MES^XPDUTL(" Done.")
  1.  D UPDATE^XPDID(IBXPD)
  1.  Q
  1.  ;
  1. DISPROT(IBXPD) ; disable action protocols IBT HCSR SEND 278 REQUEST and IBT HCSR COPY 278 REQUEST
  1.  N FDA,PRIEN,PRNAME
  1.  D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
  1.  D MES^XPDUTL("-------------")
  1.  D MES^XPDUTL("Disabling out-of-order actions ... ")
  1.  F PRNAME="IBT HCSR SEND 278 REQUEST","IBT HCSR COPY 278 REQUEST","IBT HCSR RESPONSE EE SEND278" D
  1.  .S PRIEN=+$$FIND1^DIC(101,,"X",PRNAME,"B")
  1.  .I PRIEN S FDA(101,PRIEN_",",2)="This action is not currently available."
  1.  .Q
  1.  I $D(FDA) D FILE^DIE("E","FDA")
  1.  D MES^XPDUTL(" Done.")
  1.  D UPDATE^XPDID(IBXPD)
  1.  Q
  1.  ;
  1. DONE ; Displays the 'Done' message and finishes the progress bar
  1.  D MES^XPDUTL("")
  1.  D MES^XPDUTL("POST-Install Completed.")
  1.  Q
  1.  ;