LRSRVR3 ;DALOI/JMC -LAB DATA SERVER, CONT'D - LOINC SECTION ;Aug 17,2006
;;5.2;LAB SERVICE;**303,346**;Sep 27, 1994;Build 10
;
;
LOINCLD ; Build and send local delimited LOINC report
N I,LR6206,LR64,LINR,LRA,LRB,LRCNT,LRCRLF,LRMSUBJ,LRNODE,LRSTR,LRTXT,LRXREF,X,Y
;
K ^TMP($J,"LRSERVER","LOINC"),^TMP($J,"LRDATA")
S ^TMP($J,"LRDATA",1)="Report Generated.......: "_$$FMTE^XLFDT($$NOW^XLFDT)_" at "_LRSTN
S ^TMP($J,"LRDATA",2)="Report requested.......: "_LRSUB
S ^TMP($J,"LRDATA",3)="LOINC version..........: "_$$GET1^DID(95.3,"","","PACKAGE REVISION DATA")
S ^TMP($J,"LRDATA",4)="File version...........: "_$G(^LAB(95.3,"VR"))
S LRFILENM=$TR(LRSTN," ","_")_"-"_LRSUB_"-"_$P($$FMTHL7^XLFDT($$NOW^XLFDT),"-")_".TXT"
S ^TMP($J,"LRDATA",5)="Attached file..........: "_LRFILENM
S ^TMP($J,"LRDATA",7)=" "
S ^TMP($J,"LRDATA",8)="Legend:"
S X="Station #-64 ien-61 ien-Time Aspect|NLT Code|NLT Name|Default LOINC Code|Default LOINC Name|Default Test|Time Aspect|Specimen|Data Location|Data Type|Input Transform|Units|Test Name|LOINC Code|LOINC Name"
S ^TMP($J,"LRDATA",9)=X
S Y="|Reference Low|Reference High|Therapeutic Low|Therapeutic High|Subscript|Lab Section|"
S ^TMP($J,"LRDATA",10)=Y
S ^TMP($J,"LRDATA",11)=" 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 "
S ^TMP($J,"LRDATA",12)="| 16 | 17 | 18 | 19 | 20 | 21 |"
S ^TMP($J,"LRDATA",13)=$$REPEAT^XLFSTR("-",$L(X))
S ^TMP($J,"LRDATA",14)=$$REPEAT^XLFSTR("-",$L(Y))
S ^TMP($J,"LRDATA",15)=" "
S ^TMP($J,"LRDATA",16)=$$UUBEGFN^LRSRVR2A(LRFILENM)
S LINR=1,LRCNT=0,LRSTR="",LRTXT=0,LRCRLF=$C(13,10)
;
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 LR64=""
F S LR64=$O(^TMP($J,"LRSERVER","LOINC",LR64)) Q:LR64="" D LOINCLA
;
S LR6206=0,LRSS="MI"
F S LR6206=$O(^LAB(62.06,LR6206)) Q:'LR6206 D
. S LR64=$$GET1^DIQ(62.06,LR6206_",",64,"I")
. S LRREC=$$MICRO(LR64)
. S LRINDX=LRST_"-"_LR64_"-"_"AB"_LR6206
. S LRSTR=LRSTR_LRINDX_"|"_LRREC_LRCRLF
. D SETDATA^LRSRVR2
. S LRCNT=LRCNT+1
;
S ^TMP($J,"LRDATA",6)="Total number of records: "_LRCNT
I '$O(^TMP($J,"LRDATA",15)) S ^TMP($J,"LRDATA",12)="No LOINC codes mapped at "_LRSTN
;
; Set the final info into the ^TMP( message global
S LRNODE=$O(^TMP($J,"LRDATA",""),-1)+1
I LRSTR'="" S ^TMP($J,"LRDATA",LRNODE)=$$UUEN^LRSRVR4(LRSTR)
S ^TMP($J,"LRDATA",LRNODE+1)=" "
S ^TMP($J,"LRDATA",LRNODE+2)="end"
;
S LRMSUBJ=LRST_" "_LRSTN_" LOCAL REPORT DELIMIT "_$$HTE^XLFDT($H,"1M")
D MAILSEND^LRSRVR6(LRMSUBJ)
D CLEAN^LRSRVR
Q
;
;
LOINCLA ;
N LR60,LR61,LRAA,LRAA1,LRERR,LRINDX,LOINCDTA,LOINCDTB,LRPNTA,LRPNTB,LRREC,LRSS,LRX
D GETS^DIQ(64,LR64,".01;1;13;25;25.5","IE","LOINCDTB","LRERR")
D GETS^DIQ(64,LR64,"20*","IE","LOINCDTA","LRERR")
S LRPNTB=$O(LOINCDTB(64,"")) Q:LRPNTB=""
;
; NLT Code/Procedure
S LRSTUB=$G(LOINCDTB(64,LRPNTB,1,"E"))
S $P(LRSTUB,"|",2)=$G(LOINCDTB(64,LRPNTB,.01,"I"))
;
; Default LOINC code/name
S $P(LRSTUB,"|",3)=$G(LOINCDTB(64,LRPNTB,25,"E"))
S $P(LRSTUB,"|",4)=$G(^LAB(95.3,+$G(LOINCDTB(64,LRPNTB,25,"I")),81))
;
; Default LOINC code test (64,25.5)
S $P(LRSTUB,"|",5)=$G(LOINCDTB(64,LRPNTB,25.5,"I"))
;
; 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 $P(LRSTUB,"|",6)="Specimen sub-field error in file 64 - "_LRAA1
. . S $P(LRSTUB,"|",7)=$G(LRERR("DIERR",1,"TEXT",1))
. . S LRSTR=LRSTR_LRCRLF
. . D SETDATA^LRSRVR2
. . S LRCNT=LRCNT+1
. S LRPNTA=LOINCDTA(64.01,LRAA1,.01,"I")
. S $P(LRSTUB,"|",6)=$$GET1^DIQ(61,LRPNTA_",",.0961) ; Time Aspect
. S $P(LRSTUB,"|",7)=LOINCDTA(64.01,LRAA1,.01,"E") ; Specimen
. S LRAA=""
. F S LRAA=$O(LOINCDTA(64.02,LRAA)) Q:LRAA="" I LRAA[LRAA1 D
. . S $P(LRSTUB,"|",8)=$G(LOINCDTA(64.02,LRAA,2,"E")) ; Data location
. . S LR60=+LOINCDTA(64.02,LRAA,3,"I")
. . S LR61=+LOINCDTA(64.01,$P(LRAA,",",2,4),.01,"I")
. . S $P(LRSTUB,"|",9,10)=$$TSTTYP(LOINCDTA(64.02,LRAA,2,"I"))
. . S LRSS=$$GET1^DIQ(60,LR60_",",4,"I") ; Subscript
. . S LRX=$$GET1^DIQ(60.01,LR61_","_LR60_",",6) ; Units
. . S $P(LRSTUB,"|",11)=$$TRIM^XLFSTR(LRX,"LR"," ")
. . S $P(LRSTUB,"|",12)=LOINCDTA(64.02,LRAA,3,"E") ; Test name
. . S $P(LRSTUB,"|",13)=$G(LOINCDTA(64.02,LRAA,4,"E")) ; Loinc code
. . S $P(LRSTUB,"|",14)=$G(^LAB(95.3,+$G(LOINCDTA(64.02,LRAA,4,"E")),81)) ; LOINC code (64.02,4)
. . S X=$G(^LAB(60,LR60,1,LR61,0))
. . S $P(LRSTUB,"|",15)=$P(X,"^",2) ; Test reference low
. . S $P(LRSTUB,"|",16)=$P(X,"^",3) ; Test reference high
. . S $P(LRSTUB,"|",17)=$P(X,"^",11) ; Test therapeutic low
. . S $P(LRSTUB,"|",18)=$P(X,"^",12) ; Test therapeutic high
. . S $P(LRSTUB,"|",19)=LRSS ; Lab subscript
. . S $P(LRSTUB,"|",20)=$G(LOINCDTB(64,LRPNTB,13,"E")) ; Lab section
. . S LRINDX=LRST_"-"_LR64_"-"_LR61_"-"_LOINCDTA(64.02,LRAA,.01,"I")
. . S LRSTR=LRSTR_LRINDX_"|"_LRSTUB_LRCRLF
. . D SETDATA^LRSRVR2
. . S LRCNT=LRCNT+1
Q
;
;
MICRO(LR64) ;
N LOINCDTB,LR6421,LRPNTB,LRSTUB
S LRSTUB=""
D GETS^DIQ(64,LR64,".01;1;13;25;25.5","IE","LOINCDTB","LRERR")
D GETS^DIQ(64,LR64,"20*","IE","LOINCDTA","LRERR")
S LRPNTB=$O(LOINCDTB(64,"")) Q:LRPNTB="" LRSTUB
;
; NLT Code/Procedure
S LRSTUB=$G(LOINCDTB(64,LRPNTB,1,"E"))
S $P(LRSTUB,"|",2)=$G(LOINCDTB(64,LRPNTB,.01,"I"))
;
; Default LOINC code/name
S $P(LRSTUB,"|",3)=$G(LOINCDTB(64,LRPNTB,25,"E"))
S $P(LRSTUB,"|",4)=$G(^LAB(95.3,+$G(LOINCDTB(64,LRPNTB,25,"I")),81))
;
; Anti-microbial Suscept (62.06,.01)
S $P(LRSTUB,"|",5)=$$GET1^DIQ(62.06,LR6206_",",.01)
;
; Lab subscript/section
S $P(LRSTUB,"|",19)=LRSS
I $G(LOINCDTB(64,LRPNTB,13,"I")) D ; Lab section
. S LR6421=LOINCDTB(64,LRPNTB,13,"I")
. S $P(LRSTUB,"|",20)=$$GET1^DIQ(64.21,LR6421_",",1)
;
Q LRSTUB
;
;
TSTTYP(LRX) ; Determine test data type
N LRSTUB,LRTYPE,LRY
I LRX="" Q "|"
S LRX=$P(LRX,"(",2)
;
; Data type
S LRTYPE=$$GET1^DID($P(LRX,","),$P(LRX,",",2,99),"","TYPE")
S $P(LRSTUB,"|",2)=LRTYPE
;
; Input transform
S LRY=$$GET1^DID($P(LRX,","),$P(LRX,",",2,99),"",$S(LRTYPE="SET":"POINTER",1:"INPUT TRANSFORM"))
I LRTYPE="NUMERIC",LRY["LRNUM" D
. S LRX=$P(LRY,"""",2)
. I LRX?.1"-".N1","1.N1","1N S LRY="Number from "_$P(LRX,",")_" to "_$P(LRX,",",2)_" with "_$P(LRX,",",3)_" decimal"
S $P(LRSTUB,"|",1)=LRY
; Help prompt
I LRTYPE="FREE TEXT" D
. S LRY=$$GET1^DID($P(LRX,","),$P(LRX,",",2,99),"","HELP-PROMPT")
. S $P(LRSTUB,"|",1)=LRY
Q LRSTUB
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRSRVR3 6822 printed Dec 13, 2024@02:20:51 Page 2
LRSRVR3 ;DALOI/JMC -LAB DATA SERVER, CONT'D - LOINC SECTION ;Aug 17,2006
+1 ;;5.2;LAB SERVICE;**303,346**;Sep 27, 1994;Build 10
+2 ;
+3 ;
LOINCLD ; Build and send local delimited LOINC report
+1 NEW I,LR6206,LR64,LINR,LRA,LRB,LRCNT,LRCRLF,LRMSUBJ,LRNODE,LRSTR,LRTXT,LRXREF,X,Y
+2 ;
+3 KILL ^TMP($JOB,"LRSERVER","LOINC"),^TMP($JOB,"LRDATA")
+4 SET ^TMP($JOB,"LRDATA",1)="Report Generated.......: "_$$FMTE^XLFDT($$NOW^XLFDT)_" at "_LRSTN
+5 SET ^TMP($JOB,"LRDATA",2)="Report requested.......: "_LRSUB
+6 SET ^TMP($JOB,"LRDATA",3)="LOINC version..........: "_$$GET1^DID(95.3,"","","PACKAGE REVISION DATA")
+7 SET ^TMP($JOB,"LRDATA",4)="File version...........: "_$GET(^LAB(95.3,"VR"))
+8 SET LRFILENM=$TRANSLATE(LRSTN," ","_")_"-"_LRSUB_"-"_$PIECE($$FMTHL7^XLFDT($$NOW^XLFDT),"-")_".TXT"
+9 SET ^TMP($JOB,"LRDATA",5)="Attached file..........: "_LRFILENM
+10 SET ^TMP($JOB,"LRDATA",7)=" "
+11 SET ^TMP($JOB,"LRDATA",8)="Legend:"
+12 SET X="Station #-64 ien-61 ien-Time Aspect|NLT Code|NLT Name|Default LOINC Code|Default LOINC Name|Default Test|Time Aspect|Specimen|Data Location|Data Type|Input Transform|Units|Test Name|LOINC Code|LOINC Name"
+13 SET ^TMP($JOB,"LRDATA",9)=X
+14 SET Y="|Reference Low|Reference High|Therapeutic Low|Therapeutic High|Subscript|Lab Section|"
+15 SET ^TMP($JOB,"LRDATA",10)=Y
+16 SET ^TMP($JOB,"LRDATA",11)=" 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 "
+17 SET ^TMP($JOB,"LRDATA",12)="| 16 | 17 | 18 | 19 | 20 | 21 |"
+18 SET ^TMP($JOB,"LRDATA",13)=$$REPEAT^XLFSTR("-",$LENGTH(X))
+19 SET ^TMP($JOB,"LRDATA",14)=$$REPEAT^XLFSTR("-",$LENGTH(Y))
+20 SET ^TMP($JOB,"LRDATA",15)=" "
+21 SET ^TMP($JOB,"LRDATA",16)=$$UUBEGFN^LRSRVR2A(LRFILENM)
+22 SET LINR=1
SET LRCNT=0
SET LRSTR=""
SET LRTXT=0
SET LRCRLF=$CHAR(13,10)
+23 ;
+24 FOR LRXREF="AI","AH"
Begin DoDot:1
+25 SET LRA=""
+26 FOR
SET LRA=$ORDER(^LAM(LRXREF,LRA))
if 'LRA
QUIT
Begin DoDot:2
+27 SET LRB=""
+28 FOR
SET LRB=$ORDER(^LAM(LRXREF,LRA,LRB))
if LRB=""
QUIT
SET ^TMP($JOB,"LRSERVER","LOINC",LRB)=""
End DoDot:2
End DoDot:1
+29 ;
+30 SET LR64=""
+31 FOR
SET LR64=$ORDER(^TMP($JOB,"LRSERVER","LOINC",LR64))
if LR64=""
QUIT
DO LOINCLA
+32 ;
+33 SET LR6206=0
SET LRSS="MI"
+34 FOR
SET LR6206=$ORDER(^LAB(62.06,LR6206))
if 'LR6206
QUIT
Begin DoDot:1
+35 SET LR64=$$GET1^DIQ(62.06,LR6206_",",64,"I")
+36 SET LRREC=$$MICRO(LR64)
+37 SET LRINDX=LRST_"-"_LR64_"-"_"AB"_LR6206
+38 SET LRSTR=LRSTR_LRINDX_"|"_LRREC_LRCRLF
+39 DO SETDATA^LRSRVR2
+40 SET LRCNT=LRCNT+1
End DoDot:1
+41 ;
+42 SET ^TMP($JOB,"LRDATA",6)="Total number of records: "_LRCNT
+43 IF '$ORDER(^TMP($JOB,"LRDATA",15))
SET ^TMP($JOB,"LRDATA",12)="No LOINC codes mapped at "_LRSTN
+44 ;
+45 ; Set the final info into the ^TMP( message global
+46 SET LRNODE=$ORDER(^TMP($JOB,"LRDATA",""),-1)+1
+47 IF LRSTR'=""
SET ^TMP($JOB,"LRDATA",LRNODE)=$$UUEN^LRSRVR4(LRSTR)
+48 SET ^TMP($JOB,"LRDATA",LRNODE+1)=" "
+49 SET ^TMP($JOB,"LRDATA",LRNODE+2)="end"
+50 ;
+51 SET LRMSUBJ=LRST_" "_LRSTN_" LOCAL REPORT DELIMIT "_$$HTE^XLFDT($HOROLOG,"1M")
+52 DO MAILSEND^LRSRVR6(LRMSUBJ)
+53 DO CLEAN^LRSRVR
+54 QUIT
+55 ;
+56 ;
LOINCLA ;
+1 NEW LR60,LR61,LRAA,LRAA1,LRERR,LRINDX,LOINCDTA,LOINCDTB,LRPNTA,LRPNTB,LRREC,LRSS,LRX
+2 DO GETS^DIQ(64,LR64,".01;1;13;25;25.5","IE","LOINCDTB","LRERR")
+3 DO GETS^DIQ(64,LR64,"20*","IE","LOINCDTA","LRERR")
+4 SET LRPNTB=$ORDER(LOINCDTB(64,""))
if LRPNTB=""
QUIT
+5 ;
+6 ; NLT Code/Procedure
+7 SET LRSTUB=$GET(LOINCDTB(64,LRPNTB,1,"E"))
+8 SET $PIECE(LRSTUB,"|",2)=$GET(LOINCDTB(64,LRPNTB,.01,"I"))
+9 ;
+10 ; Default LOINC code/name
+11 SET $PIECE(LRSTUB,"|",3)=$GET(LOINCDTB(64,LRPNTB,25,"E"))
+12 SET $PIECE(LRSTUB,"|",4)=$GET(^LAB(95.3,+$GET(LOINCDTB(64,LRPNTB,25,"I")),81))
+13 ;
+14 ; Default LOINC code test (64,25.5)
+15 SET $PIECE(LRSTUB,"|",5)=$GET(LOINCDTB(64,LRPNTB,25.5,"I"))
+16 ;
+17 ; Look for 64.01 & 64.02 here
+18 SET LRAA1=""
+19 FOR
SET LRAA1=$ORDER(LOINCDTA(64.01,LRAA1))
if LRAA1=""
QUIT
Begin DoDot:1
+20 IF '$DATA(LOINCDTA(64.01,LRAA1,.01,"I"))
Begin DoDot:2
+21 SET $PIECE(LRSTUB,"|",6)="Specimen sub-field error in file 64 - "_LRAA1
+22 SET $PIECE(LRSTUB,"|",7)=$GET(LRERR("DIERR",1,"TEXT",1))
+23 SET LRSTR=LRSTR_LRCRLF
+24 DO SETDATA^LRSRVR2
+25 SET LRCNT=LRCNT+1
End DoDot:2
QUIT
+26 SET LRPNTA=LOINCDTA(64.01,LRAA1,.01,"I")
+27 ; Time Aspect
SET $PIECE(LRSTUB,"|",6)=$$GET1^DIQ(61,LRPNTA_",",.0961)
+28 ; Specimen
SET $PIECE(LRSTUB,"|",7)=LOINCDTA(64.01,LRAA1,.01,"E")
+29 SET LRAA=""
+30 FOR
SET LRAA=$ORDER(LOINCDTA(64.02,LRAA))
if LRAA=""
QUIT
IF LRAA[LRAA1
Begin DoDot:2
+31 ; Data location
SET $PIECE(LRSTUB,"|",8)=$GET(LOINCDTA(64.02,LRAA,2,"E"))
+32 SET LR60=+LOINCDTA(64.02,LRAA,3,"I")
+33 SET LR61=+LOINCDTA(64.01,$PIECE(LRAA,",",2,4),.01,"I")
+34 SET $PIECE(LRSTUB,"|",9,10)=$$TSTTYP(LOINCDTA(64.02,LRAA,2,"I"))
+35 ; Subscript
SET LRSS=$$GET1^DIQ(60,LR60_",",4,"I")
+36 ; Units
SET LRX=$$GET1^DIQ(60.01,LR61_","_LR60_",",6)
+37 SET $PIECE(LRSTUB,"|",11)=$$TRIM^XLFSTR(LRX,"LR"," ")
+38 ; Test name
SET $PIECE(LRSTUB,"|",12)=LOINCDTA(64.02,LRAA,3,"E")
+39 ; Loinc code
SET $PIECE(LRSTUB,"|",13)=$GET(LOINCDTA(64.02,LRAA,4,"E"))
+40 ; LOINC code (64.02,4)
SET $PIECE(LRSTUB,"|",14)=$GET(^LAB(95.3,+$GET(LOINCDTA(64.02,LRAA,4,"E")),81))
+41 SET X=$GET(^LAB(60,LR60,1,LR61,0))
+42 ; Test reference low
SET $PIECE(LRSTUB,"|",15)=$PIECE(X,"^",2)
+43 ; Test reference high
SET $PIECE(LRSTUB,"|",16)=$PIECE(X,"^",3)
+44 ; Test therapeutic low
SET $PIECE(LRSTUB,"|",17)=$PIECE(X,"^",11)
+45 ; Test therapeutic high
SET $PIECE(LRSTUB,"|",18)=$PIECE(X,"^",12)
+46 ; Lab subscript
SET $PIECE(LRSTUB,"|",19)=LRSS
+47 ; Lab section
SET $PIECE(LRSTUB,"|",20)=$GET(LOINCDTB(64,LRPNTB,13,"E"))
+48 SET LRINDX=LRST_"-"_LR64_"-"_LR61_"-"_LOINCDTA(64.02,LRAA,.01,"I")
+49 SET LRSTR=LRSTR_LRINDX_"|"_LRSTUB_LRCRLF
+50 DO SETDATA^LRSRVR2
+51 SET LRCNT=LRCNT+1
End DoDot:2
End DoDot:1
+52 QUIT
+53 ;
+54 ;
MICRO(LR64) ;
+1 NEW LOINCDTB,LR6421,LRPNTB,LRSTUB
+2 SET LRSTUB=""
+3 DO GETS^DIQ(64,LR64,".01;1;13;25;25.5","IE","LOINCDTB","LRERR")
+4 DO GETS^DIQ(64,LR64,"20*","IE","LOINCDTA","LRERR")
+5 SET LRPNTB=$ORDER(LOINCDTB(64,""))
if LRPNTB=""
QUIT LRSTUB
+6 ;
+7 ; NLT Code/Procedure
+8 SET LRSTUB=$GET(LOINCDTB(64,LRPNTB,1,"E"))
+9 SET $PIECE(LRSTUB,"|",2)=$GET(LOINCDTB(64,LRPNTB,.01,"I"))
+10 ;
+11 ; Default LOINC code/name
+12 SET $PIECE(LRSTUB,"|",3)=$GET(LOINCDTB(64,LRPNTB,25,"E"))
+13 SET $PIECE(LRSTUB,"|",4)=$GET(^LAB(95.3,+$GET(LOINCDTB(64,LRPNTB,25,"I")),81))
+14 ;
+15 ; Anti-microbial Suscept (62.06,.01)
+16 SET $PIECE(LRSTUB,"|",5)=$$GET1^DIQ(62.06,LR6206_",",.01)
+17 ;
+18 ; Lab subscript/section
+19 SET $PIECE(LRSTUB,"|",19)=LRSS
+20 ; Lab section
IF $GET(LOINCDTB(64,LRPNTB,13,"I"))
Begin DoDot:1
+21 SET LR6421=LOINCDTB(64,LRPNTB,13,"I")
+22 SET $PIECE(LRSTUB,"|",20)=$$GET1^DIQ(64.21,LR6421_",",1)
End DoDot:1
+23 ;
+24 QUIT LRSTUB
+25 ;
+26 ;
TSTTYP(LRX) ; Determine test data type
+1 NEW LRSTUB,LRTYPE,LRY
+2 IF LRX=""
QUIT "|"
+3 SET LRX=$PIECE(LRX,"(",2)
+4 ;
+5 ; Data type
+6 SET LRTYPE=$$GET1^DID($PIECE(LRX,","),$PIECE(LRX,",",2,99),"","TYPE")
+7 SET $PIECE(LRSTUB,"|",2)=LRTYPE
+8 ;
+9 ; Input transform
+10 SET LRY=$$GET1^DID($PIECE(LRX,","),$PIECE(LRX,",",2,99),"",$SELECT(LRTYPE="SET":"POINTER",1:"INPUT TRANSFORM"))
+11 IF LRTYPE="NUMERIC"
IF LRY["LRNUM"
Begin DoDot:1
+12 SET LRX=$PIECE(LRY,"""",2)
+13 IF LRX?.1"-".N1","1.N1","1N
SET LRY="Number from "_$PIECE(LRX,",")_" to "_$PIECE(LRX,",",2)_" with "_$PIECE(LRX,",",3)_" decimal"
End DoDot:1
+14 SET $PIECE(LRSTUB,"|",1)=LRY
+15 ; Help prompt
+16 IF LRTYPE="FREE TEXT"
Begin DoDot:1
+17 SET LRY=$$GET1^DID($PIECE(LRX,","),$PIECE(LRX,",",2,99),"","HELP-PROMPT")
+18 SET $PIECE(LRSTUB,"|",1)=LRY
End DoDot:1
+19 QUIT LRSTUB
