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

LR232P.m

Go to the documentation of this file. 
  1. LR232P ;DALOI/FHS - LR*5.2*232 POST INSTALL ROUTINE;31 -AUG-2001
  1.  ;;5.2;LAB SERVICE'**232**;Sep 27, 1994
  1. ENP ;Resolve pointers saved in XTMP("LR232",FILE#)
  1.  Q:'$D(XPDNM)
  1.  N D0,DA,DC,IEN,LR642,LRDA,LRDATA,LRENTRY,LRERR,LRFDA,LRFIELD,LRFILE
  1.  N LRGN,LRIEN,LRLKUP,LRLVL,LRMSG,LRNAME,LRNODE,LRNOP,LROUT,LRP,LRPTR,LRSUB
  1.  Q:'$G(^XTMP("LR232",1))  ; The save pointer did not go to completion
  1.  D SING(61,.09)
  1.  D SING(62.05,4)
  1.  D O628
  1.  D SING(62.85,.05)
  1.  D O682
  1.  D SING(69.6,6)
  1.  D O6964
  1.  D BMES^XPDUTL($$CJ^XLFSTR("Pointer Resolution Completed",IOM))
  1.  Q
  1. HDR(LRFILE) ;Print file being resolved
  1.  K LRNAME,LRERR
  1.  D FILE^DID(LRFILE,"","NAME","LRNAME","LRERR")
  1.  Q:$D(LRERR)
  1.  S LRHDR="Resolving "_$S('$D(LRERR):LRNAME("NAME"),1:LRFILE)_" Pointers"
  1.  D BMES^XPDUTL($$CJ^XLFSTR(LRHDR,IOM))
  1.  D FILE^DID(LRFILE,"","GLOBAL NAME","LRGN","LRERR")
  1.  Q
  1. SING(LRFILE,LRFIELD) ;Resolve Pointer in LRFILE (file number) by LRFIELD (field to edit)
  1.  Q:'LRFILE!'LRFIELD
  1.  D HDR(LRFILE)
  1.  I $D(LRERR) K ^XTMP("LR232",LRFILE) Q
  1.  K LRDA,LRIEN,LRNODE,LRPTR,LROUT
  1.  S LRDA=0 F  S LRDA=$O(^XTMP("LR232",LRFILE,LRDA)) Q:LRDA<1  D
  1.  . I '(LRDA#500) W "*"
  1.  . K LROUT,LRMSG
  1.  . S LRPTR=$O(^XTMP("LR232",LRFILE,LRDA,0)) I 'LRPTR K ^XTMP("LR232",LRFILE,LRDA) Q
  1.  . I '$D(@(LRGN("GLOBAL NAME")_LRDA_",0)")) K ^XTMP("LR232",LRFILE,LRDA) Q
  1.  . S LRNODE=^XTMP("LR232",LRFILE,LRDA,LRPTR),LRPTR=LRPTR_","
  1.  . D GETS^DIQ(64.061,LRPTR,.01,"E","LROUT")
  1.  . I $G(LROUT(64.061,LRPTR,.01,"E"))=$P(LRNODE,U) W:$G(LRDBUG) LRPTR_" OK",! K ^XTMP("LR232",LRFILE,LRDA,+LRPTR) Q
  1.  . S LRIEN=$$IENS^DILF(.LRDA)
  1.  . K LRFDA,LRMSG,LRLKUP
  1.  . D GETNAM(LRPTR,64.061)
  1.  . D LK($P(LRNODE,U))
  1.  . I $D(LRMSG) K ^XTMP("LR232",LRFILE,+LRDA,+LRPTR) Q
  1.  . I '$G(LRLKUP("DILIST",2,1))  K ^XTMP("LR232",LRFILE,+LRDA,+LRPTR) Q
  1.  . S LRFDA(LRFILE,LRIEN,LRFIELD)=LRLKUP("DILIST",2,1)
  1.  . D BMES^XPDUTL($$LJ^XLFSTR("   Updating "_LROUT(64.061,LRPTR,.01,"E")_" to "_$P(LRNODE,U),IOM))
  1.  . D FILE^DIE("KS","LRFDA","LRMSG")
  1.  . I '$D(LRMSG) K ^XTMP("LR232",LRFILE,LRDA,+LRPTR)
  1.  Q
  1. LK(VAL) ;Lookup specimens
  1.  D FIND^DIC(64.061,"",".01","X",VAL,"","B","","","LRLKUP","LRMSG")
  1.  Q
  1. O628 ; Resolve pointers for LAB SHIPPING MANIFEST 62.8
  1.  K LRIEN,LRFILE S LRIEN=0,LRFILE=62.8
  1.  D HDR(LRFILE)
  1.  F  S LRIEN=$O(^XTMP("LR232",LRFILE,LRIEN)) Q:LRIEN<1  D
  1.  . I '(LRIEN#500) W "*"
  1.  . K LRSUB S LRSUB=0
  1.  . F  S LRSUB=$O(^XTMP("LR232",LRFILE,LRIEN,LRSUB)) Q:LRSUB<1  D
  1.  . . K LRLVL S LRLVL=0
  1.  . . S LRLVL=$O(^XTMP("LR232",LRFILE,LRIEN,LRSUB,LRLVL)) Q:LRLVL<1  D
  1.  . . K LRNODE,LRP,LRFDA,LRMSG S LRNOP=0
  1.  . . D LVL(LRLVL)
  1.  . . I $D(LRFDA) D FILE^DIE("KS","LRFDA","LRMSG")
  1.  . . I '$D(LRMSG) K ^XTMP("LR232",LRFILE,LRIEN,LRSUB)
  1.  Q
  1. LVL(LRLVL) ;
  1.  S LRNODE=$G(^XTMP("LR232",LRFILE,LRIEN,LRSUB,LRLVL)) D
  1.  . I LRLVL=1 F LRP=3,6 S LRP(LRP)=$P(LRNODE,U,LRP) D CHK
  1.  . I LRLVL=2 F LRP=3,7,12 S LRP(LRP)=$P(LRNODE,U,LRP) D CHK
  1.  I $G(LRNOP)>1 K ^XTMP("LR232",LRFILE,LRIEN,LRSUB,LRLVL)
  1.  Q
  1. CHK ;
  1.  N LRCHKIEN
  1.  Q:'LRP(LRP)
  1.  S LRDATA=$P(LRP(LRP),"|",2)
  1.  I '$L(LRDATA) S LRNOP=$G(LRNOP)+1 Q
  1.  S LRPTR=+LRP(LRP)_","
  1.  D GETNAM(LRPTR,64.061)
  1.  I $G(LROUT(64.061,LRPTR,.01,"E"))=$P(LRP(LRP),"|",2) W:$G(LRDBUG) LRPTR_" Ok",! S LRNOP=$G(LRNOP)+1 Q
  1.  D  I 'LRDATA S LRNOP=$G(LRNOP)+1 Q
  1.  . D LK(LRDATA)
  1.  . S LRDATA=+$G(LRLKUP("DILIST",2,1))
  1.  S LRCHKIEN=LRSUB_","_LRIEN_","
  1.  I $G(LRLVL)=1,$G(LRP)=3 S LRFDA(62.801,LRCHKIEN,1.13)=LRDATA
  1.  I $G(LRLVL)=1,$G(LRP)=6 S LRFDA(62.801,LRCHKIEN,1.23)=LRDATA
  1.  I $G(LRLVL)=2,$G(LRP)=3 S LRFDA(62.801,LRCHKIEN,2.13)=LRDATA
  1.  I $G(LRLVL)=2,$G(LRP)=7 S LRFDA(62.801,LRCHKIEN,2.23)=LRDATA
  1.  I $G(LRLVL)=2,$G(LRP)=12 S LRFDA(62.801,LRCHKIEN,2.24)=LRDATA
  1.  Q
  1. GETNAM(LRPTR,LRFILE) ;Return the external name for the code
  1.  K LROUT
  1.  D GETS^DIQ(LRFILE,LRPTR,.01,"E","LROUT")
  1.  Q
  1. O682 ;Resolve pointer for LOAD/WORK LIST LRO(68.2
  1.  S LRFILE=68.2 D HDR(LRFILE)
  1.  S LRIEN=0
  1.  F  S LRIEN=$O(^XTMP("LR232",LRFILE,LRIEN)) Q:LRIEN<1  D
  1.  . K D0,DA,DC
  1.  . S LRPTR=$O(^XTMP("LR232",LRFILE,LRIEN,0)),LRPTR=LRPTR_","
  1.  . W "*" W:$G(LRDBUG) LRPTR
  1.  . S LRNODE=$G(^XTMP("LR232",LRFILE,LRIEN,+LRPTR))
  1.  . I 'LRNODE K ^XTMP("LR232",LRFILE,LRIEN,+LRPTR) Q
  1.  . K LRFDA,LRMSG,LROUT
  1.  . S LR642=$P(LRNODE,U,3) S:LR642=".000" LR642=".0000"
  1.  . D FIND^DIC(64.2,"",".01;1","X",LR642,"","F","","","LROUT","LRMSG")
  1.  . I $O(LROUT("DILIST",1,1)) K ^XTMP("LR232",LRFILE,LRIEN,+LRPTR) Q
  1.  . I '$D(LROUT("DILIST",1,1)) K ^XTMP("LR232",LRFILE,LRIEN,+LRPTR) Q
  1.  . I $D(LRMSG) K ^XTMP("LR232",LRFILE,LRIEN,+LRPTR) Q
  1.  . I '$G(LROUT("DILIST",2,1)) K ^XTMP("LR232",LRFILE,LRIEN,+LRPTR) Q
  1.  . S (D0,DC,DA,LRFDA(68.2,LRIEN_",",.14))=LROUT("DILIST",2,1)
  1.  . D FILE^DIE("KS","LRFDA","LRMSG")
  1.  . K D0,DC,DA
  1.  . I '$D(LRMSG) K ^XTMP("LR232",LRFILE,LRIEN,+LRPTR)
  1.  Q
  1. O6964 ;Repoint the LAB PENDING ORDER - ORDERED TEST multiple
  1.  K LRFILE,LRIEN
  1.  S LRFILE=69.6 D HDR(LRFILE) D BMES^XPDUTL($$CJ^XLFSTR("Subfile entries",IOM))
  1.  S LRIEN=0 F  S LRIEN=$O(^XTMP("LR232",69.64,LRIEN)) Q:LRIEN<1  D
  1.  . I '(LRIEN#500) W "*"
  1.  . S LRSUB=0 F  S LRSUB=$O(^XTMP("LR232",69.64,LRIEN,LRSUB)) Q:LRSUB<1  D
  1.  . . S LRPTR=0 F  S LRPTR=$O(^XTMP("LR232",69.64,LRIEN,LRSUB,LRPTR)) Q:LRPTR<1  D
  1.  . . . I 'LRPTR K ^XTMP("LR232",69.64,LRIEN,LRSUB) Q
  1.  . . . S LRNODE=$G(^XTMP("LR232",69.64,LRIEN,LRSUB,LRPTR))
  1.  . . . D GETNAM(LRPTR_",",64.061)
  1.  . . . I $G(LROUT(64.061,LRPTR_",",.01,"E"))=$P(LRNODE,U) W:$G(LRDBUG) " OK "_LRIEN K ^XTMP("LR232",69.64,LRIEN,LRSUB,+LRPTR) Q
  1.  . . . S IEN=LRSUB_","_LRIEN_","
  1.  . . . K LRFDA,LRMSG
  1.  . . . S LRFDA(69.6,IEN,5)=$P(LRNODE,U)
  1.  . . . D FILE^DIE("EKS","LRFDA","LRMSG")
  1.  . . . I '$D(LRMSG) K ^XTMP("LR232",69.64,LRIEN,LRSUB,+LRPTR)
  1.  Q