source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LR7OF1.m@ 1800

Last change on this file since 1800 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.5 KB
Line 
1LR7OF1 ;slc/dcm/JAH - Setup new order from OE/RR ;8/10/04
2 ;;5.2;LAB SERVICE;**121,187,223,256,299,291**;Sep 27, 1994
3 ;
4EN ;Setup NEW orders from OE/RR messages
5 ;[^TMP("OR",$J,"LRES") DOCUMENTATION]
6 ; 'Combining of Orders' functionality depends on this TMP global
7 ; Set and Killed when BHS and BTS batch message headers are received
8 ; Global contains a list of lab orders for a session
9 ; Lab adds elements to the global array as orders are processed:
10 ; ^TMP("OR",$J,"LRES",LRDFN,LRSDT,LRXZ,^TMP("OR",$J,"LRES","CTR"))=LRORD_"^"_LRODT_"^"_LRSN
11 ; ^TMP("OR",$J,"LRES","CTR")=Count
12 N ZTSK,LRORDR,X,UNEEK,LRNT ;UNEEK forces a unique entry (Micro tests), set when ^..."LROT" built
13 D DT
14 S LRORDR=LRXZ
15 S:'$D(^TMP("OR",$J,"LRES","CTR")) ^("CTR")=0
16 F LRSAMP=-1:0 S LRSAMP=$O(^TMP("OR",$J,"LROT",LRSDT,LRXZ,LRSAMP)) Q:LRSAMP="" D
17 . F LRSPEC=-1:0 S LRSPEC=$O(^TMP("OR",$J,"LROT",LRSDT,LRXZ,LRSAMP,LRSPEC)) Q:LRSPEC="" S X=^(LRSPEC,0) D
18 .. S ORIFN=+X,UNEEK=$P(X,"^",2)
19 .. D ZX
20 Q
21ZX ;
22 N COMBINE,X,NEWORD
23 I '$D(^LRO(69,LRODT,0)) D
24 . S ^(0)=$P(^LRO(69,0),U,1,2)_"^"_LRODT_"^"_(1+$P(^(0),U,4)),^LRO(69,LRODT,0)=LRODT,^LRO(69,"B",LRODT,LRODT)=""
25 S COMBINE=""
26 I 'UNEEK D
27 . S COMBINE=$$ORES^LR7OF5(LRDFN,LRSDT,LRXZ,+LRSAMP,LRPRAC,LROLLOC,LRSPEC,LRDUZ)
28 . I '$L(COMBINE) S COMBINE=$$FIND^LR7OF5(LRDFN,LRODT,LRSDT,LRXZ,+LRSAMP,LRPRAC,LROLLOC,LRSPEC,LRDUZ)
29 I '$L(COMBINE) S (NEWORD,ZTQUEUED)=1 L +^LRO(69,$E(DT,1,3)_"0000",2) D ORDER^LROW2 K ZTSK,ZTQUEUED,ZTREQ G LOCK
30 I $E(COMBINE,1,2)="S." S LRSN=$P(COMBINE,".",2),LRORD=$P(COMBINE,".",3) G ADD ;Combine on specimen
31 I $E(COMBINE,1,2)="O."!($E(COMBINE,1,2)="C.") S LRORD=$S($E(COMBINE,1,2)="O.":$P(COMBINE,".",2),1:$P(COMBINE,".",3)) ;Combine on order #
32LOCK ;
33 L +^LRO(69,LRODT,1):360
34 I '$T G LOCK
35 S LRSN=1+$O(^LRO(69,LRODT,1,999999999),-1),LRSUM=1+$S($D(^LRO(69,LRODT,1,0)):$P(^(0),U,4),1:0)
36ZSN ;
37 I $D(^LRO(69,LRODT,1,LRSN,0)) S LRSN=LRSN+1 G ZSN
38 S ^LRO(69,LRODT,1,LRSN,0)=LRDFN_"^"_LRDUZ_"^"_+LRSAMP_"^"_LRORDR_"^"_LRNT_"^"_LRPRAC_"^"_LRLLOC_"^"_LRSDT_"^"_LROLLOC_"^^"_ORIFN,^LRO(69,LRODT,1,0)="^69.01PA^"_LRSN_"^"_LRSUM
39 L -^LRO(69,LRODT,1)
40 S ^LRO(69,LRODT,1,"AA",LRDFN,LRSN)="",^TMP("OR",$J,"LROT",LRSDT,LRXZ,LRSAMP,LRSPEC,"SN")=LRSN,^LRO(69,"D",LRDFN,LRODT,LRSN)=""
41 I $L(LRLLOC) S ^LRO(69,LRODT,1,"AC",LRLLOC,LRSN)=""
42 I $L(LRSPEC) S ^LRO(69,LRODT,1,LRSN,4,0)="^69.02PA^1^1",^(1,0)=LRSPEC
43 S ^LRO(69,LRODT,1,LRSN,.1)=LRORD,^LRO(69,"C",+LRORD,LRODT,LRSN)=""
44 I $G(NEWORD) L -^LRO(69,$E(DT,1,3)_"0000",2)
45ADD ;
46 N I,J,LRJ,LRSXN,LRORIFN,NODE,STATUS
47 S ^TMP("OR",$J,"LRES","CTR")=^TMP("OR",$J,"LRES","CTR")+1,^TMP("OR",$J,"LRES",LRDFN,LRSDT,LRXZ,^TMP("OR",$J,"LRES","CTR"))=LRORD_"^"_LRODT_"^"_LRSN
48 S LRORIFN=+$G(^TMP("OR",$J,"LROT",LRSDT,LRXZ,LRSAMP,LRSPEC,0))
49 S J=0
50 F LRJ=1:1 S J=$O(^TMP("OR",$J,"LROT",LRSDT,LRXZ,LRSAMP,LRSPEC,J)) Q:J<1 S NODE=^(J),STATUS=$G(^(J,1)) D ZSN1(NODE,STATUS)
51 S (LRSXN,I)=0
52 F S I=$O(^LRO(69,LRODT,1,LRSN,2,I)) Q:I<1 S LRSXN=LRSXN+1
53 S:LRSXN ^LRO(69,LRODT,1,LRSN,2,0)="^69.03PA^"_LRSXN_"^"_LRSXN
54 I $E(COMBINE,1,2)="C." D
55 . S (LRSXN,I)=0 F S I=$O(^LRO(69,LRODT,1,+$P(COMBINE,".",2),2,I)) Q:I<1 S LRSXN=LRSXN+1
56 . S:LRSXN ^LRO(69,LRODT,1,+$P(COMBINE,".",2),2,0)="^69.03PA^"_LRSXN_"^"_LRSXN
57 Q
58ZSN1(NODE,STATUS) ;Add tests
59 N CNT,XI,X,I,C,TCNT
60 S CNT=+$O(^LRO(69,LRODT,1,LRSN,2,99999),-1)
61 S LRTSTS=+NODE,LRQUANT=$P(NODE,"^",2)
62 I $D(^LRO(69,LRODT,1,LRSN,2,"B",LRTSTS)) S REJECT(LRTSTS)="" Q
63 S ^LRO(69,LRODT,1,LRSN,2,CNT+LRJ,0)=LRTSTS_"^"_$S($L(STATUS):STATUS,1:LROUTINE)_"^^^^^"_LRORIFN
64 D SDGX69^LRBEBA2(J,(CNT+LRJ)_","_LRSN_","_LRODT_",")
65 I $O(^TMP("OR",$J,"COM",LRSDT,LRXZ,LRSAMP,LRSPEC,J,0)) D
66 . S X=^TMP("OR",$J,"COM",LRSDT,LRXZ,LRSAMP,LRSPEC,J)+$S($P($G(^LRO(69,LRODT,1,LRSN,2,CNT+LRJ,1,0)),"^",4):$P(^(0),"^",4),1:0),^LRO(69,LRODT,1,LRSN,2,CNT+LRJ,1,0)="^^"_X_"^"_X_"^"_DT
67 . S TCNT=+$O(^LRO(69,LRODT,1,LRSN,2,CNT+LRJ,1,99999),-1),(C,I)=0
68 . F S I=$O(^TMP("OR",$J,"COM",LRSDT,LRXZ,LRSAMP,LRSPEC,J,I)) Q:I<1 S C=C+1,^LRO(69,LRODT,1,LRSN,2,CNT+LRJ,1,C+TCNT,0)=^TMP("OR",$J,"COM",LRSDT,LRXZ,LRSAMP,LRSPEC,J,I)
69 S ^LRO(69,LRODT,1,LRSN,2,"B",LRTSTS,CNT+LRJ)=""
70 S ^LRO(69,"AT",LRDFN,LRTSTS,LRSPEC,LRODT)="",^(-LRODT)=""
71 I $E(COMBINE,1,2)="C." S X=^LRO(69,LRODT,1,LRSN,2,CNT+LRJ,0),$P(^(0),"^",6)=LRORD,XI=$P($G(^LRO(69,LRODT,1,LRSN,1)),"^",7),XI=XI_LRORD_"/",$P(^(1),"^",7)=XI D
72 . N CNT1
73 . S CNT1=$O(^LRO(69,LRODT,1,+$P(COMBINE,".",2),2,99999),-1)+1,^(CNT1,0)=X,$P(^(0),"^",14)=LRODT_";"_LRSN_";"_(CNT+LRJ),^LRO(69,LRODT,1,$P(COMBINE,".",2),2,"B",LRTSTS,CNT1)=""
74 Q
75DT ;
76 S DT=$$DT^XLFDT()
77 S LRNT=$P($H,",",2),LRNT=LRNT\3600*100+(LRNT\60#60)/10000+DT
78 Q
Note: See TracBrowser for help on using the repository browser.