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

BAREV181.m

Go to the documentation of this file. 
  1. BAREV181 ; IHS/SD/LSL - ENVIRONMENT CHECK V1.8 PATCH 2 NPI;
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**1**;MAR 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.  ;I $$VCHK("XU","8.0",2)              ; Kernel V8.0
  1.  N BARXU
  1.  ;S BARXU=$$INSTALLD("XU")               ;RLT     ; Find current Kernel version and patch
  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.  ;I $P(BARXU,"*",2)>7,$P(BARXU,"*",2)<9,$P(BARXU,"*",3)<1010 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")               ;RLT    ; Find current IHS utilities version and patch
  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.  ;I $P(BARXB,"*",2)>2,$P(BARXB,"*",2)<4,$P(BARXB,"*",3)<10 S BARXB=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 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.  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","BAREV181")
  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. 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.  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=3070430"
  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. PRE ;EP -
  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.  ; ********************************************************************
  1. INTROE ; Intro text during KIDS Environment check.
  1.  ;;This distribution Modifies Accounts Receivable containing previous patch
  1.  ;;modifications and:
  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.  ;;###