LRSRVR1 ;DALOI/JMC -LAB DATA SERVER, CONT'D - LOINC SECTION ; March 25, 2002
;;5.2;LAB SERVICE;**303**;Sep 27, 1994
;
;
LOINC ; Scan for LOINC Coding
;
N LR60,LR61,LRLLINA,LRLLINB,LRLLINC,LRX
K XMY
;S XMY("G.LOINCSERVER@ISC-DALLAS.DOMAIN.EXT")=""
S XMY(XQSND)=""
S ^TMP($J,"LRDATA",1)="*"_$$NOW^XLFDT
S ^TMP($J,"LRDATA",2)="No codes defined at "_LRSTN
K ^TMP($J,"LRSERVER","LOINC")
S LINE=2,LINR=1
F LRSUB="AI","AH" D
. S LRA=""
. F S LRA=$O(^LAM(LRSUB,LRA)) Q:'LRA D
. . S LRB=""
. . F S LRB=$O(^LAM(LRSUB,LRA,LRB)) Q:LRB="" S ^TMP($J,"LRSERVER","LOINC",LRB)=""
;
S LRA=""
F S LRA=$O(^TMP($J,"LRSERVER","LOINC",LRA)) Q:LRA="" D
. K LOINCDTA,LOINCDTB,LRERR
. D GETS^DIQ(64,LRA,".01;1;25;25.5","IE","LOINCDTB","LRERR")
. D GETS^DIQ(64,LRA,"20*","IE","LOINCDTA","LRERR")
. S LRPNTB=$O(LOINCDTB(64,"")) Q:LRPNTB=""
. I LINE>2 F Q:'$D(^TMP($J,"LRDATA",LINE)) S LINE=LINE+1
. S LRLLINA="~"_LRST_"^"_$G(LOINCDTB(64,LRPNTB,.01,"E"))
. ;PROCEDURE (64,.01)
. S LRLLINA=LRLLINA_"^"_$G(LOINCDTB(64,LRPNTB,1,"E"))
. ;WKLD CODE (64,1)
. S LRLLINA=LRLLINA_"^"_$G(LOINCDTB(64,LRPNTB,25,"E"))
. ;DEFAULT LOINC CODE (64,25)
. S LRLLINA=LRLLINA_"^"_$G(LOINCDTB(64,LRPNTB,25.5,"E"))
. ;LOOK FOR 64.01 & 64.02 HERE
. I '$O(LOINCDTA(64.01,"")) S ^TMP($J,"LRDATA",LINE)=LRLLINA S LINE=LINE+1
. S LRAA1=""
. F S LRAA1=$O(LOINCDTA(64.01,LRAA1)) Q:LRAA1="" D
. . I '$D(LOINCDTA(64.01,LRAA1,.01,"I")) D Q
. . . S ^TMP($J,"LRDTERR",LINR)="Specimen sub-field error in file 64!! "_LRAA1,LINR=LINR+1
. . . S ^TMP($J,"LRDTERR",LINR)=$G(LRERR("DIERR",1,"TEXT",1)),LINR=LINR+1
. . S LRPNTA=LOINCDTA(64.01,LRAA1,.01,"I")
. . D GETS^DIQ(61,LRPNTA,.0961,,"LOINCTAS","LRERR")
. . S LRLLINB="^"_$G(LOINCTAS(61,LRPNTA_",",.0961))
. . ;TIME ASPECT (61,.0961)
. . S LRLLINB=LRLLINB_"^"_LOINCDTA(64.01,LRAA1,.01,"E")
. . ;SPECIMEN (64.01,.01)
. . I '$O(LOINCDTA(64.02,"")) S ^TMP($J,"LRDATA",LINE)=LRLLINA_LRLLINB,LINE=LINE+1
. . S LRAA=""
. . F S LRAA=$O(LOINCDTA(64.02,LRAA)) Q:LRAA="" D
. . . S LRLLINC="^"_$G(LOINCDTA(64.02,LRAA,2,"E"))
. . . ;DATA LOCATION (64.02,2)
. . . D TSTNAM
. . . ;TEST (64.02,3)
. . . S LRLLINC=LRLLINC_"^"_$G(LOINCDTA(64.02,LRAA,4,"E"))
. . . S ^TMP($J,"LRDATA",LINE)=LRLLINA_LRLLINB_LRLLINC
. . . D TSTTYP,TSTUNS
. . . S LINE=LINE+1
D EXIT^LRSRVR
Q
;
;
LOINCL ; Build and send local LOINC report
;
N LINE,LINR,LRA,LRXREF
K ^TMP($J,"LRSERVER","LOINC")
K XMY
S XMY(XQSND)=""
S ^TMP($J,"LRDATA",1)="Report Generated "_$$FMTE^XLFDT($$NOW^XLFDT)_" at "_LRSTN
S ^TMP($J,"LRDATA",2)="No codes defined at "_LRSTN
S LINE=2,LINR=1
F LRXREF="AI","AH" D
. S LRA=""
. F S LRA=$O(^LAM(LRXREF,LRA)) Q:'LRA D
. . S LRB=""
. . F S LRB=$O(^LAM(LRXREF,LRA,LRB)) Q:LRB="" S ^TMP($J,"LRSERVER","LOINC",LRB)=""
;
S LRA=""
F S LRA=$O(^TMP($J,"LRSERVER","LOINC",LRA)) Q:LRA="" D LOINCLA
D EXIT^LRSRVR
Q
;
;
LOINCLA ;
N LR60,LR61,LRERR,LOINCDTA,LOINCDTB,LRPNTB,LRX
S:'$D(LINE) LINE=1 S:'$D(LINR) LINR=1
D GETS^DIQ(64,LRA,".01;1;25;25.5","IE","LOINCDTB","LRERR")
D GETS^DIQ(64,LRA,"20*","IE","LOINCDTA","LRERR")
S LRPNTB=$O(LOINCDTB(64,"")) Q:LRPNTB=""
S ^TMP($J,"LRDATA",LINE)="",LINE=LINE+1
S ^TMP($J,"LRDATA",LINE)="NLT Procedure: "_$G(LOINCDTB(64,LRPNTB,.01,"E")),LINE=LINE+1
;
; Procedure (64,.01)
S ^TMP($J,"LRDATA",LINE)="NLT Code: "_$G(LOINCDTB(64,LRPNTB,1,"E")),LINE=LINE+1
;
; WKLD CODE (64,1)
S ^TMP($J,"LRDATA",LINE)="Default LOINC Code: "_$G(LOINCDTB(64,LRPNTB,25,"E"))_" : "_$G(^LAB(95.3,+$G(LOINCDTB(64,LRPNTB,25,"E")),80)),LINE=LINE+1
;
; Default LOINC code (64,25)
S ^TMP($J,"LRDATA",LINE)="Default LOINC Code Test: "_$G(LOINCDTB(64,LRPNTB,25.5,"E")),LINE=LINE+1
;
; Look for 64.01 & 64.02 here
S LRAA1=""
F S LRAA1=$O(LOINCDTA(64.01,LRAA1)) Q:LRAA1="" D
. I '$D(LOINCDTA(64.01,LRAA1,.01,"I")) D Q
. . S ^TMP($J,"LRDATA",LINE)="Specimen sub-field error in file 64!! "_LRAA1,LINE=LINE+1
. . S ^TMP($J,"LRDATA",LINE)=$G(LRERR("DIERR",1,"TEXT",1)),LINE=LINE+1
. S LRPNTA=LOINCDTA(64.01,LRAA1,.01,"I")
. D GETS^DIQ(61,LRPNTA,.0961,,"LOINCTAS","LRERR")
. S ^TMP($J,"LRDATA",LINE)="Time Aspect: "_LOINCTAS(61,LRPNTA_",",.0961),LINE=LINE+1
. ; TIME ASPECT (61,.0961)
. S ^TMP($J,"LRDATA",LINE)="Specimen: "_LOINCDTA(64.01,LRAA1,.01,"E"),LINE=LINE+1
. ; SPECIMEN (64.01,.01)
. S LRAA=""
. F S LRAA=$O(LOINCDTA(64.02,LRAA)) Q:LRAA="" I LRAA[LRAA1 D
. . S ^TMP($J,"LRDATA",LINE)="Data Location: "_$G(LOINCDTA(64.02,LRAA,2,"E")),LINE=LINE+1
. . ; DATA LOCATION (64.02,2)
. . D TSTTYP,TSTNAM,TSTUNS
. . S ^TMP($J,"LRDATA",LINE)="LOINC Code: "_$G(LOINCDTA(64.02,LRAA,4,"E"))_" : "_$G(^LAB(95.3,+$G(LOINCDTA(64.02,LRAA,4,"E")),80)),LINE=LINE+1
. . ; LOINC CODE (64.02,4)
Q
;
;
TSTTYP ; Determine test data type
N LRX,LRTYPE,LRY
I LOINCDTA(64.02,LRAA,2,"I")="" Q
S LRX=$P(LOINCDTA(64.02,LRAA,2,"I"),"(",2)
S LRTYPE=$$GET1^DID($P(LRX,","),$P(LRX,",",2,99),"","TYPE")
I LRSUB="LOINC" S $P(^TMP($J,"LRDATA",LINE),"^",11)=LRTYPE
I LRSUB="LOCAL REPORT" S ^TMP($J,"LRDATA",LINE)="Data Type: "_LRTYPE,LINE=LINE+1
S LRY=$$GET1^DID($P(LRX,","),$P(LRX,",",2,99),"",$S(LRTYPE="SET":"POINTER",1:"INPUT TRANSFORM"))
I LRSUB="LOINC" S LRY=$TR(LRY,"^","~"),$P(^TMP($J,"LRDATA",LINE),"^",12)=LRY
I LRSUB="LOCAL REPORT" S ^TMP($J,"LRDATA",LINE)="Data Values: "_LRY,LINE=LINE+1
S LRY=$$GET1^DID($P(LRX,","),$P(LRX,",",2,99),"","HELP-PROMPT")
I LRSUB="LOINC" S $P(^TMP($J,"LRDATA",LINE),"^",13)=LRY
I LRSUB="LOCAL REPORT" S ^TMP($J,"LRDATA",LINE)="Data Help: "_LRY,LINE=LINE+1
Q
;
;
TSTNAM ; Test name and units
N LRX,LRY
S LRX=LOINCDTA(64.02,LRAA,3,"E")
S LRY=""
I LOINCDTA(64.02,LRAA,3,"I") S LRY=LOINCDTA(64.02,LRAA,3,"I")_"-"_LOINCDTA(64.01,$P(LRAA,",",2,4),.01,"I")
I LRSUB="LOCAL REPORT" D
. S ^TMP($J,"LRDATA",LINE)="Test: "_LRX,LINE=LINE+1
. I LRY'="" S ^TMP($J,"LRDATA",LINE)="Test-Spec: "_LRY,LINE=LINE+1
I LRSUB="LOINC" D
. S LRLLINC=LRLLINC_"^"_LRX
. S $P(^TMP($J,"LRDATA",LINE),"^",15)=LRY
Q
;
;
TSTUNS ; Test units
N LR60,LR61,LRY
S LR60=+LOINCDTA(64.02,LRAA,3,"I"),LR61=+LOINCDTA(64.01,$P(LRAA,",",2,4),.01,"I")
S LRY=$$GET1^DIQ(60.01,LR61_","_LR60_",",6)
I LRSUB="LOINC" S $P(^TMP($J,"LRDATA",LINE),"^",14)=LRY
I LRSUB="LOCAL REPORT" S ^TMP($J,"LRDATA",LINE)="Units: "_LRY,LINE=LINE+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRSRVR1 6389 printed Oct 16, 2024@18:21:32 Page 2
LRSRVR1 ;DALOI/JMC -LAB DATA SERVER, CONT'D - LOINC SECTION ; March 25, 2002
+1 ;;5.2;LAB SERVICE;**303**;Sep 27, 1994
+2 ;
+3 ;
LOINC ; Scan for LOINC Coding
+1 ;
+2 NEW LR60,LR61,LRLLINA,LRLLINB,LRLLINC,LRX
+3 KILL XMY
+4 ;S XMY("G.LOINCSERVER@ISC-DALLAS.DOMAIN.EXT")=""
+5 SET XMY(XQSND)=""
+6 SET ^TMP($JOB,"LRDATA",1)="*"_$$NOW^XLFDT
+7 SET ^TMP($JOB,"LRDATA",2)="No codes defined at "_LRSTN
+8 KILL ^TMP($JOB,"LRSERVER","LOINC")
+9 SET LINE=2
SET LINR=1
+10 FOR LRSUB="AI","AH"
Begin DoDot:1
+11 SET LRA=""
+12 FOR
SET LRA=$ORDER(^LAM(LRSUB,LRA))
if 'LRA
QUIT
Begin DoDot:2
+13 SET LRB=""
+14 FOR
SET LRB=$ORDER(^LAM(LRSUB,LRA,LRB))
if LRB=""
QUIT
SET ^TMP($JOB,"LRSERVER","LOINC",LRB)=""
End DoDot:2
End DoDot:1
+15 ;
+16 SET LRA=""
+17 FOR
SET LRA=$ORDER(^TMP($JOB,"LRSERVER","LOINC",LRA))
if LRA=""
QUIT
Begin DoDot:1
+18 KILL LOINCDTA,LOINCDTB,LRERR
+19 DO GETS^DIQ(64,LRA,".01;1;25;25.5","IE","LOINCDTB","LRERR")
+20 DO GETS^DIQ(64,LRA,"20*","IE","LOINCDTA","LRERR")
+21 SET LRPNTB=$ORDER(LOINCDTB(64,""))
if LRPNTB=""
QUIT
+22 IF LINE>2
FOR
if '$DATA(^TMP($JOB,"LRDATA",LINE))
QUIT
SET LINE=LINE+1
+23 SET LRLLINA="~"_LRST_"^"_$GET(LOINCDTB(64,LRPNTB,.01,"E"))
+24 ;PROCEDURE (64,.01)
+25 SET LRLLINA=LRLLINA_"^"_$GET(LOINCDTB(64,LRPNTB,1,"E"))
+26 ;WKLD CODE (64,1)
+27 SET LRLLINA=LRLLINA_"^"_$GET(LOINCDTB(64,LRPNTB,25,"E"))
+28 ;DEFAULT LOINC CODE (64,25)
+29 SET LRLLINA=LRLLINA_"^"_$GET(LOINCDTB(64,LRPNTB,25.5,"E"))
+30 ;LOOK FOR 64.01 & 64.02 HERE
+31 IF '$ORDER(LOINCDTA(64.01,""))
SET ^TMP($JOB,"LRDATA",LINE)=LRLLINA
SET LINE=LINE+1
+32 SET LRAA1=""
+33 FOR
SET LRAA1=$ORDER(LOINCDTA(64.01,LRAA1))
if LRAA1=""
QUIT
Begin DoDot:2
+34 IF '$DATA(LOINCDTA(64.01,LRAA1,.01,"I"))
Begin DoDot:3
+35 SET ^TMP($JOB,"LRDTERR",LINR)="Specimen sub-field error in file 64!! "_LRAA1
SET LINR=LINR+1
+36 SET ^TMP($JOB,"LRDTERR",LINR)=$GET(LRERR("DIERR",1,"TEXT",1))
SET LINR=LINR+1
End DoDot:3
QUIT
+37 SET LRPNTA=LOINCDTA(64.01,LRAA1,.01,"I")
+38 DO GETS^DIQ(61,LRPNTA,.0961,,"LOINCTAS","LRERR")
+39 SET LRLLINB="^"_$GET(LOINCTAS(61,LRPNTA_",",.0961))
+40 ;TIME ASPECT (61,.0961)
+41 SET LRLLINB=LRLLINB_"^"_LOINCDTA(64.01,LRAA1,.01,"E")
+42 ;SPECIMEN (64.01,.01)
+43 IF '$ORDER(LOINCDTA(64.02,""))
SET ^TMP($JOB,"LRDATA",LINE)=LRLLINA_LRLLINB
SET LINE=LINE+1
+44 SET LRAA=""
+45 FOR
SET LRAA=$ORDER(LOINCDTA(64.02,LRAA))
if LRAA=""
QUIT
Begin DoDot:3
+46 SET LRLLINC="^"_$GET(LOINCDTA(64.02,LRAA,2,"E"))
+47 ;DATA LOCATION (64.02,2)
+48 DO TSTNAM
+49 ;TEST (64.02,3)
+50 SET LRLLINC=LRLLINC_"^"_$GET(LOINCDTA(64.02,LRAA,4,"E"))
+51 SET ^TMP($JOB,"LRDATA",LINE)=LRLLINA_LRLLINB_LRLLINC
+52 DO TSTTYP
DO TSTUNS
+53 SET LINE=LINE+1
End DoDot:3
End DoDot:2
End DoDot:1
+54 DO EXIT^LRSRVR
+55 QUIT
+56 ;
+57 ;
LOINCL ; Build and send local LOINC report
+1 ;
+2 NEW LINE,LINR,LRA,LRXREF
+3 KILL ^TMP($JOB,"LRSERVER","LOINC")
+4 KILL XMY
+5 SET XMY(XQSND)=""
+6 SET ^TMP($JOB,"LRDATA",1)="Report Generated "_$$FMTE^XLFDT($$NOW^XLFDT)_" at "_LRSTN
+7 SET ^TMP($JOB,"LRDATA",2)="No codes defined at "_LRSTN
+8 SET LINE=2
SET LINR=1
+9 FOR LRXREF="AI","AH"
Begin DoDot:1
+10 SET LRA=""
+11 FOR
SET LRA=$ORDER(^LAM(LRXREF,LRA))
if 'LRA
QUIT
Begin DoDot:2
+12 SET LRB=""
+13 FOR
SET LRB=$ORDER(^LAM(LRXREF,LRA,LRB))
if LRB=""
QUIT
SET ^TMP($JOB,"LRSERVER","LOINC",LRB)=""
End DoDot:2
End DoDot:1
+14 ;
+15 SET LRA=""
+16 FOR
SET LRA=$ORDER(^TMP($JOB,"LRSERVER","LOINC",LRA))
if LRA=""
QUIT
DO LOINCLA
+17 DO EXIT^LRSRVR
+18 QUIT
+19 ;
+20 ;
LOINCLA ;
+1 NEW LR60,LR61,LRERR,LOINCDTA,LOINCDTB,LRPNTB,LRX
+2 if '$DATA(LINE)
SET LINE=1
if '$DATA(LINR)
SET LINR=1
+3 DO GETS^DIQ(64,LRA,".01;1;25;25.5","IE","LOINCDTB","LRERR")
+4 DO GETS^DIQ(64,LRA,"20*","IE","LOINCDTA","LRERR")
+5 SET LRPNTB=$ORDER(LOINCDTB(64,""))
if LRPNTB=""
QUIT
+6 SET ^TMP($JOB,"LRDATA",LINE)=""
SET LINE=LINE+1
+7 SET ^TMP($JOB,"LRDATA",LINE)="NLT Procedure: "_$GET(LOINCDTB(64,LRPNTB,.01,"E"))
SET LINE=LINE+1
+8 ;
+9 ; Procedure (64,.01)
+10 SET ^TMP($JOB,"LRDATA",LINE)="NLT Code: "_$GET(LOINCDTB(64,LRPNTB,1,"E"))
SET LINE=LINE+1
+11 ;
+12 ; WKLD CODE (64,1)
+13 SET ^TMP($JOB,"LRDATA",LINE)="Default LOINC Code: "_$GET(LOINCDTB(64,LRPNTB,25,"E"))_" : "_$GET(^LAB(95.3,+$GET(LOINCDTB(64,LRPNTB,25,"E")),80))
SET LINE=LINE+1
+14 ;
+15 ; Default LOINC code (64,25)
+16 SET ^TMP($JOB,"LRDATA",LINE)="Default LOINC Code Test: "_$GET(LOINCDTB(64,LRPNTB,25.5,"E"))
SET LINE=LINE+1
+17 ;
+18 ; Look for 64.01 & 64.02 here
+19 SET LRAA1=""
+20 FOR
SET LRAA1=$ORDER(LOINCDTA(64.01,LRAA1))
if LRAA1=""
QUIT
Begin DoDot:1
+21 IF '$DATA(LOINCDTA(64.01,LRAA1,.01,"I"))
Begin DoDot:2
+22 SET ^TMP($JOB,"LRDATA",LINE)="Specimen sub-field error in file 64!! "_LRAA1
SET LINE=LINE+1
+23 SET ^TMP($JOB,"LRDATA",LINE)=$GET(LRERR("DIERR",1,"TEXT",1))
SET LINE=LINE+1
End DoDot:2
QUIT
+24 SET LRPNTA=LOINCDTA(64.01,LRAA1,.01,"I")
+25 DO GETS^DIQ(61,LRPNTA,.0961,,"LOINCTAS","LRERR")
+26 SET ^TMP($JOB,"LRDATA",LINE)="Time Aspect: "_LOINCTAS(61,LRPNTA_",",.0961)
SET LINE=LINE+1
+27 ; TIME ASPECT (61,.0961)
+28 SET ^TMP($JOB,"LRDATA",LINE)="Specimen: "_LOINCDTA(64.01,LRAA1,.01,"E")
SET LINE=LINE+1
+29 ; SPECIMEN (64.01,.01)
+30 SET LRAA=""
+31 FOR
SET LRAA=$ORDER(LOINCDTA(64.02,LRAA))
if LRAA=""
QUIT
IF LRAA[LRAA1
Begin DoDot:2
+32 SET ^TMP($JOB,"LRDATA",LINE)="Data Location: "_$GET(LOINCDTA(64.02,LRAA,2,"E"))
SET LINE=LINE+1
+33 ; DATA LOCATION (64.02,2)
+34 DO TSTTYP
DO TSTNAM
DO TSTUNS
+35 SET ^TMP($JOB,"LRDATA",LINE)="LOINC Code: "_$GET(LOINCDTA(64.02,LRAA,4,"E"))_" : "_$GET(^LAB(95.3,+$GET(LOINCDTA(64.02,LRAA,4,"E")),80))
SET LINE=LINE+1
+36 ; LOINC CODE (64.02,4)
End DoDot:2
End DoDot:1
+37 QUIT
+38 ;
+39 ;
TSTTYP ; Determine test data type
+1 NEW LRX,LRTYPE,LRY
+2 IF LOINCDTA(64.02,LRAA,2,"I")=""
QUIT
+3 SET LRX=$PIECE(LOINCDTA(64.02,LRAA,2,"I"),"(",2)
+4 SET LRTYPE=$$GET1^DID($PIECE(LRX,","),$PIECE(LRX,",",2,99),"","TYPE")
+5 IF LRSUB="LOINC"
SET $PIECE(^TMP($JOB,"LRDATA",LINE),"^",11)=LRTYPE
+6 IF LRSUB="LOCAL REPORT"
SET ^TMP($JOB,"LRDATA",LINE)="Data Type: "_LRTYPE
SET LINE=LINE+1
+7 SET LRY=$$GET1^DID($PIECE(LRX,","),$PIECE(LRX,",",2,99),"",$SELECT(LRTYPE="SET":"POINTER",1:"INPUT TRANSFORM"))
+8 IF LRSUB="LOINC"
SET LRY=$TRANSLATE(LRY,"^","~")
SET $PIECE(^TMP($JOB,"LRDATA",LINE),"^",12)=LRY
+9 IF LRSUB="LOCAL REPORT"
SET ^TMP($JOB,"LRDATA",LINE)="Data Values: "_LRY
SET LINE=LINE+1
+10 SET LRY=$$GET1^DID($PIECE(LRX,","),$PIECE(LRX,",",2,99),"","HELP-PROMPT")
+11 IF LRSUB="LOINC"
SET $PIECE(^TMP($JOB,"LRDATA",LINE),"^",13)=LRY
+12 IF LRSUB="LOCAL REPORT"
SET ^TMP($JOB,"LRDATA",LINE)="Data Help: "_LRY
SET LINE=LINE+1
+13 QUIT
+14 ;
+15 ;
TSTNAM ; Test name and units
+1 NEW LRX,LRY
+2 SET LRX=LOINCDTA(64.02,LRAA,3,"E")
+3 SET LRY=""
+4 IF LOINCDTA(64.02,LRAA,3,"I")
SET LRY=LOINCDTA(64.02,LRAA,3,"I")_"-"_LOINCDTA(64.01,$PIECE(LRAA,",",2,4),.01,"I")
+5 IF LRSUB="LOCAL REPORT"
Begin DoDot:1
+6 SET ^TMP($JOB,"LRDATA",LINE)="Test: "_LRX
SET LINE=LINE+1
+7 IF LRY'=""
SET ^TMP($JOB,"LRDATA",LINE)="Test-Spec: "_LRY
SET LINE=LINE+1
End DoDot:1
+8 IF LRSUB="LOINC"
Begin DoDot:1
+9 SET LRLLINC=LRLLINC_"^"_LRX
+10 SET $PIECE(^TMP($JOB,"LRDATA",LINE),"^",15)=LRY
End DoDot:1
+11 QUIT
+12 ;
+13 ;
TSTUNS ; Test units
+1 NEW LR60,LR61,LRY
+2 SET LR60=+LOINCDTA(64.02,LRAA,3,"I")
SET LR61=+LOINCDTA(64.01,$PIECE(LRAA,",",2,4),.01,"I")
+3 SET LRY=$$GET1^DIQ(60.01,LR61_","_LR60_",",6)
+4 IF LRSUB="LOINC"
SET $PIECE(^TMP($JOB,"LRDATA",LINE),"^",14)=LRY
+5 IF LRSUB="LOCAL REPORT"
SET ^TMP($JOB,"LRDATA",LINE)="Units: "_LRY
SET LINE=LINE+1
+6 QUIT
