lab rpms extract routines
This commit is contained in:
george
parent
1fb0489ae3
commit
62b6eeeaf0
|
|
@ -0,0 +1,220 @@
|
||||||
|
C0CENV ;WV/JMC - CCD/CCR Environment Check/Install Routine; July 21, 2009
|
||||||
|
;;1.0;C0C;;May 19, 2009;
|
||||||
|
;
|
||||||
|
;
|
||||||
|
ENV ; Does not prevent loading of the transport global.
|
||||||
|
; Environment check is done only during the install.
|
||||||
|
;
|
||||||
|
N XQA,XQAMSG
|
||||||
|
;
|
||||||
|
;
|
||||||
|
; Make sure the patch name exist
|
||||||
|
;
|
||||||
|
I '$D(XPDNM) D Q
|
||||||
|
. D BMES("No valid patch name exist")
|
||||||
|
. S XPDQUIT=2
|
||||||
|
. D EXIT
|
||||||
|
;
|
||||||
|
D CHECK
|
||||||
|
D EXIT
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
;
|
||||||
|
CHECK ; Perform environment check
|
||||||
|
;
|
||||||
|
I $S('$G(IOM):1,'$G(IOSL):1,$G(U)'="^":1,1:0) D
|
||||||
|
. D BMES("Terminal Device is not defined")
|
||||||
|
. S XPDQUIT=2
|
||||||
|
;
|
||||||
|
I $S('$G(DUZ):1,$D(DUZ)[0:1,$D(DUZ(0))[0:1,1:0) D
|
||||||
|
. D BMES("Please log in to set local DUZ... variables")
|
||||||
|
. S XPDQUIT=2
|
||||||
|
;
|
||||||
|
I $P($$ACTIVE^XUSER(DUZ),"^")'=1 D
|
||||||
|
. D BMES("You are not a valid user on this system")
|
||||||
|
. S XPDQUIT=2
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
;
|
||||||
|
EXIT ;
|
||||||
|
;
|
||||||
|
;
|
||||||
|
I $G(XPDQUIT) D BMES("--- Install Environment Check FAILED ---") Q
|
||||||
|
D BMES("--- Environment Check is Ok ---")
|
||||||
|
;
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
;
|
||||||
|
PRE ;Pre-install entry point
|
||||||
|
;
|
||||||
|
; No action needed in pre-install
|
||||||
|
D BMES("No action need for pre-install")
|
||||||
|
;
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
;
|
||||||
|
POST ;Post install
|
||||||
|
;
|
||||||
|
; Check for RPMS system with V LAB file.
|
||||||
|
;
|
||||||
|
I $$VFILE^DILFD(9000010.09)'=1 Q
|
||||||
|
;
|
||||||
|
S %=$$NEWCP^XPDUTL("RPMS1","POST1^C0CENV")
|
||||||
|
S %=$$NEWCP^XPDUTL("RPMS2","POST2^C0CENV")
|
||||||
|
S %=$$NEWCP^XPDUTL("RPMS3","POST3^C0CENV")
|
||||||
|
S %=$$NEWCP^XPDUTL("RPMS4","POST4^C0CENV")
|
||||||
|
S %=$$NEWCP^XPDUTL("RPMS5","POST5^C0CENV")
|
||||||
|
S %=$$NEWCP^XPDUTL("RPMS6","POST6^C0CENV")
|
||||||
|
S %=$$NEWCP^XPDUTL("RPMS7","POST7^C0CENV")
|
||||||
|
;
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
;
|
||||||
|
POST1 ; Checkpoint call back entry point.
|
||||||
|
; Add new style ALR1 cross-reference to V LAB file.
|
||||||
|
;
|
||||||
|
N MSG
|
||||||
|
S MSG="Starting installation of ALR1 cross-reference at "_$$HTE^XLFDT($H,"1Z")
|
||||||
|
D BMES(MSG)
|
||||||
|
D ALR1^C0CLA7DD
|
||||||
|
S MSG="Installation of ALR1 cross-reference completed at "_$$HTE^XLFDT($H,"1Z")
|
||||||
|
D BMES(MSG)
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
;
|
||||||
|
POST2 ; Checkpoint call back entry point.
|
||||||
|
; Add new style ALR2 cross-reference to V LAB file.
|
||||||
|
;
|
||||||
|
N MSG
|
||||||
|
S MSG="Starting installation of ALR2 cross-reference at "_$$HTE^XLFDT($H,"1Z")
|
||||||
|
D BMES(MSG)
|
||||||
|
D ALR2^C0CLA7DD
|
||||||
|
S MSG="Installation of ALR2 cross-reference completed at "_$$HTE^XLFDT($H,"1Z")
|
||||||
|
D BMES(MSG)
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
;
|
||||||
|
POST3 ; Checkpoint call back entry point.
|
||||||
|
; Add new style ALR3 cross-reference to V LAB file.
|
||||||
|
;
|
||||||
|
N MSG
|
||||||
|
S MSG="Starting installation of ALR3 cross-reference at "_$$HTE^XLFDT($H,"1Z")
|
||||||
|
D BMES(MSG)
|
||||||
|
D ALR3^C0CLA7DD
|
||||||
|
S MSG="Installation of ALR3 cross-reference completed at "_$$HTE^XLFDT($H,"1Z")
|
||||||
|
D BMES(MSG)
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
;
|
||||||
|
POST4 ; Checkpoint call back entry point.
|
||||||
|
; Add new style ALR4 cross-reference to V LAB file.
|
||||||
|
;
|
||||||
|
N MSG
|
||||||
|
S MSG="Starting installation of ALR4 cross-reference at "_$$HTE^XLFDT($H,"1Z")
|
||||||
|
D BMES(MSG)
|
||||||
|
D ALR4^C0CLA7DD
|
||||||
|
S MSG="Installation of ALR4 cross-reference completed at "_$$HTE^XLFDT($H,"1Z")
|
||||||
|
D BMES(MSG)
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
;
|
||||||
|
POST5 ; Checkpoint call back entry point.
|
||||||
|
; Add new style ALR5 cross-reference to V LAB file.
|
||||||
|
;
|
||||||
|
N MSG
|
||||||
|
S MSG="Starting installation of ALR5 cross-reference at "_$$HTE^XLFDT($H,"1Z")
|
||||||
|
D BMES(MSG)
|
||||||
|
D ALR5^C0CLA7DD
|
||||||
|
S MSG="Installation of ALR5 cross-reference completed at "_$$HTE^XLFDT($H,"1Z")
|
||||||
|
D BMES(MSG)
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
;
|
||||||
|
POST6 ; Checkpoint call back entry point.
|
||||||
|
; Check for RPMS system and determine LAB patch level
|
||||||
|
; and need to load in C0C version of LA7 routines.
|
||||||
|
;
|
||||||
|
N MSG
|
||||||
|
;
|
||||||
|
; Load and rename C0CQRY2 to LA7QRY2 if LA*5.2*69 not installed
|
||||||
|
I '$$PATCH^XPDUTL("LA*5.2*69") D
|
||||||
|
. S MSG="This system missing LAB patch LA*5.2*69"
|
||||||
|
. D BMES(MSG)
|
||||||
|
. S MSG="Renaming routine C0CQRY2 to LA7QRY2"
|
||||||
|
. D BMES(MSG)
|
||||||
|
. D LOAD("C0CQRY2")
|
||||||
|
. D SAVE("C0CQRY2","LA7QRY2")
|
||||||
|
;
|
||||||
|
; Load and rename C0CVOBX1 to LA7VOBX1 if LA*5.2*64 not installed.
|
||||||
|
I '$$PATCH^XPDUTL("LA*5.2*64") D
|
||||||
|
. S MSG="This system missing LAB patch LA*5.2*64"
|
||||||
|
. D BMES(MSG)
|
||||||
|
. S MSG="Renaming routine C0CVOBX1 to LA7VOBX1"
|
||||||
|
. D BMES(MSG)
|
||||||
|
. D LOAD("C0CVOBX1")
|
||||||
|
. D SAVE("C0CVOBX1","LA7VOBX1")
|
||||||
|
;
|
||||||
|
; Load and rename C0CQRY1 to LA7QRY1 if LA*5.2*68 not installed.
|
||||||
|
I '$$PATCH^XPDUTL("LA*5.2*68") D
|
||||||
|
. S MSG="Renaming routine C0CQRY1 to LA7QRY1"
|
||||||
|
. D BMES(MSG)
|
||||||
|
. D LOAD("C0CQRY1")
|
||||||
|
. D SAVE("C0CQYR1","LA7QRY1")
|
||||||
|
;
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
;
|
||||||
|
POST7 ; Checkpoint call back entry point.
|
||||||
|
; Task setting the data in the indexes.
|
||||||
|
;
|
||||||
|
N MSG,ZTDESC,ZTDTH,ZTIO,ZTSK,ZTRTN,ZTSAVE
|
||||||
|
;
|
||||||
|
; If TaskMan not running then peform post-intall directly (interactively)
|
||||||
|
I '$$TM^%ZTLOAD D Q
|
||||||
|
. S MSG="TaskMan is not running"
|
||||||
|
. D BMES(MSG)
|
||||||
|
. S MSG="Will run indexing interactively"
|
||||||
|
. D BMES(MSG)
|
||||||
|
. D REINDEX^C0CLA7DD
|
||||||
|
;
|
||||||
|
; If KIDS install has been tasked then run post-install during this task.
|
||||||
|
I $D(ZTQUEUED) D REINDEX^C0CLA7DD Q
|
||||||
|
;
|
||||||
|
S MSG="Tasking setting data into new V LAB indexes"
|
||||||
|
D BMES(MSG)
|
||||||
|
;
|
||||||
|
S ZTRTN="REINDEX^C0CLA7DD",ZTDESC="C0C post-install - V LAB x-refs indexing"
|
||||||
|
S ZTIO="",ZTDTH=$H,ZTSAVE("XP*")=""
|
||||||
|
D ^%ZTLOAD
|
||||||
|
;
|
||||||
|
I ZTSK>0 D
|
||||||
|
. S MSG="Task "_ZTSK_" tasked to set data into ALR* cross-references to V LAB file."
|
||||||
|
. D BMES(MSG)
|
||||||
|
E D
|
||||||
|
. S MSG="Tasking of indexing of V LAB file failed"
|
||||||
|
. D BMES(MSG)
|
||||||
|
;
|
||||||
|
;
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
;
|
||||||
|
BMES(STR) ; Write BMES^XPDUTL statements
|
||||||
|
;
|
||||||
|
D BMES^XPDUTL($$CJ^XLFSTR(STR,IOM))
|
||||||
|
;
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
;
|
||||||
|
LOAD(X) ; load routine X
|
||||||
|
N %N,DIF,XCNP
|
||||||
|
K ^TMP($J,X)
|
||||||
|
S DIF="^TMP($J,X,",XCNP=0
|
||||||
|
X ^%ZOSF("LOAD")
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
;
|
||||||
|
SAVE(OLD,NEW) ; restore routine X
|
||||||
|
N %,DIE,X,XCM,XCN,XCS
|
||||||
|
S DIE="^TMP($J,"_OLD_",",XCN=0,X=NEW
|
||||||
|
X ^%ZOSF("SAVE")
|
||||||
|
Q
|
||||||
|
|
@ -0,0 +1,274 @@
|
||||||
|
C0C7VORU ;WV/JMC - Builder of HL7 Lab Results OBR/OBX/NTE based on RPMS V LAB file ;Jun 16, 2009
|
||||||
|
;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
|
||||||
|
;
|
||||||
|
EN(LA) ; called from C0CVLAB
|
||||||
|
; variables
|
||||||
|
; LA("HUID") - Host Unique ID from the local ACCESSION file (#68)
|
||||||
|
; LA("SITE") - Ordering site IEN in the INSTITUTION file (#4)
|
||||||
|
; LA("RUID") - Remote sites Unique ID from ACCESSION file (#68)
|
||||||
|
; LA("ORD") - Free text ordered test name from WKLD CODE file (#64)
|
||||||
|
; LA("NLT") - National Laboratory test code from WKLD CODE file (#64)
|
||||||
|
; LA("LRIDT") - Inverse date/time the lab arrival time (accession date/time)
|
||||||
|
; LA("SUB") - test subscript defined in LABORATORY TEST file (#60)
|
||||||
|
; LA("LRDFN") - IEN in LAB DATA file (#63)
|
||||||
|
; LA("ORD"), LA("NLT"), and LA("SUB") are sent for specific lab results.
|
||||||
|
; LA("AUTO-INST") - Auto-Instrument
|
||||||
|
;
|
||||||
|
N LA763,LA7NLT,LA7NVAF,LA7X,PRIMARY
|
||||||
|
;
|
||||||
|
S PRIMARY=$$PRIM^VASITE(DT),LA("AUTO-INST")=""
|
||||||
|
I $G(PRIMARY)'="" D
|
||||||
|
. S PRIMARY=$$SITE^VASITE(DT,PRIMARY)
|
||||||
|
. S PRIMARY=$P(PRIMARY,U,3)
|
||||||
|
. S LA("AUTO-INST")="LA7V HOST "_PRIMARY
|
||||||
|
;
|
||||||
|
I '$O(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),0)) D Q
|
||||||
|
. ; need to add error logging when no entry in 63.
|
||||||
|
;
|
||||||
|
; Get zeroth node of entry in #63.
|
||||||
|
S LA763(0)=$G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),0))
|
||||||
|
S LA7NLT=$G(LA("NLT"))
|
||||||
|
;
|
||||||
|
S LA7NVAF=$$NVAF^LA7VHLU2(+LA("SITE"))
|
||||||
|
S LA7NTESN=0
|
||||||
|
D ORC
|
||||||
|
;
|
||||||
|
I $G(LA("SUB"))="CH" D CH
|
||||||
|
;I $G(LA("SUB"))="MI" D MI^LA7VORU1
|
||||||
|
;I "SPCYEM"[$G(LA("SUB")) D AP^LA7VORU2
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
;
|
||||||
|
CH ; Build segments for "CH" subscript
|
||||||
|
;
|
||||||
|
D OBR
|
||||||
|
D NTE
|
||||||
|
S LA7OBXSN=0
|
||||||
|
D OBX
|
||||||
|
;
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
;
|
||||||
|
ORC ; Build ORC segment
|
||||||
|
;
|
||||||
|
N LA763,LA7696,LA7DATA,LA7SM,LA7X,LA7Y,ORC
|
||||||
|
;
|
||||||
|
S LA763(0)=$G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),0))
|
||||||
|
;
|
||||||
|
S ORC(0)="ORC"
|
||||||
|
;
|
||||||
|
; Order control
|
||||||
|
S ORC(1)=$$ORC1^LA7VORC("RE")
|
||||||
|
;
|
||||||
|
; Remote UID
|
||||||
|
S ORC(2)=$$ORC2^LA7VORC(LA("RUID"),LA7FS,LA7ECH)
|
||||||
|
;
|
||||||
|
; Host UID
|
||||||
|
S ORC(3)=$$ORC3^LA7VORC(LA("HUID"),LA7FS,LA7ECH)
|
||||||
|
;
|
||||||
|
; Return shipping manifest if found
|
||||||
|
S LA7SM="",LA7696=0
|
||||||
|
I LA("SITE")'="",LA("RUID")'="" S LA7696=$O(^LRO(69.6,"RST",LA("SITE"),LA("RUID"),0))
|
||||||
|
I LA7696 S LA7SM=$P($G(^LRO(69.6,LA7696,0)),U,14)
|
||||||
|
I LA7SM'="" S ORC(4)=$$ORC4^LA7VORC(LA7SM,LA7FS,LA7ECH)
|
||||||
|
;
|
||||||
|
; Order status
|
||||||
|
; DoD/CHCS requires ORC-5 valued otherwise will not process message
|
||||||
|
I LA7NVAF=1 S ORC(5)=$$ORC5^LA7VORC("CM",LA7FS,LA7ECH)
|
||||||
|
;
|
||||||
|
; Ordering provider
|
||||||
|
S (LA7X,LA7Y)=""
|
||||||
|
; "CH" subscript stores requesting provider and requesting div/location.
|
||||||
|
I LA("SUB")="CH" D
|
||||||
|
. N LA7J
|
||||||
|
. S LA7J=$P(LA763(0),"^",13)
|
||||||
|
. I $P(LA7J,";",2)="SC(" S LA7Y=$$GET1^DIQ(44,$P(LA7J,";")_",",3,"I")
|
||||||
|
. I $P(LA7J,";",2)="DIC(4," S LA7Y=$P(LA7J,";")
|
||||||
|
. S LA7X=$P(LA763(0),"^",10)
|
||||||
|
;
|
||||||
|
; Other subscripts only store requesting provider
|
||||||
|
I "CYEMMISP"[LA("SUB") S LA7X=$P(LA763(0),"^",7)
|
||||||
|
; Get default institution from MailMan Site Parameters file
|
||||||
|
I LA7Y="" S LA7Y=$$GET1^DIQ(4.3,"1,",217,"I")
|
||||||
|
S ORC(12)=$$ORC12^LA7VORC(LA7X,LA7Y,LA7FS,LA7ECH)
|
||||||
|
;
|
||||||
|
; Entering organization
|
||||||
|
S ORC(17)=$$ORC17^LA7VORC(LA7Y,LA7FS,LA7ECH)
|
||||||
|
;
|
||||||
|
D BUILDSEG^LA7VHLU(.ORC,.LA7DATA,LA7FS)
|
||||||
|
D FILESEG^LA7VHLU(GBL,.LA7DATA)
|
||||||
|
;
|
||||||
|
; Check for flag to only build message but do not file
|
||||||
|
I '$G(LA7NOMSG) D FILE6249^LA7VHLU(LA76249P,.LA7DATA)
|
||||||
|
;
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
;
|
||||||
|
OBR ;Observation Request segment for Lab Order
|
||||||
|
;
|
||||||
|
N LA761,LA762,LA7DATA,LA7PLOBR,LA7X,LA7Y,OBR
|
||||||
|
;
|
||||||
|
; Retrieve placer's OBR information stored in #69.6
|
||||||
|
D RETOBR^LA7VHLU(LA("SITE"),LA("RUID"),LA("NLT"),.LA7PLOBR)
|
||||||
|
;
|
||||||
|
; Initialize OBR segment
|
||||||
|
S OBR(0)="OBR"
|
||||||
|
S OBR(1)=$$OBR1^LA7VOBR(.LA7OBRSN)
|
||||||
|
;
|
||||||
|
; Remote UID
|
||||||
|
S OBR(2)=$$OBR2^LA7VOBR(LA("RUID"),LA7FS,LA7ECH)
|
||||||
|
;
|
||||||
|
; Host UID
|
||||||
|
S OBR(3)=$$OBR3^LA7VOBR(LA("HUID"),LA7FS,LA7ECH)
|
||||||
|
;
|
||||||
|
; Universal service ID, build from info stored in #69.6
|
||||||
|
S LA7X=""
|
||||||
|
I $G(LA7PLOBR("OBR-4"))'="" S OBR(4)=$$CNVFLD^LA7VHLU3(LA7PLOBR("OBR-4"),LA7PLOBR("ECH"),LA7ECH)
|
||||||
|
E S OBR(4)=$$OBR4^LA7VOBR(LA7NLT,"",LA7X,LA7FS,LA7ECH)
|
||||||
|
;
|
||||||
|
; Collection D/T
|
||||||
|
S OBR(7)=$$OBR7^LA7VOBR($P(LA763(0),U))
|
||||||
|
;
|
||||||
|
; Specimen action code
|
||||||
|
; If no OBR from PENDING ORDER file (#69.6) then assume added test.
|
||||||
|
I $G(LA7INTYP)=10,$G(LA7PLOBR("OBR-4"))="" S OBR(11)=$$OBR11^LA7VOBR("A")
|
||||||
|
;
|
||||||
|
; Infection Warning
|
||||||
|
S OBR(12)=$$OBR12^LA7VOBR(LRDFN,LA7FS,LA7ECH)
|
||||||
|
;
|
||||||
|
; Lab Arrival Time
|
||||||
|
; "CH" subscript does not store lab arrival time, use collection time.
|
||||||
|
; Other subscripts do store lab arrival time (date/time received).
|
||||||
|
I "CYEMMISP"[LA("SUB") S OBR(14)=$$OBR14^LA7VOBR($P(LA763(0),"^",10))
|
||||||
|
I LA("SUB")="CH" S OBR(14)=$$OBR14^LA7VOBR($P(LA763(0),"^"))
|
||||||
|
;
|
||||||
|
; Specimen source
|
||||||
|
S (LA761,LA762)=""
|
||||||
|
I "CHMI"[LA("SUB") D
|
||||||
|
. S LA761=$P(LA763(0),U,5)
|
||||||
|
. I LA761="" D CREATE^LA7LOG(27)
|
||||||
|
. I LA("SUB")="MI" S LA762=$P(LA763(0),U,11)
|
||||||
|
S OBR(15)=$$OBR15^LA7VOBR(LA761,LA762,"",LA7FS,LA7ECH)
|
||||||
|
;
|
||||||
|
; Ordering provider
|
||||||
|
S (LA7X,LA7Y)=""
|
||||||
|
; "CH" subscript stores requesting provider and requesting div/location.
|
||||||
|
I LA("SUB")="CH" D
|
||||||
|
. N LA7J
|
||||||
|
. S LA7J=$P(LA763(0),"^",13)
|
||||||
|
. I $P(LA7J,";",2)="SC(" S LA7Y=$$GET1^DIQ(44,$P(LA7J,";")_",",3,"I")
|
||||||
|
. I $P(LA7J,";",2)="DIC(4," S LA7Y=$P(LA7J,";")
|
||||||
|
. S LA7X=$P(LA763(0),"^",10)
|
||||||
|
;
|
||||||
|
; Other subscripts only store requesting provider
|
||||||
|
I "CYEMMISP"[LA("SUB") S LA7X=$P(LA763(0),"^",7)
|
||||||
|
; Get default institution from MailMan Site Parameters file
|
||||||
|
I LA7Y="" S LA7Y=$$GET1^DIQ(4.3,"1,",217,"I")
|
||||||
|
S OBR(16)=$$ORC12^LA7VORC(LA7X,LA7Y,LA7FS,LA7ECH)
|
||||||
|
;
|
||||||
|
; Placer Field #1 (remote auto-inst)
|
||||||
|
; Build from info stored in #69.6
|
||||||
|
I $G(LA7PLOBR("OBR-18"))'="" D
|
||||||
|
. S OBR(18)=$$CHKDATA^LA7VHLU3(LA7PLOBR("OBR-18"),LA7FS_LA7ECH)
|
||||||
|
; Else build "auto instrument" if sending to VA facility
|
||||||
|
I $G(LA7PLOBR("OBR-18"))="",'LA7NVAF D
|
||||||
|
. N LA7X
|
||||||
|
. S LA7X(1)=LA("AUTO-INST")
|
||||||
|
. S OBR(18)=$$OBR18^LA7VOBR(.LA7X,LA7FS,LA7ECH)
|
||||||
|
;
|
||||||
|
; Placer Field #2
|
||||||
|
I $G(LA7PLOBR("OBR-19"))'="" D
|
||||||
|
. S OBR(19)=$$CHKDATA^LA7VHLU3(LA7PLOBR("OBR-19"),LA7FS_LA7ECH)
|
||||||
|
; Else build collecting UID if sending to VA facility
|
||||||
|
I $G(LA7PLOBR("OBR-19"))="",'LA7NVAF,LA("RUID")'="" D
|
||||||
|
. K LA7X
|
||||||
|
. S LA7X(7)=LA("RUID")
|
||||||
|
. S OBR(19)=$$OBR19^LA7VOBR(.LA7X,LA7FS,LA7ECH)
|
||||||
|
;
|
||||||
|
; Filler Field #1
|
||||||
|
; Send file #63 ien info - used by HDR to track patient/specimen
|
||||||
|
K LA7X
|
||||||
|
S LA7X(1)=LA("LRDFN")
|
||||||
|
S LA7X(2)=LA("SUB")
|
||||||
|
S LA7X(3)=LA("LRIDT")
|
||||||
|
S OBR(20)=$$OBR20^LA7VOBR(.LA7X,LA7FS,LA7ECH)
|
||||||
|
;
|
||||||
|
; Date Report Completed
|
||||||
|
I $P(LA763(0),"^",3) S OBR(22)=$$OBR22^LA7VOBR($P(LA763(0),"^",3))
|
||||||
|
;
|
||||||
|
; Diagnostic service id
|
||||||
|
S OBR(24)=$$OBR24^LA7VOBR(LA("SUB")_"^"_$G(LRSB))
|
||||||
|
;
|
||||||
|
; Parent Result and Parent
|
||||||
|
I $D(LA7PARNT) D
|
||||||
|
. S OBR(26)=$$OBR26^LA7VOBR(LA7PARNT(1),LA7PARNT(2),LA7PARNT(3),LA7FS,LA7ECH)
|
||||||
|
. S OBR(29)=$$OBR29^LA7VOBR(LA("RUID"),LA("HUID"),LA7FS,LA7ECH)
|
||||||
|
;
|
||||||
|
; Principle result interpreter
|
||||||
|
; Get default institution from MailMan Site Parameters file
|
||||||
|
I "CYEMMISP"[LA("SUB") D
|
||||||
|
. I LA("SUB")="MI" S LA7X=$P(LA763(0),"^",4)
|
||||||
|
. E S LA7X=$P(LA763(0),"^",2)
|
||||||
|
. S LA7Y=$$GET1^DIQ(4.3,"1,",217,"I")
|
||||||
|
. S OBR(32)=$$OBR32^LA7VOBR(LA7X,LA7Y,LA7FS,LA7ECH)
|
||||||
|
;
|
||||||
|
; Assistant result interpreter
|
||||||
|
; Get default institution from MailMan Site Parameters file
|
||||||
|
I "EMSP"[LA("SUB") D
|
||||||
|
. S LA7X=$P(LA763(0),"^",4),LA7Y=$$GET1^DIQ(4.3,"1,",217,"I")
|
||||||
|
. S OBR(33)=$$OBR33^LA7VOBR(LA7X,LA7Y,LA7FS,LA7ECH)
|
||||||
|
;
|
||||||
|
; Technician
|
||||||
|
; Get default institution from MailMan Site Parameters file
|
||||||
|
I "CYEM"[LA("SUB") D
|
||||||
|
. S LA7X=$P(LA763(0),"^",4),LA7Y=$$GET1^DIQ(4.3,"1,",217,"I")
|
||||||
|
. S OBR(34)=$$OBR34^LA7VOBR(LA7X,LA7Y,LA7FS,LA7ECH)
|
||||||
|
;
|
||||||
|
; Typist - VistA stores as free text
|
||||||
|
; Get default institution from MailMan Site Parameters file
|
||||||
|
I "CYEMSP"[LA("SUB") D
|
||||||
|
. S LA7X=$P(LA763(0),"^",9),LA7Y=$$GET1^DIQ(4.3,"1,",217,"I")
|
||||||
|
. S OBR(35)=$$OBR35^LA7VOBR(LA7X,LA7Y,LA7FS,LA7ECH)
|
||||||
|
;
|
||||||
|
D BUILDSEG^LA7VHLU(.OBR,.LA7DATA,LA7FS)
|
||||||
|
D FILESEG^LA7VHLU(GBL,.LA7DATA)
|
||||||
|
;
|
||||||
|
; Check for flag to only build message but do not file
|
||||||
|
I '$G(LA7NOMSG) D FILE6249^LA7VHLU(LA76249,.LA7DATA)
|
||||||
|
;
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
;
|
||||||
|
OBX ;Observation/Result segment for Lab Results
|
||||||
|
;
|
||||||
|
N LA7953,LA7DATA,LA7VT,LA7VTIEN,LA7X
|
||||||
|
;
|
||||||
|
S LA7VTIEN=0
|
||||||
|
F S LA7VTIEN=$O(^LAHM(62.49,LA(62.49),1,LA7VTIEN)) Q:'LA7VTIEN D
|
||||||
|
. S LA7VT=$P(^LAHM(62.49,LA(62.49),1,LA7VTIEN,0),"^",1,2)
|
||||||
|
. ; Build OBX segment
|
||||||
|
. K LA7DATA
|
||||||
|
. D OBX^LA7VOBX(LA("LRDFN"),LA("SUB"),LA("LRIDT"),$P(LA7VT,"^",1,2),.LA7DATA,.LA7OBXSN,LA7FS,LA7ECH,$G(LA7NVAF))
|
||||||
|
. ; If OBX failed to build then don't store
|
||||||
|
. I '$D(LA7DATA) Q
|
||||||
|
. ;
|
||||||
|
. D FILESEG^LA7VHLU(GBL,.LA7DATA)
|
||||||
|
. I '$G(LA7NOMSG) D FILE6249^LA7VHLU(LA76249,.LA7DATA)
|
||||||
|
. ;
|
||||||
|
. ; Send performing lab comment and interpretation from file #60
|
||||||
|
. S LA7NTESN=0
|
||||||
|
. I LA7NVAF=1 D PLC^LA7VORUA
|
||||||
|
. D INTRP^LA7VORUA
|
||||||
|
. ;
|
||||||
|
. ; Mark result as sent - set to 1, if corrected results set to 2
|
||||||
|
. I LA("SUB")="CH" D
|
||||||
|
. . I $P(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),$P(LA7VT,"^")),"^",10)>1 Q
|
||||||
|
. . S $P(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),$P(LA7VT,"^")),"^",10)=$S($P(LA7VT,"^",2)="C":2,1:1)
|
||||||
|
;
|
||||||
|
Q
|
||||||
|
;
|
||||||
|
;
|
||||||
|
NTE ; Build NTE segment
|
||||||
|
;
|
||||||
|
D NTE^LA7VORUA
|
||||||
|
Q
|
||||||
Loading…
Reference in New Issue