| [613] | 1 | LR7OFAO ;slc/dcm - Setup file 69 for AP orders ;8/11/97
|
|---|
| 2 | ;;5.2;LAB SERVICE;**121**;Sep 27, 1994
|
|---|
| 3 | EN(LRODT,LRDFN,LRSAMP,LRORDR,LRNT,LRPRAC,LRLLOC,LRSDT,ORIFN,LRSPEC,LRSS) ;Start here
|
|---|
| 4 | ;LRODT=Order date
|
|---|
| 5 | ;LRDFN=Patient Lab ID
|
|---|
| 6 | ;LRSAMP=Sample ptr to 62
|
|---|
| 7 | ;LRORDR=Collection type
|
|---|
| 8 | ;LRNT=d/t Ordered
|
|---|
| 9 | ;LRSDT=Start date
|
|---|
| 10 | ;ORIFN=OE/RR #
|
|---|
| 11 | ;LRSPEC=Specimen ptr to 61
|
|---|
| 12 | ;LRSS=Test subscript
|
|---|
| 13 | N X,LRSN,LRSUM
|
|---|
| 14 | S ZTQUEUED=1 D ORDER^LROW2 K ZTSK,ZTQUEUED,ZTREQ
|
|---|
| 15 | 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)=""
|
|---|
| 16 | LOCK L +^LRO(69,LRODT,1):360 G:'$T LOCK
|
|---|
| 17 | 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)
|
|---|
| 18 | ZSN IF $D(^LRO(69,LRODT,1,LRSN,0)) S LRSN=LRSN+1 G ZSN
|
|---|
| 19 | 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
|
|---|
| 20 | L -^LRO(69,LRODT,1)
|
|---|
| 21 | S ^LRO(69,LRODT,1,"AA",LRDFN,LRSN)="",^LRO(69,"D",LRDFN,LRODT,LRSN)="" S:$L(LRLLOC) ^LRO(69,LRODT,1,"AC",LRLLOC,LRSN)=""
|
|---|
| 22 | S ^LRO(69,LRODT,1,LRSN,.1)=LRORD,^LRO(69,"C",+LRORD,LRODT,LRSN)=""
|
|---|
| 23 | 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)=""
|
|---|
| 24 | I $L(LRSPEC) S ^LRO(69,LRODT,1,LRSN,4,0)="^69.02PA^1^1",^(1,0)=LRSPEC
|
|---|
| 25 | I LRSS="SP" S X=$O(^LAB(60,"B","SURGICAL PATHOLOGY",0)) I X D TST
|
|---|
| 26 | I LRSS="EM" S X=$O(^LAB(60,"B","ELECTRON MICROSCOPY",0)) I X D TST
|
|---|
| 27 | I LRSS="CY" S X=$O(^LAB(60,"B","CYTOPATHOLOGY",0)) I X D TST
|
|---|
| 28 | I LRSS="AU" S X=$O(^LAB(60,"B","AUTOPSY",0)) I X D TST
|
|---|
| 29 | Q
|
|---|
| 30 | TST ;Set test in file 69
|
|---|
| 31 | 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)=""
|
|---|
| 32 | 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)=""
|
|---|
| 33 | Q
|
|---|
