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