source: WorldVistAEHR/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7VORR1.m@ 701

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

initial load of WorldVistAEHR

File size: 4.0 KB
Line 
1LA7VORR1 ;BIRMFO/DLR - LAB ORM (Order Response) message builder ; 12-12-96
2 ;;5.2;LAB MESSAGING;**27**;Sep 27, 1994
3EN(LA) ;
4 S GBL="^TMP(""HLS"","_$J_")",ORDER="^LRO(69.6)"
5 ;assuming the receiving institution is the primary site (site with the computer system)
6 ; LA("AUTO-INST") - Auto-Instrument
7 N PRIMARY S PRIMARY=$$PRIM^VASITE(DT) I $G(PRIMARY)'="" S PRIMARY=$$SITE^VASITE(DT,PRIMARY) S PRIMARY=$P(PRIMARY,U,3)
8 S LA("AUTO-INST")="LA7V HOST "_PRIMARY
9 D MSA,PID,ACC
10EXIT Q
11MSA ;
12 N ID
13 S ID=$O(^LRO(69.6,"RST",LA("SITE"),LA("RUID"),0)) I $G(ID)'="" S ID=$P(^LRO(69.6,ID,1),U,8)
14 S @GBL@(LA("I"))="MSA"_HL("FS")_"AA"_HL("FS")_$G(ID)
15 S LA("I")=LA("I")+1
16 Q
17PID ;Original routine saved as all lower case Frank
18 ;S HLFS="^",HLECH="~|&\",HLQ="""""",HLCOMP="~"
19 N NODE0,LRHMSG
20 Q:$G(LA("LRDFN"))=""
21 ;Q:LA("LRDFN")=$G(LA("LLRDFN"))
22 I $P(^LR(LA("LRDFN"),0),U,2)=2 S DFN=$P(^LR(LA("LRDFN"),0),U,3) S (LRHMSG,@GBL@(LA("I")))=$$EN^VAFHLPID(DFN,"1,3,5,7,8,19",1),$P(@GBL@(LA("I")),HLFS,4)=$$M11^HLFNC(LA("LRDFN"))
23 I $P(^LR(LA("LRDFN"),0),U,2)=67 D
24 . S NODE0=^LR(LA("LRDFN"),0),DFN=$P(NODE0,U,3)
25 . S LRHMSG="PID"_HLFS_LA("PCNT")_HLFS_HLFS_$$M11^HLFNC(LA("LRDFN"))_HLFS_HLFS_$$HLNAME^HLFNC($P(^LRT(67,DFN,0),U),HLECH)
26 . S LRHMSG=LRHMSG_HLFS_HLFS_$$HLDATE^HLFNC($P(NODE0,U,3),"DT")_HLFS_$P(NODE0,U,2)
27 . S @GBL@(LA("I"))=LRHMSG
28 S LA("I")=LA("I")+1,LA("PCNT")=$G(LA("PCNT"))+1
29 S LA("LLRDFN")=LA("LRDFN")
30 Q
31ACC ;
32 N LRAA,LRAD,LRAN
33 S LRAA=0 F S LRAA=$O(^LRO(68,"C",LA("RUID"),LRAA)) Q:'LRAA S LRAD=0 F S LRAD=$O(^LRO(68,"C",LA("RUID"),LRAA,LRAD)) Q:'LRAD S LRAN=0 F S LRAN=$O(^LRO(68,"C",LA("RUID"),LRAA,LRAD,LRAN)) Q:'LRAN D OBR
34 Q
35PV1 ;
36 S @GBL@(LA("I"))="PV1"_HLFS_1_HLFS_HLFS_$P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,7),LA("I")=LA("I")+1
37 Q
38ORC ;Order Control
39 N ORC
40 S @GBL@(LA("I"))="ORC"
41 S ORC(1)="OK"
42 S ORC(2)=LA("RUID")
43 S ORC(3)=LA("HUID")
44 S ORC(9)=$$HLDATE^HLFNC($P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,4)) ; Order Date/Time
45 S ORC(12)=$$HLNAME^HLFNC($$GET1^DIQ(68.02,LRAN_","_LRAD_","_LRAA_",",6.5))
46 F X=1:1:27 S @GBL@(LA("I"))=$G(@GBL@(LA("I")))_HLFS_$G(ORC(X))
47 S LA("I")=$G(LA("I"))+1
48 Q
49OBR ;Observation Request segment for Lab Order
50 N OBR,RCNT
51 S LTN=0 F S LTN=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LTN)) Q:'LTN D
52 . ;Q:$P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LTN,0),U,10)'=LA7V("IEN")
53 . D ORC
54 . S OBR(1)=$G(RCNT)+1,@GBL@(LA("I"))="OBR" ;initialize OBR segment
55 . S OBR(2)=LA("RUID") ; Remote UID
56 . S OBR(3)=LA("HUID") ; Host UID
57 . S LTN=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LTN,0),U),LRACC=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,.2),U),LTST=$P(^LAB(60,LTN,0),U) I $D(^LAB(60,LTN,64)) S NLTIEN=$P(^LAB(60,LTN,64),U) I NLTIEN=""!'$D(^LAM(NLTIEN,0)) K OBR Q
58 . S NTST=$P(^LAM(NLTIEN,0),U),NLT=$P(^LAM(NLTIEN,0),U,2)
59 . S OBR(4)=NLT_HLCOMP_NTST_HLCOMP_"99VA64"_HLCOMP_LTN_HLCOMP_LTST_HLCOMP_"99VA60" ; WKLD code/text/"99VA64"
60 . ;check to see if this TEST is setup in Auto-Instrument
61 . S OBR(7)=$$HLDATE^HLFNC($P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U)) ; Collection D/T
62 . ;S OBR(8)=$$HLDATE^HLFNC() ; DT Results Avail
63 . S OBR(12)=$P($G(^LR(LA("LRDFN"),.091)),U) ; Infection Warning
64 . S OBR(14)=$$HLDATE^HLFNC($P(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),0),U)) ; Lab Arrival Time
65 . ;S OBR(15)=$$GET1^DIQ(61,+$P(@SHP@(LA7V("IEN"),10,LA7V("S"),0),U,3)_",",.08)_HLSUB_$$GET1^DIQ(61,+$P(@SHP@(LA7V("IEN"),10,LA7V("S"),0),U,3)_",",.01)_HLSUB_"0070"
66 . S LA7CSI=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,5,0)) I LA7CSI'="" S LA7CS=$P(^(LA7CSI,0),U,2)
67 . S OBR(15)=$G(OBR(15))_HLCOMP_HLCOMP_$$GET1^DIQ(62,+$G(LA7CS)_",",.01)_HLCOMP_HLCOMP_HLCOMP ; Specimen source
68 . S OBR(18)=LA("AUTO-INST") ; Placer Field #1 (HOST site)
69 . S $P(OBR(19),HLCOMP,7)=LA("RUID") ; Placer Field #2
70 . S $P(OBR(27),HLCOMP,6)=$$GET1^DIQ(68.04,LTN_","_LRAN_","_LRAD_","_LRAA_",",1)
71 . F X=1:1:27 S @GBL@(LA("I"))=$G(@GBL@(LA("I")))_HLFS_$G(OBR(X))
72 . S LA("I")=$G(LA("I"))+1,RCNT=+$G(RCNT)+1
73 . D CHKTST
74 K LA7CS,LA7CSI
75 Q
76CHKTST ;
77 S X="LA7V HOST "_LA("SITE"),DIC=62.4,DIC(0)="ME" D ^DIC I Y>0 S TIEN=+Y,X=LTST,DIC="^LAB(62.4,"_TIEN_",3," D ^DIC I Y<1 D
78 . S DA(1)=TIEN,DIC("P")=$P(^DD(62.4,30,0),U,2),DIC(0)="L",DIC("DR")=".01///"_X_";6///"_NLT D ^DIC
79 Q
Note: See TracBrowser for help on using the repository browser.