LRLAM.m

LRLAM ;SLC/CJS - STUFF AMIS DATA INTO LAM GLOBAL ;2/5/91  14:18 ;

 ;;5.2;LAB SERVICE;;Sep 27, 1994

 ; CALL WITH LRDFN AND LRIDT AND LRLLOC

 Q:'$D(^LR(LRDFN,"CH",LRIDT,0))  S Y=^(0),LRSPEC=$P(Y,U,5),LRMETH=$P(Y,U,8),U="^"

 S N=$O(^LAB(62.4,"D",LRMETH,0)),LRSUF=$S($D(^LAB(62.4,N,6)):+(6),1:".00")

 S LRSITE=$S($D(DUZ(2)):DUZ(2),1:0) Q:'LRSITE

 S LRSB=0 F  S LRSB=$O(^LR(LRDFN,"CH",LRIDT,LRSB)) Q:LRSB<1  D PIECE

END K LRCODE,LRSUF

 Q

PIECE F LRSSP=1:1:99 Q:'$L($P(^LR(LRDFN,"CH",LRIDT,LRSB),U,LRSSP,99))  I $L($P(^(LRSB),U,LRSSP)) D COUNT

 Q

CHECK I $D(^LAM(LRLN,1,LRSITE,1,DT,1,N,0)) S N=N+1 G CHECK

 S ^LAM(LRLN,1,LRSITE,1,DT,1,"B",LRLLOC,N)="",C=$P(^LAM(LRLN,1,LRSITE,1,DT,1,0),U,4),^(0)="^64.03A^"_C_U_C

 Q

COUNT S LRTEST=$O(^LAB(60,"C",("CH;"_LRSB_";"_LRSSP),0)),LRCODE=$S($D(^LAB(60,LRTEST,1,LRSPEC,2,1,0)):^(0),1:-1),LRCODE=$S($D(^LAM(LRCODE,0)):$P(^(0),".",1),1:"80000")_LRSUF

 S LRLN=$O(^LAM("C",LRCODE,0)) I '$D(^LAM(LRLN,1,0)) S ^LAM(LRLN,1,0)="^64.01^1^1",^(LRSITE,0)=LRSITE

 I '$D(^LAM(LRLN,1,LRSITE,1,0)) S ^LAM(LRLN,1,LRSITE,1,0)="",^(DT,0)=DT

 S N=$P(^LAM(LRLN,1,LRSITE,1,0),U,4),^(0)="^64.02DA^"_DT_U_(N+1)

 I '$D(^LAM(LRLN,1,LRSITE,1,DT,1,0)) S ^LAM(LRLN,1,LRSITE,1,DT,1,0)="^64.03A^"

 S N=$O(^LAM(LRLN,1,LRSITE,1,DT,1,"B",LRLLOC,0)) I N<1 S N=1+$P(^LAM(LRLN,1,LRSITE,1,DT,1,0),U,3) D CHECK

 S $P(^LAM(LRLN,1,LRSITE,1,DT,1,N,0),U,1)=1+^LAM(LRLN,1,LRSITE,1,DT,1,N,0)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LRLAM   1408     printed  Apr 09, 2024@21:08:07                                                                                                                                                                                                       Page 2

LRLAM     ;SLC/CJS - STUFF AMIS DATA INTO LAM GLOBAL ;2/5/91  14:18 ;

 +1       ;;5.2;LAB SERVICE;;Sep 27, 1994

 +2       ; CALL WITH LRDFN AND LRIDT AND LRLLOC

 +3        if '$DATA(^LR(LRDFN,"CH",LRIDT,0))

               QUIT 

           SET Y=^(0)

           SET LRSPEC=$PIECE(Y,U,5)

           SET LRMETH=$PIECE(Y,U,8)

           SET U="^"

 +4        SET N=$ORDER(^LAB(62.4,"D",LRMETH,0))

           SET LRSUF=$SELECT($DATA(^LAB(62.4,N,6)):+(6),1:".00")

 +5        SET LRSITE=$SELECT($DATA(DUZ(2)):DUZ(2),1:0)

           if 'LRSITE

               QUIT 

 +6        SET LRSB=0

           FOR 

               SET LRSB=$ORDER(^LR(LRDFN,"CH",LRIDT,LRSB))

               if LRSB<1

                   QUIT 

               DO PIECE

END        KILL LRCODE,LRSUF

 +1        QUIT 

PIECE      FOR LRSSP=1:1:99

               if '$LENGTH($PIECE(^LR(LRDFN,"CH",LRIDT,LRSB),U,LRSSP,99))

                   QUIT 

               IF $LENGTH($PIECE(^(LRSB),U,LRSSP))

                   DO COUNT

 +1        QUIT 

CHECK      IF $DATA(^LAM(LRLN,1,LRSITE,1,DT,1,N,0))

               SET N=N+1

               GOTO CHECK

 +1        SET ^LAM(LRLN,1,LRSITE,1,DT,1,"B",LRLLOC,N)=""

           SET C=$PIECE(^LAM(LRLN,1,LRSITE,1,DT,1,0),U,4)

           SET ^(0)="^64.03A^"_C_U_C

 +2        QUIT 

COUNT      SET LRTEST=$ORDER(^LAB(60,"C",("CH;"_LRSB_";"_LRSSP),0))

           SET LRCODE=$SELECT($DATA(^LAB(60,LRTEST,1,LRSPEC,2,1,0)):^(0),1:-1)

           SET LRCODE=$SELECT($DATA(^LAM(LRCODE,0)):$PIECE(^(0),".",1),1:"80000")_LRSUF

 +1        SET LRLN=$ORDER(^LAM("C",LRCODE,0))

           IF '$DATA(^LAM(LRLN,1,0))

               SET ^LAM(LRLN,1,0)="^64.01^1^1"

               SET ^(LRSITE,0)=LRSITE

 +2        IF '$DATA(^LAM(LRLN,1,LRSITE,1,0))

               SET ^LAM(LRLN,1,LRSITE,1,0)=""

               SET ^(DT,0)=DT

 +3        SET N=$PIECE(^LAM(LRLN,1,LRSITE,1,0),U,4)

           SET ^(0)="^64.02DA^"_DT_U_(N+1)

 +4        IF '$DATA(^LAM(LRLN,1,LRSITE,1,DT,1,0))

               SET ^LAM(LRLN,1,LRSITE,1,DT,1,0)="^64.03A^"

 +5        SET N=$ORDER(^LAM(LRLN,1,LRSITE,1,DT,1,"B",LRLLOC,0))

           IF N<1

               SET N=1+$PIECE(^LAM(LRLN,1,LRSITE,1,DT,1,0),U,3)

               DO CHECK

 +6        SET $PIECE(^LAM(LRLN,1,LRSITE,1,DT,1,N,0),U,1)=1+^LAM(LRLN,1,LRSITE,1,DT,1,N,0)

 +7        QUIT