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

LR232.m

Go to the documentation of this file. 
  1. LR232 ;DALOI/CKA - LR*5.2*232 PATCH ENVIRONMENT CHECK ROUTINE;31 -AUG-2001
  1.  ;;5.2T8;LR;**1018**;Oct 27, 2004
  1.  ;;5.2;LAB SERVICE;**232**;Sep 27,1994
  1. EN ; Does not prevent loading of the transport global.
  1.  ;Environment check is done only during the install.
  1.  Q:'$D(XPDENV) 
  1.  D BMES^XPDUTL($$CJ^XLFSTR("*** Environment check started ***",80))
  1.  D CHECK
  1. EXIT I $G(XPDQUIT) D BMES^XPDUTL($$CJ^XLFSTR("Install Environment Check FAILED",IOM))
  1.  I '$G(XPDQUIT) D BMES^XPDUTL($$CJ^XLFSTR("Environment Check is Ok ---",IOM))
  1.  K VER,RN,LN2
  1.  Q
  1. CHECK I $S('$G(IOM):1,'$G(IOSL):1,$G(U)'="^":1,1:0) D BMES^XPDUTL($$CJ^XLFSTR("Terminal Device is not defined",IOM)) S XPDQUIT=2
  1.  I $S('$G(DUZ):1,$D(DUZ)[0:1,$D(DUZ(0))[0:1,1:0) D BMES^XPDUTL($$CJ^XLFSTR("Please Log in to set local DUZ... variables",80)) S XPDQUIT=2
  1.  I '$$ACTIVE^XUSER($G(DUZ)) D BMES^XPDUTL($$CJ^XLFSTR("You are not a valid user on this system",80)) S XPDQUIT=2
  1.  S VER=$$VERSION^XPDUTL("LR")
  1.  I VER'>5.1 D BMES^XPDUTL($$CJ^XLFSTR("You must have LAB V5.2 Installed",IOM)) S XPDQUIT=2
  1.  S VER=$$VERSION^XPDUTL("NLT")
  1.  ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018 ALPHA ONLY??
  1.  ;I VER'=5.254 D BMES^XPDUTL($$CJ^XLFSTR("You must have NLT V5.254 Installed",IOM)) S XPDQUIT=2
  1.  ;----- END IHS MODIFICATIONS
  1.  Q
  1. PRE ;Pre-install entry point
  1.  Q:'$D(XPDNM)
  1.  D PTRSAV ;Save pointer information
  1.  N DIU,DIK,DA
  1.  S DIU="^LAB(95.3,",DIU(0)="DST" D EN^DIU2
  1.  K DIU
  1.  S DIU="^LAB(95.31,",DIU(0)="DST" D EN^DIU2
  1.  K DIU
  1.  S DIU="^LAB(64.061,",DIU(0)="DST" D EN^DIU2
  1.  K DIU
  1.  S DIU="^LAB(64.2,",DIU(0)="DST" D EN^DIU2
  1.  K DIU
  1.  S DIU="^LAB(64.3,",DIU(0)="DST" D EN^DIU2
  1.  K DIU
  1.  S DIK="^DD(60,",DA=64.1,DA(1)=60 D ^DIK
  1.  K DIK,DA,DIU
  1.  K ^LAB(95.3),^LAB(95.31),^LAB(64.061),^LAB(64.2),^LAB(64.3)
  1.  D BMES^XPDUTL($$CJ^XLFSTR("*** Preinstall completed ***",80))
  1.  Q
  1. POST ;
  1.  Q
  1. PTRSAV ;Save pointer values into XTMP("LR232" to repointed after install
  1.  Q:$G(^XTMP("LR232",1))  ;indicates pointers already saved.
  1.  D BMES^XPDUTL($$CJ^XLFSTR("** Saving Pointer Values **",80))
  1.  N LRIEN,LRIENSUB,LRPTR,LRDTLB,LRNODE
  1.  S ^XTMP("LR232",0)=$$FMADD^XLFDT(DT,30)_U_DT_U_"LR232 pointer save data"
  1. 61 ;Save data from LAB(61
  1.  D BMES^XPDUTL($$CJ^XLFSTR(" Processing ^LAB(61, ",IOM))
  1.  S LRIEN=0 F  S LRIEN=+$O(^LAB(61,LRIEN)) Q:LRIEN<1  I $P($G(^(LRIEN,0)),U,9) D
  1.  . S LRPTR=$P($G(^LAB(61,LRIEN,0)),U,9) Q:'LRPTR
  1.  . S ^XTMP("LR232",61,LRIEN,LRPTR)=$G(^LAB(64.061,LRPTR,0))
  1. 6205 ;Save data from LAB(62.05
  1.  D BMES^XPDUTL($$CJ^XLFSTR(" Processing ^LAB(62.05, ",IOM))
  1.  S LRIEN=0 F  S LRIEN=+$O(^LAB(62.05,LRIEN)) Q:LRIEN<.01  I $P($G(^(LRIEN,0)),U,5) D
  1.  . S LRPTR=$P($G(^LAB(62.05,LRIEN,0)),U,5) Q:'LRPTR
  1.  . S ^XTMP("LR232",62.05,LRIEN,LRPTR)=$G(^LAB(64.061,LRPTR,0))
  1. 6285 ;Save date from LAHM(62.85
  1.  D BMES^XPDUTL($$CJ^XLFSTR(" Processing ^LAHM(62.85, ",IOM)) W !
  1.  S LRDTLB=$$FMADD^XLFDT(DT,-120)
  1.  S LRIEN=0 F  S LRIEN=+$O(^LAHM(62.85,LRIEN)) Q:LRIEN<1  I $P($G(^(LRIEN,0)),U,5) S LRNODE=^(0) D
  1.  . I '(LRIEN#1000) W "*"
  1.  . I $P(LRNODE,U,3)<LRDTLB Q
  1.  . S LRPTR=$P($G(^LAHM(62.85,LRIEN,0)),U,5) Q:'LRPTR
  1.  . S ^XTMP("LR232",62.85,LRIEN)=$G(^LAB(64.061,LRPTR,0))
  1. 696 ;Save data from LRO(69.6
  1.  S LRDTLB=$$FMTHL7^XLFDT($$FMADD^XLFDT(DT,-120)) ;Only save the last three 3 months
  1.  D BMES^XPDUTL($$CJ^XLFSTR(" Processing ^LRO(69.6, ",IOM)) W !
  1.  S LRIEN=0 F  S LRIEN=+$O(^LRO(69.6,LRIEN)) Q:LRIEN<1   S LRNODE=$G(^(LRIEN,0)) D
  1.  . I '(LRIEN#1000) W "*"
  1.  . I +$P($P(LRNODE,U,14),"-",2)<LRDTLB Q
  1.  . D
  1.  . . S LRIENSUB=0
  1.  . . F  S LRIENSUB=+$O(^LRO(69.6,LRIEN,2,LRIENSUB)) Q:LRIENSUB<1  D
  1.  . . . Q:'$P($G(^LRO(69.6,LRIEN,2,LRIENSUB,0)),U,6)  S LRPTR=$P(^(0),U,6)
  1.  . . . S ^XTMP("LR232",69.64,LRIEN,LRIENSUB,LRPTR)=$G(^LAB(64.061,LRPTR,0))
  1.  . S LRPTR=$P($G(^LRO(69.6,LRIEN,0)),U,10) Q:'LRPTR
  1.  . S ^XTMP("LR232",69.6,LRIEN,LRPTR)=$G(^LAB(64.061,LRPTR,0))
  1. 682 ;Save data from LRO(68.2,LRIEN,"SUF"
  1.  ;Will repoint using SUF piece 3 (WKLD CODE SUFFIX) number .xxxx
  1.  D BMES^XPDUTL($$CJ^XLFSTR(" Processing ^LRO(68.2 ",IOM))
  1.  S LRIEN=0
  1.  F  S LRIEN=+$O(^LRO(68.2,LRIEN)) Q:LRIEN<1  I $G(^(LRIEN,"SUF")) D
  1.  . S LRPTR=$G(^LRO(68.2,LRIEN,"SUF"))
  1.  . S ^XTMP("LR232",68.2,LRIEN,+LRPTR)=LRPTR
  1. 62801 ;Save data from LAB SHIPPING MANIFEST specimen multiple
  1.  D BMES^XPDUTL($$CJ^XLFSTR(" Processing ^LAHM(62.8 ",IOM)) W !
  1.  S LRIEN=0
  1.  F  S LRIEN=+$O(^LAHM(62.8,LRIEN)) Q:LRIEN<1  D
  1.  . I '(LRIEN#500) W "*"
  1.  . S LRIENSUB=0
  1.  . F  S LRIENSUB=+$O(^LAHM(62.8,LRIEN,10,LRIENSUB)) Q:LRIENSUB<1  D
  1.  . . I $D(^LAHM(62.8,LRIEN,10,LRIENSUB,1))#2 S LRSTR=^(1) D S62801(1)
  1.  . . I $D(^LAHM(62.8,LRIEN,10,LRIENSUB,2))#2 S LRSTR=^(2) D S62801(2)
  1.  S ^XTMP("LR232",1)=DT
  1.  Q
  1. S62801(NODE) ; Resolve pointer to external
  1.  K OUT,LRS
  1.  S LRSTRP=$P(LRSTR,U,3) I LRSTRP D
  1.  . S LRSTRP=LRSTRP_","
  1.  . D GETS^DIQ(64.061,LRSTRP,.01,"E","OUT")
  1.  . I $D(OUT(64.061,LRSTRP,.01,"E")) S $P(LRSTR,U,3)=+LRSTRP_"|"_OUT(64.061,LRSTRP,.01,"E"),LRS=1
  1.  K OUT
  1.  S LRSTRP=$S(NODE=2:$P(LRSTR,U,7),NODE=2:$P(LRSTR,U,12),1:$P(LRSTR,U,6)) I LRSTRP D
  1.  . S LRSTRP=LRSTRP_","
  1.  . D GETS^DIQ(64.061,LRSTRP,.01,"E","OUT")
  1.  . I $D(OUT(64.061,LRSTRP,.01,"E")) D
  1.  . . I NODE=1 S $P(LRSTR,U,6)=+LRSTRP_"|"_OUT(64.061,LRSTRP,.01,"E"),LRS=1
  1.  . . I NODE=2 S $P(LRSTR,U,7)=+LRSTRP_"|"_OUT(64.061,LRSTRP,.01,"E"),LRS=1
  1.  . . I NODE=2 S $P(LRSTR,U,12)=+LRSTRP_"|"_OUT(64.061,LRSTRP,.01,"E"),LRS=1
  1.  I $G(LRS) S ^XTMP("LR232",62.8,LRIEN,LRIENSUB,NODE)=LRSTR
  1.  Q