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

ACDENVCK.m

Go to the documentation of this file. 
  1. ACDENVCK ;IHS/ADC/EDE/KML - ENVIRONMENT CHECK ROUTINE FOR V4.1; 
  1.  ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
  1.  ;
  1. START ;
  1.  ;   kill off gbl left by v4.0 post-init
  1.  K ^ACDTEMP ;  kills temp global  SAC EXEMPTION (2.3.2.3 killing of unsubscripted globals is prohibited)
  1.  D ^XBKVAR
  1.  S ACDQ=0
  1.  W !!,"Beginning ENVIRONMENTAL CHECK routine."
  1.  D DUZ ;                                   check DUZ values
  1.  I ACDQ D STOP,EOJ Q  ;                    quit if not good DUZ values
  1.  D VIRGIN ;                                check for virgin install
  1.  I ACDQ D EOJ Q  ;                         quit if virgin install
  1.  D FILE200 ;                               check file 6/200
  1.  I ACDQ D STOP,EOJ Q  ;                    quit if 6/200 cnv bad
  1.  D VERSION ;                               check current version
  1.  I ACDQ D STOP,EOJ Q  ;                    quit if not v4.0/v4.1
  1.  D SERVICE ;                               check for OTH service
  1.  I ACDQ D STOP,EOJ Q  ;                    quit if no OTH
  1.  D LOCATION ;                              check for SCHOOL
  1.  I ACDQ D STOP,EOJ Q  ;                    quit if no SCHOOL
  1.  D COMPONEN ;                              check for DROP IN CENTER
  1.  I ACDQ D STOP,EOJ Q  ;                    quit if no DROP IN CENTER
  1.  D PCCCHK ;                                check for PCC link
  1.  W !!,"This initialization will delete all data from your CDMIS PROGRAM"
  1.  W !,"file except the site name.  If you have data in that file that you"
  1.  W !,"don't want to lose do not continue with this install."
  1.  W !
  1.  S DIR(0)="Y",DIR("A")="Do you want to continue with this install",DIR("B")="Y" K DA D ^DIR K DIR
  1.  I 'Y D STOP,EOJ Q
  1.  D EOJ
  1.  Q
  1.  ;
  1. DUZ ; GET CORRECT DUZ VALUES
  1.  S ACDQ=1
  1.  I '$G(DUZ) D
  1.  . W !!,"DUZ is not set.  I am going to do ^XUP.  You must enter your ACCESS Code but"
  1.  . W !,"just press RETURN to the Select OPTION NAME: prompt.",!
  1.  . D XUP
  1.  . Q
  1.  I '$G(DUZ) W !,"DUZ is still not set." Q
  1.  I $G(DUZ(0))'["@" W !!,"You must have programmer access to run this install.",! Q
  1.  S ACDQ=0
  1.  Q
  1.  ;
  1. XUP ; DO ^XUP
  1.  NEW ACDQ,DIFQ
  1.  D ^XUP
  1.  Q
  1.  ;
  1. VIRGIN ; CHECK FOR VIRGIN INSTALL
  1.  S ACDQ=1
  1.  K ^TMP("ACD",$J)
  1.  S ^TMP("ACD",$J,"VIRGIN INSTALL")=""
  1.  S Y=$O(^DIC(9.4,"C","ACD",0))
  1.  I 'Y W !,"VIRGIN install.  No further checking necessary." Q
  1.  K ^TMP("ACD",$J,"VIRGIN INSTALL")
  1.  S ACDQ=0
  1.  Q
  1.  ;
  1. VERSION ; CHECK FOR VERSION 4.0
  1.  S Y=$O(^DIC(9.4,"C","ACD",0))
  1.  Q:'Y  ;                            no package entry to check
  1.  S ACDQ=1
  1.  S ACDVER=^DIC(9.4,Y,"VERSION")
  1.  I +ACDVER=4.1 D  Q
  1.  . W !
  1.  . S DIR(0)="Y",DIR("A")="You already have version 4.1.  Do you want to run this install again",DIR("B")="N" K DA D ^DIR K DIR
  1.  . I Y S ACDQ=0 Q
  1.  . W !!,"Terminating install.",!
  1.  . Q
  1.  I ACDVER<4 D  Q
  1.  . W !!,"The current version is ",ACDVER
  1.  . W !,"You must install version 4.0 before you upgrade to version 4.1"
  1.  . W !!,"Terminating install.",!
  1.  . Q
  1.  I ACDVER'="4.0" D  Q
  1.  . W !!,"The current version is ",ACDVER
  1.  . W !,"You must install version 4.0 before you upgrade to version 4.1"
  1.  . S DIR(0)="Y",DIR("A")="Do you want to run this install",DIR("B")="N" K DA D ^DIR K DIR
  1.  . I Y S ACDQ=0 Q
  1.  . W !!,"Terminating install.",!
  1.  . Q
  1.  S ACDQ=0
  1.  Q
  1.  ;
  1. SERVICE ; check for OTH service
  1.  S ACDQ=1
  1.  S Y=$O(^ACDSERV("C","OTH",0))
  1.  I 'Y W !!,"There is no 'OTH' entry in your CDMIS SERVICE file." Q
  1.  S ACDQ=0
  1.  Q
  1.  ;
  1. LOCATION ; check for SCHOOL location
  1.  S ACDQ=1
  1.  S Y=$O(^ACDLOT("C",1,0))
  1.  I 'Y W !!,"There is no 'SCHOOL' entry in your CDMIS LOCATION file." Q
  1.  S ACDQ=0
  1.  Q
  1.  ;
  1. COMPONEN ; check for DROP IN CENTER component
  1.  S ACDQ=1
  1.  S Y=$O(^ACDCOMP("B","DROP IN CENTER",0))
  1.  I 'Y W !!,"There is no 'DROP IN CENTER' entry in your CDMIS COMPONENT file." Q
  1.  S ACDQ=0
  1.  Q
  1.  ;
  1. PCCCHK ; CHECK FOR PCC ENVIRONMENT
  1.  D ^ACDPCCLC
  1.  Q
  1.  ;
  1. STOP ; STOP THE INSTALL
  1.  W !!,"Terminating this install.",!!
  1.  K DIFQ
  1.  Q
  1.  ;
  1. EOJ ;
  1.  K ACDQ,ACDVER
  1.  Q
  1.  ;
  1.  ;
  1. FILE200 ; CHECK FOR FILES 6/200 CONVERSION
  1.  ;
  1.  ; This routine checks the environment for file 6 to 200
  1.  ; conversion.
  1.  ;
  1. START2 ;
  1.  D INIT2
  1.  I ACDQ S:'ACDBAD ACDQ=0 Q
  1.  D MAIN
  1.  S ACDQ=$S(ACDBAD:1,1:0)
  1.  K ACDBAD
  1.  Q
  1.  ;
  1. INIT2 ; INITIALIZATION
  1.  S (ACDBAD,ACDQ)=0
  1.  I $D(^ACDCNV("B","1")) D  S ACDQ=1 Q  ;   quit if conversion done
  1.  .  W !,"File 6 to file 200 conversion already done.",!
  1.  .  Q
  1.  S X="AVAPCHK"
  1.  X ^%ZOSF("TEST")
  1.  I '$T W !!,"^AVAPCHK routine missing!",! S (ACDBAD,ACDQ)=1 Q
  1.  Q
  1.  ;
  1. MAIN ;
  1.  D CHKPRV ;                     check file 3,6,16,200
  1.  Q:ACDQ  ;                      quit if not ok
  1.  D CHKACDF ;                    check ACD fields
  1.  Q:ACDQ  ;                      quit if not ok
  1.  Q
  1.  ;
  1. CHKPRV ; CHECK FILE 3, 6, 16, 200  
  1.  S ACDQ=1
  1.  W !!,"I am going to make sure your USER, PROVIDER, PERSON,",!," and NEW PERSON files are in sync. Please wait.",!
  1.  D EN^AVAPCHK
  1.  I '$D(^AVA("OK")) S ACDBAD=1 W !,"Files not in sync.  Do RESULTS^AVAPCHK to see errors and fix",!," before trying this install again.",! Q
  1.  S ACDQ=0
  1.  Q
  1.  ;
  1. CHKACDF ; CHECK CDMIS FIELDS  
  1.  W !,"I am now going to make sure your CDMIS provider pointers",!," are all convertible. Please wait.",!
  1.  D CHK70P7 ;          check file 9002170.7 (CDMIS PREVENTION)
  1.  D CHK72 ;            check file 9002172 (CDMIS CLIENT SVCS)
  1.  D CHK72P1 ;          check file 9002172.1 (CDMIS VISIT)
  1.  D CHK72P7 ;          check file 9002172.7 (CDMIS CLIENT SVCS COPY SET)
  1.  D CHK73P5 ;          check file 9002173.5 (CDMIS NTERVENTIONS)
  1.  I ACDBAD W !,"Some provider pointers are not convertible.  Fix errors before",!,"  trying this install again.",!
  1.  Q
  1.  ;
  1. CHK70P7 ; CHECK FILE 9002170.7
  1.  W !,"Checking file 9002170.7",!
  1.  NEW D0,D1,D2
  1.  S D0=0
  1.  F  S D0=$O(^ACDPD(D0)) Q:'D0  I $D(^ACDPD(D0,0)) D
  1.  .  S Y=$P(^ACDPD(D0,0),U,5)
  1.  .  I Y D CONVERT
  1.  .  S D1=0
  1.  .  F  S D1=$O(^ACDPD(D0,1,D1)) Q:'D1  I $D(^ACDPD(D0,1,D1,0)) D
  1.  ..  S D2=0
  1.  ..  F  S D2=$O(^ACDPD(D0,1,D1,"PRV",D2)) Q:'D2  I $D(^ACDPD(D0,1,D1,"PRV",D2,0)) D
  1.  ...  S Y=$P(^ACDPD(D0,1,D1,"PRV",D2,0),U)
  1.  ...  Q:'Y
  1.  ...  D CONVERT
  1.  ...  Q
  1.  ..  Q
  1.  .  Q
  1.  Q
  1.  ;
  1. CHK72 ; CHECK FILE 9002172 
  1.  W !,"Checking file 9002172",!
  1.  NEW D0,D1
  1.  S D0=0
  1.  F  S D0=$O(^ACDCS(D0)) Q:'D0  I $D(^ACDCS(D0,0)) D
  1.  .  S D1=0
  1.  .  F  S D1=$O(^ACDCS(D0,1,D1)) Q:'D1  I $D(^ACDCS(D0,1,D1,0)) D
  1.  ..  S Y=$P(^ACDCS(D0,1,D1,0),U)
  1.  ..  Q:'Y
  1.  ..  D CONVERT
  1.  ..  Q
  1.  .  Q
  1.  Q
  1.  ;
  1. CHK72P1 ; CHECK FILE 9002172.1
  1.  W !,"Checking file 9002172.1",!
  1.  S D0=0
  1.  F  S D0=$O(^ACDVIS(D0)) Q:'D0  I $D(^ACDVIS(D0,0)) D
  1.  .  S Y=$P(^ACDVIS(D0,0),U,3)
  1.  .  Q:'Y
  1.  .  D CONVERT
  1.  .  Q
  1.  Q
  1.  ;
  1. CHK72P7 ; CHECK FILE 9002172.7
  1.  W !,"Checking file 9002172.7",!
  1.  NEW D0,D1,D2
  1.  S D0=0
  1.  F  S D0=$O(^ACDCSCS(D0)) Q:'D0  I $D(^ACDCSCS(D0,0)) D
  1.  .  S D1=0
  1.  .  F  S D1=$O(^ACDCSCS(D0,11,D1)) Q:'D1  I $D(^ACDCSCS(D0,11,D1,0)) D
  1.  ..  S D2=0
  1.  ..  F  S D2=$O(^ACDCSCS(D0,11,D1,11,D2)) Q:'D2  I $D(^ACDCSCS(D0,11,D1,11,D2,0)) D
  1.  ...  S Y=$P(^ACDCSCS(D0,11,D1,11,D2,0),U)
  1.  ...  Q:'Y
  1.  ...  D CONVERT
  1.  ...  Q
  1.  ..  Q
  1.  .  Q
  1.  Q
  1.  ;
  1. CHK73P5 ; CHECK FILE 9002173.5
  1.  W !,"Checking file 9002173.5",!
  1.  NEW D0,D1
  1.  S D0=0
  1.  F  S D0=$O(^ACDINTV(D0)) Q:'D0  I $D(^ACDINTV(D0,0)) D
  1.  .  S D1=0
  1.  .  F  S D1=$O(^ACDINTV(D0,2,D1)) Q:'D1  I $D(^ACDINTV(D0,2,D1,0)) D
  1.  ..  S Y=$P(^ACDINTV(D0,2,D1,0),U)
  1.  ..  Q:'Y
  1.  ..  D CONVERT
  1.  ..  Q
  1.  .  Q
  1.  Q
  1.  ;
  1. CONVERT ; CONVERT FILE 6 POINTER TO FILE 200 POINTER
  1.  NEW E,M,ACDZR,X
  1.  S ACDZR=$$LGR^%ZOSV  ;                save file entry
  1.  D CONVERT2 ;                          see if ptr converts
  1.  I E D  Q  ;                           write error and exit
  1.  .  W ACDZR,!,"  "_$P($T(CONVERR+E),";;",2),!,"  "_M,!
  1.  .  S ACDBAD=1
  1.  .  Q
  1.  Q
  1.  ;
  1. CONVERR ; ERROR DESCRIPTIONS
  1.  ;;Dangling pointer to file 6
  1.  ;;File 6 pointer not in file 16
  1.  ;;No A3 node in file 16
  1.  ;;A3 pointer null or not numeric
  1.  ;;No entry in file 200 for A3 pointer
  1.  ;
  1. CONVERT2 ;
  1.  S E=0
  1.  S M="File 6 ptr="_Y
  1.  I '$D(^DIC(6,Y,0)) S E=1 Q  ;         dangling 6 ptr
  1.  I '$D(^DIC(16,Y,0)) S E=2 Q  ;        6 ptr not in 16
  1.  I '$D(^DIC(16,Y,"A3")) S E=3 Q  ;     no A3 node in 16
  1.  S X=^DIC(16,Y,"A3")
  1.  I 'X S E=4 Q  ;                       A3 ptr null or not numeric
  1.  S M=M_", A3 ptr="_X
  1.  I '$D(^VA(200,X,0)) S E=5 Q  ;        no 200 entry for A3 ptr
  1.  Q