LR7OFAO.m

LR7OFAO ; IHS/DIR/AAB - Setup file 69 for AP orders ; [ 8/11/97 ]

 ;;5.2;LR;**1003**;JUN 01, 1998

 ;

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

EN(LRODT,LRDFN,LRSAMP,LRORDR,LRNT,LRPRAC,LRLLOC,LRSDT,ORIFN,LRSPEC,LRSS) ;Start here

 ;LRODT=Order date

 ;LRDFN=Patient Lab ID

 ;LRSAMP=Sample ptr to 62

 ;LRORDR=Collection type

 ;LRNT=d/t Ordered

 ;LRSDT=Start date

 ;ORIFN=OE/RR #

 ;LRSPEC=Specimen ptr to 61

 ;LRSS=Test subscript

 N X,LRSN,LRSUM

 S ZTQUEUED=1 D ORDER^LROW2 K ZTSK,ZTQUEUED,ZTREQ

 S:'$D(^LRO(69,LRODT,0)) ^(0)=$P(^LRO(69,0),"^",1,2)_"^"_LRODT_"^"_(1+$P(^(0),"^",4)),^LRO(69,LRODT,0)=LRODT,^LRO(69,"B",LRODT,LRODT)=""

LOCK L +^LRO(69,LRODT,1):360 G:'$T LOCK

 S LRSN=1+$S($D(^LRO(69,LRODT,1,0)):$P(^(0),"^",3),1:0),LRSUM=1+$S($D(^LRO(69,LRODT,1,0)):$P(^(0),"^",4),1:0)

ZSN IF $D(^LRO(69,LRODT,1,LRSN,0)) S LRSN=LRSN+1 G ZSN

 S ^LRO(69,LRODT,1,LRSN,0)=LRDFN_"^"_DUZ_"^"_LRSAMP_"^"_LRORDR_"^"_LRNT_"^"_LRPRAC_"^"_LRLLOC_"^"_LRSDT_"^"_LRLLOC_"^^"_ORIFN,^(2,0)="^69.03PA^",^LRO(69,LRODT,1,0)="^69.01PA^"_LRSN_"^"_LRSUM

 L -^LRO(69,LRODT,1)

 S ^LRO(69,LRODT,1,"AA",LRDFN,LRSN)="",^LRO(69,"D",LRDFN,LRODT,LRSN)="" S:$L(LRLLOC) ^LRO(69,LRODT,1,"AC",LRLLOC,LRSN)=""

 S ^LRO(69,LRODT,1,LRSN,.1)=LRORD,^LRO(69,"C",+LRORD,LRODT,LRSN)=""

 S $P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),"^",4,5)=LRODT_"^"_LRSN,^(.1)=LRORD,^LRO(68,LRAA,1,LRAD,1,"D",LRORD,LRAN)=""

 I $L(LRSPEC) S ^LRO(69,LRODT,1,LRSN,4,0)="^69.02PA^1^1",^(1,0)=LRSPEC

 I LRSS="SP" S X=$O(^LAB(60,"B","SURGICAL PATHOLOGY",0)) I X D TST

 I LRSS="EM" S X=$O(^LAB(60,"B","ELECTRON MICROSCOPY",0)) I X D TST

 I LRSS="CY" S X=$O(^LAB(60,"B","CYTOPATHOLOGY",0)) I X D TST

 I LRSS="AU" S X=$O(^LAB(60,"B","AUTOPSY",0)) I X D TST

 Q

TST ;Set test in file 69

 S ^LRO(69,LRODT,1,LRSN,2,0)="^69.03PA^1^1",^(1,0)=X_"^^"_LRAD_"^"_LRAA_"^"_LRAN,^LRO(69,LRODT,1,LRSN,2,"B",X,1)="" S:LRSPEC ^LRO(69,"AT",LRDFN,X,LRSPEC,LRODT)="",^(-LRODT)=""

 S ^LRO(68,LRAA,1,LRAD,1,LRAN,4,0)="^68.04PA^"_X_"^1",^(X,0)=X,^LRO(68,LRAA,1,LRAD,1,LRAN,4,"B",X,X)=""

 Q

LR7OFAO   ; IHS/DIR/AAB - Setup file 69 for AP orders ; [ 8/11/97 ]

 +1       ;;5.2;LR;**1003**;JUN 01, 1998

 +2       ;

 +3       ;;5.2;LAB SERVICE;**121**;Sep 27, 1994

EN(LRODT,LRDFN,LRSAMP,LRORDR,LRNT,LRPRAC,LRLLOC,LRSDT,ORIFN,LRSPEC,LRSS) ;Start here

 +1       ;LRODT=Order date

 +2       ;LRDFN=Patient Lab ID

 +3       ;LRSAMP=Sample ptr to 62

 +4       ;LRORDR=Collection type

 +5       ;LRNT=d/t Ordered

 +6       ;LRSDT=Start date

 +7       ;ORIFN=OE/RR #

 +8       ;LRSPEC=Specimen ptr to 61

 +9       ;LRSS=Test subscript

 +10       NEW X,LRSN,LRSUM

 +11       SET ZTQUEUED=1

           DO ORDER^LROW2

           KILL ZTSK,ZTQUEUED,ZTREQ

 +12       IF '$DATA(^LRO(69,LRODT,0))

               SET ^(0)=$PIECE(^LRO(69,0),"^",1,2)_"^"_LRODT_"^"_(1+$PIECE(^(0),"^",4))

               SET ^LRO(69,LRODT,0)=LRODT

               SET ^LRO(69,"B",LRODT,LRODT)=""

LOCK       LOCK +^LRO(69,LRODT,1):360

           IF '$TEST

               GOTO LOCK

 +1        SET LRSN=1+$SELECT($DATA(^LRO(69,LRODT,1,0)):$PIECE(^(0),"^",3),1:0)

           SET LRSUM=1+$SELECT($DATA(^LRO(69,LRODT,1,0)):$PIECE(^(0),"^",4),1:0)

ZSN        IF $DATA(^LRO(69,LRODT,1,LRSN,0))

               SET LRSN=LRSN+1

               GOTO ZSN

 +1        SET ^LRO(69,LRODT,1,LRSN,0)=LRDFN_"^"_DUZ_"^"_LRSAMP_"^"_LRORDR_"^"_LRNT_"^"_LRPRAC_"^"_LRLLOC_"^"_LRSDT_"^"_LRLLOC_"^^"_ORIFN

           SET ^(2,0)="^69.03PA^"

           SET ^LRO(69,LRODT,1,0)="^69.01PA^"_LRSN_"^"_LRSUM

 +2        LOCK -^LRO(69,LRODT,1)

 +3        SET ^LRO(69,LRODT,1,"AA",LRDFN,LRSN)=""

           SET ^LRO(69,"D",LRDFN,LRODT,LRSN)=""

           IF $LENGTH(LRLLOC)

               SET ^LRO(69,LRODT,1,"AC",LRLLOC,LRSN)=""

 +4        SET ^LRO(69,LRODT,1,LRSN,.1)=LRORD

           SET ^LRO(69,"C",+LRORD,LRODT,LRSN)=""

 +5        SET $PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,0),"^",4,5)=LRODT_"^"_LRSN

           SET ^(.1)=LRORD

           SET ^LRO(68,LRAA,1,LRAD,1,"D",LRORD,LRAN)=""

 +6        IF $LENGTH(LRSPEC)

               SET ^LRO(69,LRODT,1,LRSN,4,0)="^69.02PA^1^1"

               SET ^(1,0)=LRSPEC

 +7        IF LRSS="SP"

               SET X=$ORDER(^LAB(60,"B","SURGICAL PATHOLOGY",0))

               IF X

                   DO TST

 +8        IF LRSS="EM"

               SET X=$ORDER(^LAB(60,"B","ELECTRON MICROSCOPY",0))

               IF X

                   DO TST

 +9        IF LRSS="CY"

               SET X=$ORDER(^LAB(60,"B","CYTOPATHOLOGY",0))

               IF X

                   DO TST

 +10       IF LRSS="AU"

               SET X=$ORDER(^LAB(60,"B","AUTOPSY",0))

               IF X

                   DO TST

 +11       QUIT 

TST       ;Set test in file 69

 +1        SET ^LRO(69,LRODT,1,LRSN,2,0)="^69.03PA^1^1"

           SET ^(1,0)=X_"^^"_LRAD_"^"_LRAA_"^"_LRAN

           SET ^LRO(69,LRODT,1,LRSN,2,"B",X,1)=""

           IF LRSPEC

               SET ^LRO(69,"AT",LRDFN,X,LRSPEC,LRODT)=""

               SET ^(-LRODT)=""

 +2        SET ^LRO(68,LRAA,1,LRAD,1,LRAN,4,0)="^68.04PA^"_X_"^1"

           SET ^(X,0)=X

           SET ^LRO(68,LRAA,1,LRAD,1,LRAN,4,"B",X,X)=""

 +3        QUIT