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

LRAPLG2.m

Go to the documentation of this file.
LRAPLG2 ;DALOI/STAFF - LOG-IN DATA FROM FILE #63 ;05/30/12  16:50
 ;;5.2;LAB SERVICE;**72,115,350**;Sep 27, 1994;Build 230
 ;
 ;
EN ;
 N X
 ;
 S LRDFN=$O(^LR(LRXREF,LRH(2),LRABV,LRAN,0))
 I 'LRDFN G END
 ;
 S LRI=$O(^LR(LRXREF,LRH(2),LRABV,LRAN,LRDFN,0))
 I '$D(^LR(LRDFN,0))!('LRI&(LRSS'="AU")) G END
 ;
 S X=^LR(LRDFN,0),(LRDPF,LRPFN)=$P(X,U,2),DFN=$P(X,U,3)
 I 'LRPFN!('DFN) G END
 ;
 S LRPF=$$GET1^DID(LRPFN,"","","GLOBAL NAME"),LRP=@(LRPF_DFN_",0)"),SSN=$P(LRP,U,9),LRP=$P(LRP,U)
 D SSN^LRU
 ;
 I LRSS'="AU" D  Q
 . I '$D(^LR(LRDFN,LRSS,LRI,0)) D END Q
 . S X=^LR(LRDFN,LRSS,LRI,0),LRIDT=LRI,LRCAPLOC=""
 . S LRSD=$P(X,U),LRRC=$P(X,U,10),LRACC=$P(X,U,6),LRMD(1)=$P(X,U,7),LRSIT=$P(X,U,5),LRCS=$P(X,U,11),LRLLOC=$P(X,U,8),LRC(5)=""
 . D SETUP
 ;
 I LRSS="AU" D  Q
 . I '$D(^LR(LRDFN,"AU")) D END Q
 . S X=^LR(LRDFN,"AU"),LRCAPLOC=""
 . S LRRC=$P(X,U),LRLLOC=$P(X,U,5),LRACC=$P(X,U,6),LRMD(1)=$P(X,U,12),LRSVC=$P(X,U,14),(LRCS,LRIDT,LRSIT,LRC(5))="",DA=LRDFN
 . D D^LRAUAW
 . S LRSD=LR(63,12)
 . D SETUP
 ;
 Q
 ;
 ;
SETUP ; Setup accession
 ;
 S Y=LRRC D D^LRU
 W $C(7),!!,"Accession # ",LRAN," for ",LRH(0)
 W !,"In ",LRAA(1)," file but not in Accession file."
 W !,"Entry: ",LRP," ID: ",SSN,"  Dated: ",Y
 W !,"Enter in Accession file "
 S %=2 D YN^LRU
 I %'=1 D END^LRAPLG1 S LRFND=1 Q
 ;
 I '$D(LRTS) S LRTS=""
 ;
 D CRE868^LRAPLG1
 I $D(LRMSG) D END^LRAPLG1 S LRFND=1 Q
 ;
 D EN^LRUWLF
 ;
 ;L +^LRO(68,LRAA)
 ;S ^LRO(68,LRAA,1,LRAD,1,LRAN,0)=LRDFN_"^^"_LRRC_"^^^^"_LRLLOC_"^"_LRMD(1)_"^"_LRSVC_"^"_DUZ
 ;S ^LRO(68,LRAA,1,LRAD,1,LRAN,3)=LRSD_"^^^^"_LRI_"^"_LRC(5)
 ;S ^LRO(68,LRAA,1,LRAD,1,0)=$P(^LRO(68,LRAA,1,LRAD,1,0),"^",1,2)_"^"_LRAN_"^"_($P(^(0),"^",4)+1)
 ;S ^LRO(68,LRAA,1,"AC",DUZ(2),LRAD,LRAN)=""
 ;L -^LRO(68,LRAA)
 ;K LRSD
 ;
 ;S:LRRC ^LRO(68,LRAA,1,LRAD,1,"E",LRRC,LRAN)=""
 ;
 ;I "AUCYEMSP"'[LRSS D
 ;. S ^LRO(68,LRAA,1,LRAD,1,LRAN,5,0)="^68.05PA^1^1"
 ;. S ^LRO(68,LRAA,1,LRAD,1,LRAN,5,1,0)=LRSIT_"^"_LRCS
 S LRIDT=LRI
 ;
 Q
 ;
 ;
END ;
 ;
 K ^LR(LRXREF,LRH(2),LRABV,LRAN)
 W $C(7),!!,"Sorry, try again",!!
 D END^LRAPLG1
 S LRFND=1
 ;
 Q