- LRAPLG2 ; IHS/DIR/AAB - LOG-IN DATA FROM FILE #63 3/26/96 19:08 ;
- ;;5.2;LR;**1002**;JUN 01, 1998
- ;;5.2;LAB SERVICE;**72,115**;Sep 27, 1994
- S LRAN=X,LRFND=1 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=^DIC(LRPFN,0,"GL"),LRP=@(LRPF_DFN_",0)"),SSN=$P(LRP,U,9),LRP=$P(LRP,U) D SSN^LRU
- I LRSS="AU" G:'$D(^LR(LRDFN,"AU")) END S X=^("AU"),LRRC=$P(X,U),LRSVC=$P(X,U,14),(LRCS,LRMD,LRSIT,LRLLOC,LRC(5))="",DA=LRDFN D D^LRAUAW S LRSD=LR(63,12)
- I LRSS'="AU" G:'$D(^LR(LRDFN,LRSS,LRI,0)) END S X=^(0),LRSD=$P(X,U),LRRC=$P(X,U,10),LRMD=$P(X,U,7),LRSIT=$P(X,U,5),LRCS=$P(X,U,11),LRLLOC=$P(X,U,8),LRC(5)=""
- S Y=LRRC D D^LRU
- ;W $C(7),!!,"Accession # ",LRAN," for ",LRH(0),!,"In ",$P(LRAA(1)," ",1)," file but not in Accession file.",!,"Entry: ",LRP," ID: ",SSN," Dated: ",Y,!,"Enter in Accession file " S %=2 D YN^LRU
- W $C(7),!!,"Accession # ",LRAN," for ",LRH(0),!,"In ",$P(LRAA(1)," ",1)," file but not in Accession file.",!,"Entry: ",LRP," ID: ",HRCN," Dated: ",Y,!,"Enter in Accession file " S %=2 D YN^LRU ;IHS/OIRM TUC/AAB 10/08/97
- I %'=1 D END^LRAPLG1 Q
- I '$D(LRTS) S LRTS=""
- L +^LRO(68,LRAA) S ^LRO(68,LRAA,1,LRAD,1,LRAN,0)=LRDFN_"^^"_LRRC_"^^^^"_LRLLOC_"^"_LRMD(1)_"^"_LRSVC_"^"_DUZ,^(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),^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 S ^LRO(68,LRAA,1,LRAD,1,LRAN,5,0)="^68.05PA^1^1",^LRO(68,LRAA,1,LRAD,1,LRAN,5,1,0)=LRSIT_"^"_LRCS
- Q
- Q
- END K ^LR(LRXREF,LRH(2),LRABV,LRAN) W $C(7),!!,"Sorry, try again",!! D END^LRAPLG1 Q
- LRAPLG2 ; IHS/DIR/AAB - LOG-IN DATA FROM FILE #63 3/26/96 19:08 ;
- +1 ;;5.2;LR;**1002**;JUN 01, 1998
- +2 ;;5.2;LAB SERVICE;**72,115**;Sep 27, 1994
- +3 SET LRAN=X
- SET LRFND=1
- SET LRDFN=$ORDER(^LR(LRXREF,LRH(2),LRABV,LRAN,0))
- IF 'LRDFN
- GOTO END
- +4 SET LRI=$ORDER(^LR(LRXREF,LRH(2),LRABV,LRAN,LRDFN,0))
- IF '$DATA(^LR(LRDFN,0))!('LRI&(LRSS'="AU"))
- GOTO END
- +5 SET X=^LR(LRDFN,0)
- SET (LRDPF,LRPFN)=$PIECE(X,U,2)
- SET DFN=$PIECE(X,U,3)
- IF 'LRPFN!('DFN)
- GOTO END
- +6 SET LRPF=^DIC(LRPFN,0,"GL")
- SET LRP=@(LRPF_DFN_",0)")
- SET SSN=$PIECE(LRP,U,9)
- SET LRP=$PIECE(LRP,U)
- DO SSN^LRU
- +7 IF LRSS="AU"
- IF '$DATA(^LR(LRDFN,"AU"))
- GOTO END
- SET X=^("AU")
- SET LRRC=$PIECE(X,U)
- SET LRSVC=$PIECE(X,U,14)
- SET (LRCS,LRMD,LRSIT,LRLLOC,LRC(5))=""
- SET DA=LRDFN
- DO D^LRAUAW
- SET LRSD=LR(63,12)
- +8 IF LRSS'="AU"
- IF '$DATA(^LR(LRDFN,LRSS,LRI,0))
- GOTO END
- SET X=^(0)
- SET LRSD=$PIECE(X,U)
- SET LRRC=$PIECE(X,U,10)
- SET LRMD=$PIECE(X,U,7)
- SET LRSIT=$PIECE(X,U,5)
- SET LRCS=$PIECE(X,U,11)
- SET LRLLOC=$PIECE(X,U,8)
- SET LRC(5)=""
- +9 SET Y=LRRC
- DO D^LRU
- +10 ;W $C(7),!!,"Accession # ",LRAN," for ",LRH(0),!,"In ",$P(LRAA(1)," ",1)," file but not in Accession file.",!,"Entry: ",LRP," ID: ",SSN," Dated: ",Y,!,"Enter in Accession file " S %=2 D YN^LRU
- +11 ;IHS/OIRM TUC/AAB 10/08/97
- WRITE $CHAR(7),!!,"Accession # ",LRAN," for ",LRH(0),!,"In ",$PIECE(LRAA(1)," ",1)," file but not in Accession file.",!,"Entry: ",LRP," ID: ",HRCN," Dated: ",Y,!,"Enter in Accession file "
- SET %=2
- DO YN^LRU
- +12 IF %'=1
- DO END^LRAPLG1
- QUIT
- +13 IF '$DATA(LRTS)
- SET LRTS=""
- +14 LOCK +^LRO(68,LRAA)
- SET ^LRO(68,LRAA,1,LRAD,1,LRAN,0)=LRDFN_"^^"_LRRC_"^^^^"_LRLLOC_"^"_LRMD(1)_"^"_LRSVC_"^"_DUZ
- SET ^(3)=LRSD_"^^^^"_LRI_"^"_LRC(5)
- +15 SET ^LRO(68,LRAA,1,LRAD,1,0)=$PIECE(^LRO(68,LRAA,1,LRAD,1,0),"^",1,2)_"^"_LRAN_"^"_($PIECE(^(0),"^",4)+1)
- SET ^LRO(68,LRAA,1,"AC",DUZ(2),LRAD,LRAN)=""
- LOCK -^LRO(68,LRAA)
- KILL LRSD
- +16 IF LRRC
- SET ^LRO(68,LRAA,1,LRAD,1,"E",LRRC,LRAN)=""
- +17 IF "AUCYEMSP"'[LRSS
- SET ^LRO(68,LRAA,1,LRAD,1,LRAN,5,0)="^68.05PA^1^1"
- SET ^LRO(68,LRAA,1,LRAD,1,LRAN,5,1,0)=LRSIT_"^"_LRCS
- +18 QUIT
- +19 QUIT
- END KILL ^LR(LRXREF,LRH(2),LRABV,LRAN)
- WRITE $CHAR(7),!!,"Sorry, try again",!!
- DO END^LRAPLG1
- QUIT
