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

BAREV183.m

Go to the documentation of this file. 
  1. BAREV183 ; IHS/SD/LSL - ENVIRONMENT CHECK V1.8 PATCH 2 UFMS SESSION LOGGING;
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**1,2,3**;APR 27,2007
  1.  ;
  1.  ;IHS/SD/RLT - 04/05/05
  1.  ;             Modified routine to use PATCH^XPDUTL in the INSTALLD tag
  1.  ;
  1.  I '$G(DUZ) D  Q
  1.  . W !,"DUZ UNDEFINED OR 0."
  1.  . D SORRY(2)
  1.  ;
  1.  I '$L($G(DUZ(0))) D  Q
  1.  . W !,"DUZ(0) UNDEFINED OR NULL."
  1.  . D SORRY(2)
  1.  ;
  1.  S X=$P(^VA(200,DUZ,0),U)            ; User's name
  1.  W !!,$$CJ^XLFSTR("Hello, "_$P(X,",",2)_" "_$P(X,","),IOM)
  1.  W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_" V "_$P($T(+2),";",3),IOM)
  1.  ;
  1.  N BARXU
  1.  S BARXU=$$INSTALLD("XU","8.0",1011)     ;RLT     ; Find current Kernel version and patch
  1.  I $P(BARXU,"*",2)<8 S BARXU=0
  1.  I $P(BARXU,"*",3)'=1 S BARXU=0        ;RLT
  1.  W !,$$CJ^XLFSTR("Need at least XU v8.0 Patch 1011..... "_$S(BARXU=0:"NOT ",1:"")_"Present",IOM)
  1.  I BARXU=0 D SORRY(2)
  1.  ;
  1.  I $$VCHK("DI","21.0",2)             ; FileMan V21.0
  1.  ;
  1.  N BARXB
  1.  S BARXB=$$INSTALLD("XB","3.0",11)       ;RLT    ; Find current IHS utilities version and patch
  1.  I $P(BARXB,"*",2)<3 S BARXB=0
  1.  I $P(BARXU,"*",3)'=1 S BARXU=0        ;RLT
  1.  W !,$$CJ^XLFSTR("Need at least XB v3.0 Patch 11..... "_$S(BARXB=0:"NOT ",1:"")_"Present",IOM)
  1.  I BARXB=0 D SORRY(2)
  1.  ;
  1.  I $$VCHK("BAR","1.8",2)             ; Accounts Receivable V1.8
  1.  ;
  1.  ; At least Third Party Billing V2.5 Patch 1 by looking for routine ABMUTLP in routine file
  1.  ;N BARABM
  1.  ;S BARABM=$$VERSION^XPDUTL("ABM")
  1.  ;I BARABM'>2.5 S BARABM=$D(^DIC(9.8,"B","ABMUTLP"))
  1.  ;W !,$$CJ^XLFSTR("Need at least ABM v2.5 Patch 1..... "_$S(BARABM=0:"NOT ",1:"")_" Present",IOM)
  1.  ;I BARABM=0 D SORRY(2)
  1.  ;
  1.  N BARABM
  1.  S BARABM=$$INSTALLD("ABM","2.5",12)
  1.  I $P(BARABM,"*",2)<2.5 S BARABM=0
  1.  I $P(BARABM,"*",3)'=1 S BARABM=0
  1.  W !,$$CJ^XLFSTR("Need at least Third Party Billing v2.5 Patch 12..... "_$S(BARABM=0:"NOT ",1:"")_"Present",IOM)
  1.  I BARABM=0 D SORRY(2)
  1.  ;
  1.  ;
  1.  N DA,DIC
  1.  S X="BAR"
  1.  S DIC="^DIC(9.4,"
  1.  S DIC(0)=""
  1.  S D="C"
  1.  D IX^DIC
  1.  I Y<0,$D(^DIC(9.4,"C","BAR")) D
  1.  . W !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM)
  1.  . W !,$$CJ^XLFSTR("PACKAGE File with an ""BAR"" prefix.",IOM)
  1.  . W !,$$CJ^XLFSTR("One entry needs to be deleted.",IOM)
  1.  . D SORRY(2)
  1.  . Q
  1.  ;
  1.  ;LETS DOUBLE CHECK - MAKE SURE THEY SAVE THE GLOBALS OFF
  1.  I '$G(XPDQUIT) D
  1.  .W !!!,$$CJ^XLFSTR("IMPORTANT: PLEASE MAKE SURE YOU SAVE THE FOLLOWING GLOBALS TO DISK?",IOM)
  1.  .W !,$$CJ^XLFSTR("USE ^%GOGEN TO SAVE ^BAR(90052.01",IOM)
  1.  .W !,$$CJ^XLFSTR("USE ^%GO TO SAVE ^BARTBL",IOM)
  1.  ;
  1.  I $G(XPDQUIT) W !,$$CJ^XLFSTR("FIX IT! Before Proceeding.",IOM),!!,*7,*7,*7 Q
  1.  ;
  1.  W !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
  1.  D HELP^XBHELP("INTROE","BAREV182")
  1.  ;
  1.  I $G(XPDENV)=1 D
  1.  . ; The following line prevents the "Disable Options..." and "Move
  1.  . ; Routines..." questions from being asked during the install.
  1.  . S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
  1.  . D HELP^XBHELP("INTROI","BAREV181")
  1.  . Q
  1.  ;
  1.  I '$$DIR^XBDIR("E","","","","","",1) D SORRY(2)
  1.  Q
  1.  ; ********************************************************************
  1. SORRY(X) ;
  1.  KILL DIFQ
  1.  S XPDQUIT=X
  1.  W *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
  1.  Q
  1.  ; ********************************************************************
  1. VCHK(BARPRE,BARVER,BARQUIT)     ; Check versions needed.
  1.  ;
  1.  N BARV
  1.  S BARV=$$VERSION^XPDUTL(BARPRE)
  1.  W !,$$CJ^XLFSTR("Need at least "_BARPRE_" v "_BARVER_"....."_BARPRE_" v "_BARV_" Present",IOM)
  1.  I BARV<BARVER KILL DIFQ S XPDQUIT=BARQUIT D SORRY(BARQUIT) Q 0
  1.  Q 1
  1.  ; ********************************************************************
  1. INSTALLD(BARNM,BARVR,BARPT) ;EP    ;RLT
  1.  ; RLT - 04/05/05 - Per Don Jackson, modified this tag to use
  1.  ;                  PATCH^XPDUTL.  Removed the reverse $O, problem
  1.  ;                  with XU patch numbers. VA (lower than 1000) and
  1.  ;                  IHS patch numers (1000 and higher) not loaded
  1.  ;                  in numerical order.  No longer
  1.  ;                  verifies that a lower version did not get
  1.  ;                  reinstalled over a higher version.
  1.  N BARVNUM,BARPATCH
  1.  ;1 get current version
  1.  S BARVNUM=$$VERSION^XPDUTL(BARNM)
  1.  I '+BARVNUM Q 0
  1.  ;2 is needed patch loaded
  1.  S BARPATCH=$$PATCH^XPDUTL(BARNM_"*"_BARVR_"*"_BARPT)
  1.  I '+BARPATCH Q 0
  1.  Q BARNM_"*"_BARVNUM_"*"_BARPATCH
  1.  ;
  1. POST ;EP - POST INSTALL OF ZISH ENTRIES AND QUEING OF BIZTALK TASK
  1.  D STUFFDCM       ;Stuff too long target id into
  1.  D FIXADJ3        ;FIX A/R EDI STND CLAIM ADJ REASONS STANDARD ADJUSTMENT CODE 3
  1.  ;                BAD ENTRY IN FIELD .03 (14;17) IM21683,IM23712
  1.  D AWODT          ;CHANGE THE AWO EXPIRATION DATE
  1.  D ADWO            ;ADD NEW WRITE OFF ENTRY IN BARTBL AT 916 SO IT DOESNOT GET OVERWRITTEN BY
  1.  ;                  NEW ENTRIES IN PATCH 2
  1.  D EDIHIPAA       ;EDIT "HIPAA 835 v4010" ENTRY IN A/R EDI TRANSPORT FILE
  1.  ;
  1.  ;set default value for field #22 in A/R COLLECTION POINT file
  1.  D COLPOINT
  1.  ;
  1.  D ADDZISH         ;ADD ZISH SEND PARAMETER ENTRIES FOR UFMS
  1.  ;
  1.  D ADDDIS          ;ADD DEFAULT (#1504) UFMS DISPLAY DATE LIMIT
  1.  ;
  1.  Q
  1. ADDDIS ;EP - 
  1.  K DIE,DR,DIC,DIE,DIR,DA
  1.  S DR="1504////^S X=""T-1W"";1505////30"""
  1.  S DUZ2=1
  1.  F  S DUZ2=$O(^BAR(90052.06,DUZ2)) Q:'DUZ2  D
  1.  .S DA(1)=DUZ2
  1.  .S DA=0
  1.  .F  S DA=$O(^BAR(90052.06,DUZ2,DA)) Q:'DA  D
  1.  ..I '$$IHS^BARUFUT(DA) S DR=DR_";1502////1;1503////1"  ;FOR NON-IHS SITES
  1.  ..S DIE="^BAR(90052.06,"_DA(1)_","
  1.  ..D ^DIE
  1.  Q
  1. COLPOINT ;EP -
  1.  K DIE,DR,DIC,DIE,DIR,DA
  1.  S DR="22////^S X=1"
  1.  S DUZ2=1
  1.  F  S DUZ2=$O(^BAR(90051.02,DUZ2)) Q:'DUZ2  D
  1.  .S DA(1)=DUZ2
  1.  .S DA=0
  1.  .F  S DA=$O(^BAR(90051.02,DUZ2,DA)) Q:'DA  D
  1.  ..S DIE="^BAR(90051.02,"_DA(1)_","
  1.  ..D ^DIE
  1.  Q
  1. ADWO ; EP
  1.  N ADWO
  1.  S ADWO="^BARTBL(916,0)"
  1.  S @ADWO="AUTO WRITE-OFF 2007^3^WO"
  1.  S DIK="^BARTBL(" D IXALL^DIK
  1.  Q
  1. AWODT ;EP -
  1.  K DIR,DIE,DIC,DA,DR
  1.  S DR="15////^S X=3070525"
  1.  S DUZ2=1
  1.  F  S DUZ2=$O(^BAR(90052.06,DUZ2)) Q:'DUZ2  D
  1.  .S DIE="^BAR(90052.06,"_DUZ2_","
  1.  .S DA=DUZ2
  1.  .D ^DIE
  1.  Q
  1. EDIHIPAA ;EP - EDIT HIPAA TRANSPORT ENTRY
  1.  N TRANIEN
  1.  S TRANIEN=$O(^BAREDI("1T","B","HIPAA 835 v4010",""))
  1.  I 'TRANIEN D  Q
  1.  .W !,$$CJ^XLFSTR("CANNOT FIND HIPAA 835 v4010 ENTRY!!",IOM)
  1.  .W !,$$CJ^XLFSTR("INFORM THE HELP DESK IMMEDIATELY!!",IOM)
  1.  ;BEGIN UPDATING FIELDS
  1.  ;
  1.  ;EDIT SEGMENT 2-080.B-N1
  1.  ;IDENTIFICATION CODE QUALIFIER
  1.  K DIE,DIC,DA,DR,DIR
  1.  S DA(2)=TRANIEN
  1.  S DA(1)=15
  1.  S DA=3
  1.  S DIE="^BAREDI(""1T"","_DA(2)_",10,"_DA(1)_",10,"
  1.  S BARVAL="VICQ"
  1.  S DR=".08///^S X=BARVAL"
  1.  D ^DIE
  1.  ;
  1.  ;IDENTIFICATION CODE
  1.  K DIE,DIC,DA,DR,DIR
  1.  S DA(2)=TRANIEN
  1.  S DA(1)=15
  1.  S DA=4
  1.  S DIE="^BAREDI(""1T"","_DA(2)_",10,"_DA(1)_",10,"
  1.  S BARVAL="VIC"
  1.  S DR=".08///^S X=BARVAL"
  1.  D ^DIE
  1.  ;
  1.  ;REFERENCE ID QUALIFIER
  1.  K DIE,DIC,DA,DR,DIR
  1.  S DA(2)=TRANIEN
  1.  S DA(1)=18
  1.  S DA=1
  1.  S DIE="^BAREDI(""1T"","_DA(2)_",10,"_DA(1)_",10,"
  1.  S BARVAL="VREFBIQ"
  1.  S DR=".08///^S X=BARVAL"
  1.  D ^DIE
  1.  ;
  1.  ;REFERENCE IDENTIFICATION
  1.  K DIE,DIC,DA,DR,DIR
  1.  S DA(2)=TRANIEN
  1.  S DA(1)=18
  1.  S DA=2
  1.  S DIE="^BAREDI(""1T"","_DA(2)_",10,"_DA(1)_",10,"
  1.  S BARVAL="VREFBID"
  1.  S DR=".08///^S X=BARVAL"
  1.  D ^DIE
  1.  ;
  1.  ;VARIABLE PROCESSING
  1.  K DIE,DIC,DA,DR,DIR
  1.  S X="VREFBIQ"
  1.  S DA(1)=TRANIEN
  1.  S DIC(0)="L"
  1.  S DIC="^BAREDI(""1T"","_DA(1)_",70,"
  1.  D ^DIC
  1.  I +Y>0 D
  1.  .K DIE,DIC,DA,DR,DIR
  1.  .S DA=+Y
  1.  .S DA(1)=TRANIEN
  1.  .S DIE="^BAREDI(""1T"","_DA(1)_",70,"
  1.  .S BARVAL="VREFB|BAREDPA1"
  1.  .S DR=".02///^S X=BARVAL"
  1.  .D ^DIE
  1.  ;
  1.  K DIE,DIC,DA,DR,DIR
  1.  S X="VREFBID"
  1.  S DA(1)=TRANIEN
  1.  S DIC(0)="L"
  1.  S DIC="^BAREDI(""1T"","_DA(1)_",70,"
  1.  D ^DIC
  1.  I +Y>0 D
  1.  .K DIE,DIC,DA,DR,DIR
  1.  .S DA=+Y
  1.  .S DA(1)=TRANIEN
  1.  .S DIE="^BAREDI(""1T"","_DA(1)_",70,"
  1.  .S BARVAL="VREFB|BAREDPA1"
  1.  .S DR=".02///^S X=BARVAL"
  1.  .D ^DIE
  1.  ;
  1.  K DIE,DIC,DA,DR,DIR
  1.  S X="VIC"
  1.  S DA(1)=TRANIEN
  1.  S DIC(0)="L"
  1.  S DIC="^BAREDI(""1T"","_DA(1)_",70,"
  1.  D ^DIC
  1.  I +Y>0 D
  1.  .K DIE,DIC,DA,DR,DIR
  1.  .S DA=+Y
  1.  .S DA(1)=TRANIEN
  1.  .S DIE="^BAREDI(""1T"","_DA(1)_",70,"
  1.  .S BARVAL="VIC|BAREDPA1"
  1.  .S DR=".02///^S X=BARVAL"
  1.  .D ^DIE
  1.  Q
  1.  ;
  1. PRE ;EP - PRE INSTALL - DELETE OLD DATA IN TABLES
  1.  W !,"DELETING OLD TABLE DATA.."
  1.  S IEN=0 F  S IEN=$O(^BARTBL(IEN)) Q:IEN=""!(IEN>999)  W "." K ^BARTBL(IEN)
  1.  Q
  1. FIXADJ3 ;EP
  1.  Q:$$GET1^DIQ(90056.06,"3,",.03,"I")'="14;17"
  1.  K DIE,DIR,DR,DA,DIC
  1.  S DIE="^BARADJ("
  1.  S DA=3
  1.  S DR=".03///14;.04///27"
  1.  D ^DIE
  1.  Q
  1. STUFFDCM ;
  1.  D BMES^XPDUTL("Updating Debt Collection Target ID in ZISH SEND PARAMETERS file....")
  1.  K DIC,DIE,DA,DR,DIR
  1.  S TARGETID="asdstgw.d1.na.DOMAIN.NAME"
  1.  F X="BAR DCM B","BAR DCM F" D
  1.  .S DIC="^%ZIB(9888888.93,"
  1.  .S DIC(0)=""
  1.  .D ^DIC
  1.  .Q:Y<0
  1.  .S DIE=DIC
  1.  .K DIC,DA,DR,DIR
  1.  .S DA=+Y
  1.  .S DR=".02////"_TARGETID
  1.  .D ^DIE
  1.  Q
  1. ADDZISH ;EP - ADD ZISH ENTIRES TO 'ZISH SEND PARAMETERS' FILE
  1.  ;ADD 'BAR UFMS B' BACKGROUND ENTRY
  1.  ;ADD 'BAR UFMS F' FOREGROUND ENTRY
  1. ADDF ;ADD FOREGROUND
  1.  I $D(^%ZIB(9888888.93,"B","BAR UFMS F")) D
  1.  .D BMES^XPDUTL("Found [BAR UFMS F] as a ZISH SEND PARAMETER entry")
  1.  D BMES^XPDUTL("Adding [BAR UFMS F] as a ZISH SEND PARAMETER entry")
  1.  K DIC,DIE,DA,DR,DIR
  1.  S DIC="^%ZIB(9888888.93,"
  1.  S DIC(0)="L"
  1.  S X="BAR UFMS F"
  1.  D ^DIC
  1.  I +Y<0 W !,"UNABLE TO ADD ZISH PARAMETER ENTRY. TRY MANUALLY!!" Q
  1.  K DIC,DIE,DA,DR,DIR,DD,DO,DINUM
  1.  S DIE="^%ZIB(9888888.93,"
  1.  S DA=+Y
  1.  S USERNAME="ufmsuser"
  1.  S PASSWORD="vjrsshn9"
  1.  S SENDCMD="sendto"
  1.  S TYPE="F"
  1.  S TARGETIP="quovadx-ie.DOMAIN.NAME"
  1.  S ARGS="-i -u -a"
  1.  S DR=".02///^S X=TARGETIP"
  1.  S DR=DR_";.03///^S X=USERNAME"
  1.  S DR=DR_";.04////^S X=PASSWORD"
  1.  S DR=DR_";.06///^S X=ARGS"
  1.  S DR=DR_";.07///^S X=TYPE"
  1.  S DR=DR_";.08///^S X=SENDCMD"
  1.  D ^DIE
  1.  K DIC,DIE,DA,DR,DIR
  1. ADDB ;ADD BACKGROUND
  1.  I $D(^%ZIB(9888888.93,"B","BAR UFMS B")) D
  1.  .D BMES^XPDUTL("Found [BAR UFMS B] as a ZISH SEND PARAMETER entry")
  1.  D BMES^XPDUTL("Adding [BAR UFMS B] as a ZISH SEND PARAMETER entry")
  1.  K DIC,DIE,DA,DR,DIR
  1.  S DIC="^%ZIB(9888888.93,"
  1.  S DIC(0)="L"
  1.  S X="BAR UFMS B"
  1.  D ^DIC
  1.  I +Y<0 D BMES^XPDUTL("UNABLE TO ADD ZISH PARAMETER ENTRY. TRY MANUALLY!!")
  1.  K DIC,DIE,DA,DR,DIR,DD,DO,DINUM
  1.  S DIE="^%ZIB(9888888.93,"
  1.  S DA=+Y
  1.  S USERNAME="ufmsuser"
  1.  S PASSWORD="vjrsshn9"
  1.  S SENDCMD="sendto"
  1.  S TYPE="B"
  1.  S TARGETIP="quovadx-ie.DOMAIN.NAME"
  1.  S ARGS="-i -u -a"
  1.  S DR=".02///^S X=TARGETIP"
  1.  S DR=DR_";.03///^S X=USERNAME"
  1.  S DR=DR_";.04////^S X=PASSWORD"
  1.  S DR=DR_";.06///^S X=ARGS"
  1.  S DR=DR_";.07///^S X=TYPE"
  1.  S DR=DR_";.08///^S X=SENDCMD"
  1.  D ^DIE
  1.  K DIC,DIE,DA,DR,DIR
  1.  Q
  1.  ; ********************************************************************
  1. INTROE ; Intro text during KIDS Environment check.
  1.  ;;This distribution Modifies Accounts Receivable containing previous patch
  1.  ;;modifications fpr veriosn 1.8. This patch is cumulative.
  1.  ;;
  1.  ;;###
  1.  ;;
  1.  ;
  1. INTROI ; Intro text during KIDS Install.
  1.  ;;If you run interactively, results will be displayed on your screen,
  1.  ;;and recorded in the entry in the INSTALL file.
  1.  ;;If you queue to TaskMan, remember not to Q to the HOME device.
  1.  ;;###