LRCAPED2.m

LRCAPED2 ;SLC/DCM- MANUAL EDIT OF AMIS/CAP FILE ; 3/16/89  15:15 ;

 ;;V~5.0~;LAB;;02/27/90 17:09

ENT ;from LRCAPED, LRPHITEM

 I $D(DUZ(2)) I +DUZ(2) S LRSIT=+DUZ(2)

 S:'$D(LRSIT) LRSIT=^DD("SITE",1) Q:'LRSIT  S:'$D(^LAM(LRCAP,1,0)) ^(0)="^64.01P^0^0"

 I '$D(^LAM(LRCAP,1,LRSIT,0)) S $P(^(0),U)=LRSIT,$P(^LAM(LRCAP,1,0),U,3)=LRSIT,$P(^(0),U,4)=$P(^(0),U,4)+1

 I '$D(^LAM(LRCAP,1,LRSIT,1,0)) S ^(0)="^64.02DA^0^0"

 S LRTDT=$P(LRTIM,".") I '$D(^LAM(LRCAP,1,LRSIT,1,LRTDT,0)) S ^(0)=LRTDT,$P(^LAM(LRCAP,1,LRSIT,1,0),U,3)=LRTDT,$P(^(0),U,4)=$P(^(0),U,4)+1

 S:'$D(^LAM(LRCAP,1,LRSIT,1,LRTDT,1,0)) ^(0)="^64.03PA^"

LRTSA ;

 L ^LAM(LRCAP,1,LRSIT,1,LRTDT):1 I '$T W !!?7,"Another User is Editing this Date",!,*7 Q

 S LRC1=+$P(^LAM(LRCAP,1,LRSIT,1,LRTDT,1,0),U,3),LRI=+$O(^LAM(LRCAP,1,LRSIT,1,LRTDT,1,"B",LRTSA,0)) I 'LRI F LRI=LRC1:1 I '$D(^LAM(LRCAP,1,LRSIT,1,LRTDT,1,LRI)) S ^(LRI,0)=LRTSA,$P(^LAM(LRCAP,1,LRSIT,1,LRTDT,1,0),U,3)=LRI,$P(^(0),U,4)=LRC1+1 Q

 S ^LAM(LRCAP,1,LRSIT,1,LRTDT,1,"B",LRTSA,LRI)=""

 S ^(5)=$S('$D(^LAM(LRCAP,1,LRSIT,1,LRTDT,5)):LRA,1:^(5)+(LRA))

 I LRX="X" S ^(3)=$S('$D(^LAM(LRCAP,1,LRSIT,1,LRTDT,3)):LRA,1:^(3)+(LRA)) L  K LRTDT,LRC,LRH1,LRC1,LRI Q

 I LRURG=1 S ^(7)=$S('$D(^LAM(LRCAP,1,LRSIT,1,LRTDT,7)):LRA,1:^(7)+(LRA)),^(3)=$S('$D(^LAM(LRCAP,1,LRSIT,1,LRTDT,1,LRI,3)):LRA,1:^(3)+(LRA))

 I LRIN=1 S ^(4)=$S('$D(^LAM(LRCAP,1,LRSIT,1,LRTDT,4)):LRA,1:^(4)+(LRA))

INPST I LRIN=1,LRURG=1 S ^(8)=$S('$D(^LAM(LRCAP,1,LRSIT,1,LRTDT,8)):LRA,1:^(8)+(LRA))

OUTPAT I 'LRIN,LRX="S" S ^(10)=$S('$D(^LAM(LRCAP,1,LRSIT,1,LRTDT,10)):LRA,1:^(10)+(LRA))

 I LRX="R" S ^(6)=$S('$D(^LAM(LRCAP,1,LRSIT,1,LRTDT,6)):LRA,1:^(6)+(LRA))

 I LRX="Q" S ^(2)=$S('$D(^LAM(LRCAP,1,LRSIT,1,LRTDT,2)):LRA,1:^(2)+(LRA)),^(2)=$S('$D(^(1,LRI,2)):LRA,1:^(2)+(LRA))

REF I LRX="O" S ^(9)=$S('$D(^LAM(LRCAP,1,LRSIT,1,LRTDT,9)):LRA,1:^(9)+(LRA))

 I LRX="S" S ^(1)=$S('$D(^LAM(LRCAP,1,LRSIT,1,LRTDT,1,LRI,1)):LRA,1:^(1)+(LRA))

UNLOCK ;

 S $P(^LAM(LRCAP,1,LRTDT,1,0),U,3)=LRI LOCK  K LRTDT,LRC,LRH1,LRC1,LRI Q

 L  K LRTDT,LRC,LRH1,LRC1,LRI Q

UPDATE ;

LRCAPED2  ;SLC/DCM- MANUAL EDIT OF AMIS/CAP FILE ; 3/16/89  15:15 ;

 +1       ;;V~5.0~;LAB;;02/27/90 17:09

ENT       ;from LRCAPED, LRPHITEM

 +1        IF $DATA(DUZ(2))

               IF +DUZ(2)

                   SET LRSIT=+DUZ(2)

 +2        IF '$DATA(LRSIT)

               SET LRSIT=^DD("SITE",1)

           IF 'LRSIT

               QUIT 

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

               SET ^(0)="^64.01P^0^0"

 +3        IF '$DATA(^LAM(LRCAP,1,LRSIT,0))

               SET $PIECE(^(0),U)=LRSIT

               SET $PIECE(^LAM(LRCAP,1,0),U,3)=LRSIT

               SET $PIECE(^(0),U,4)=$PIECE(^(0),U,4)+1

 +4        IF '$DATA(^LAM(LRCAP,1,LRSIT,1,0))

               SET ^(0)="^64.02DA^0^0"

 +5        SET LRTDT=$PIECE(LRTIM,".")

           IF '$DATA(^LAM(LRCAP,1,LRSIT,1,LRTDT,0))

               SET ^(0)=LRTDT

               SET $PIECE(^LAM(LRCAP,1,LRSIT,1,0),U,3)=LRTDT

               SET $PIECE(^(0),U,4)=$PIECE(^(0),U,4)+1

 +6        IF '$DATA(^LAM(LRCAP,1,LRSIT,1,LRTDT,1,0))

               SET ^(0)="^64.03PA^"

LRTSA     ;

 +1        LOCK ^LAM(LRCAP,1,LRSIT,1,LRTDT):1

           IF '$TEST

               WRITE !!?7,"Another User is Editing this Date",!,*7

               QUIT 

 +2        SET LRC1=+$PIECE(^LAM(LRCAP,1,LRSIT,1,LRTDT,1,0),U,3)

           SET LRI=+$ORDER(^LAM(LRCAP,1,LRSIT,1,LRTDT,1,"B",LRTSA,0))

           IF 'LRI

               FOR LRI=LRC1:1

                   IF '$DATA(^LAM(LRCAP,1,LRSIT,1,LRTDT,1,LRI))

                       SET ^(LRI,0)=LRTSA

                       SET $PIECE(^LAM(LRCAP,1,LRSIT,1,LRTDT,1,0),U,3)=LRI

                       SET $PIECE(^(0),U,4)=LRC1+1

                       QUIT 

 +3        SET ^LAM(LRCAP,1,LRSIT,1,LRTDT,1,"B",LRTSA,LRI)=""

 +4        SET ^(5)=$SELECT('$DATA(^LAM(LRCAP,1,LRSIT,1,LRTDT,5)):LRA,1:^(5)+(LRA))

 +5        IF LRX="X"

               SET ^(3)=$SELECT('$DATA(^LAM(LRCAP,1,LRSIT,1,LRTDT,3)):LRA,1:^(3)+(LRA))

               LOCK 

               KILL LRTDT,LRC,LRH1,LRC1,LRI

               QUIT 

 +6        IF LRURG=1

               SET ^(7)=$SELECT('$DATA(^LAM(LRCAP,1,LRSIT,1,LRTDT,7)):LRA,1:^(7)+(LRA))

               SET ^(3)=$SELECT('$DATA(^LAM(LRCAP,1,LRSIT,1,LRTDT,1,LRI,3)):LRA,1:^(3)+(LRA))

 +7        IF LRIN=1

               SET ^(4)=$SELECT('$DATA(^LAM(LRCAP,1,LRSIT,1,LRTDT,4)):LRA,1:^(4)+(LRA))

INPST      IF LRIN=1

               IF LRURG=1

                   SET ^(8)=$SELECT('$DATA(^LAM(LRCAP,1,LRSIT,1,LRTDT,8)):LRA,1:^(8)+(LRA))

OUTPAT     IF 'LRIN

               IF LRX="S"

                   SET ^(10)=$SELECT('$DATA(^LAM(LRCAP,1,LRSIT,1,LRTDT,10)):LRA,1:^(10)+(LRA))

 +1        IF LRX="R"

               SET ^(6)=$SELECT('$DATA(^LAM(LRCAP,1,LRSIT,1,LRTDT,6)):LRA,1:^(6)+(LRA))

 +2        IF LRX="Q"

               SET ^(2)=$SELECT('$DATA(^LAM(LRCAP,1,LRSIT,1,LRTDT,2)):LRA,1:^(2)+(LRA))

               SET ^(2)=$SELECT('$DATA(^(1,LRI,2)):LRA,1:^(2)+(LRA))

REF        IF LRX="O"

               SET ^(9)=$SELECT('$DATA(^LAM(LRCAP,1,LRSIT,1,LRTDT,9)):LRA,1:^(9)+(LRA))

 +1        IF LRX="S"

               SET ^(1)=$SELECT('$DATA(^LAM(LRCAP,1,LRSIT,1,LRTDT,1,LRI,1)):LRA,1:^(1)+(LRA))

UNLOCK    ;

 +1        SET $PIECE(^LAM(LRCAP,1,LRTDT,1,0),U,3)=LRI

           LOCK 

           KILL LRTDT,LRC,LRH1,LRC1,LRI

           QUIT 

 +2        LOCK 

           KILL LRTDT,LRC,LRH1,LRC1,LRI

           QUIT 

UPDATE    ;