LR7OSUM2 ;DALOI/staff - Silent Patient cum cont. ;08/28/09 14:13
;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
;
;
ORDBY ; List ordering provider
N L,LRMH,LRSH,LRY
S LRY=$$NAME^XUSER(LRPROV,"G")
;
S LRMH=0
F S LRMH=$O(^TMP($J,LRDFN,LRMH)) Q:'LRMH D
. S LRSH=0
. F S LRSH=$O(^TMP($J,LRDFN,LRMH,LRSH)) Q:'LRSH D
. . I '$D(^TMP($J,LRDFN,LRMH,LRSH,LRIDT)) Q
. . S L=+$O(^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",9999999),-1),L=L+1
. . I L>1 S ^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",L,0)=" ",L=L+1
. . S ^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",L,0)="Ordering Provider: "_LRY
. . S ^TMP("LRCMTINDX",$J,LRIDT)=""
;
I $D(^TMP($J,LRDFN,"MISC",LRIDT)) D
. S L=+$O(^TMP($J,LRDFN,"MISC",LRIDT,"TX",9999999),-1),L=L+1
. S ^TMP($J,LRDFN,"MISC",LRIDT,"TX",L,0)=" "
. S ^TMP($J,LRDFN,"MISC",LRIDT,"TX",L+1,0)="Ordering Provider: "_LRY
Q
;
;
RELDT ; List report release date/time
N L,LRMH,LRSH,LRY
S LRY=$$FMTE^XLFDT(LRVDT,"M")
;
S LRMH=0
F S LRMH=$O(^TMP($J,LRDFN,LRMH)) Q:'LRMH D
. S LRSH=0
. F S LRSH=$O(^TMP($J,LRDFN,LRMH,LRSH)) Q:'LRSH D
. . I '$D(^TMP($J,LRDFN,LRMH,LRSH,LRIDT)) Q
. . S L=+$O(^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",9999999),-1),L=L+1
. . S ^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",L,0)="Report Released..: "_LRY
. . S ^TMP("LRCMTINDX",$J,LRIDT)=""
;
I $D(^TMP($J,LRDFN,"MISC",LRIDT)) D
. S L=+$O(^TMP($J,LRDFN,"MISC",LRIDT,"TX",9999999),-1),L=L+1
. S ^TMP($J,LRDFN,"MISC",LRIDT,"TX",L+1,0)="Report Released..: "_LRY
Q
;
;
RL ; List reporting laboratory
N L,LINE,LRMH,LRSH,LRX
; Retrieve reporting lab
S LRX=+$G(^LR(LRDFN,"CH",LRIDT,"RF"))
I LRX<1 Q
S LINE=$$PLSADDR(LRX)
;
S LRMH=0
F S LRMH=$O(^TMP($J,LRDFN,LRMH)) Q:'LRMH D
. S LRSH=0
. F S LRSH=$O(^TMP($J,LRDFN,LRMH,LRSH)) Q:'LRSH D
. . I '$D(^TMP($J,LRDFN,LRMH,LRSH,LRIDT)) Q
. . S L=+$O(^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",9999999),-1),L=L+1
. . S ^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",L,0)="Reporting Lab....: "_$P(LINE,"^"),L=L+1
. . S ^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",L,0)=" "_$P(LINE,"^",2)
. . S ^TMP("LRCMTINDX",$J,LRIDT)=""
;
I $D(^TMP($J,LRDFN,"MISC",LRIDT)) D
. S L=+$O(^TMP($J,LRDFN,"MISC",LRIDT,"TX",9999999),-1),L=L+1
. S ^TMP($J,LRDFN,"MISC",LRIDT,"TX",L,0)="Reporting Lab....: "_$P(LINE,"^"),L=L+1
. S ^TMP($J,LRDFN,"MISC",LRIDT,"TX",L,0)=" "_$P(LINE,"^",2)
;
Q
;
;
PLS ; List performing laboratories
; If multiple performing labs then list tests associated with each lab.
;
N CLIA,CNT,LINE,LLEN,LRMH,LRMPLS,LRPLS,LRSH,OUTCNT,TESTNAME,X
;
; Tests formatted to a header
S LRMH=0
F S LRMH=$O(^TMP($J,LRDFN,LRMH)) Q:'LRMH D
. S LRSH=0
. F S LRSH=$O(^TMP($J,LRDFN,LRMH,LRSH)) Q:'LRSH D
. . I '$D(^TMP($J,LRDFN,LRMH,LRSH,LRIDT)) Q
. . S OUTCNT=+$O(^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",9999999),-1),OUTCNT=OUTCNT+1,CNT=0
. . S LRMPLS=+$O(^TMP("LRPLS",$J,LRMH,LRSH,0)),LRMPLS=+$O(^TMP("LRPLS",$J,LRMH,LRSH,LRMPLS)) ; More than one performing lab to report
. . S LRPLS=0
. . F S LRPLS=$O(^TMP("LRPLS",$J,LRMH,LRSH,LRPLS)) Q:LRPLS<1 D
. . . I CNT S ^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",OUTCNT,0)=" ",OUTCNT=OUTCNT+1
. . . I LRMPLS D
. . . . S TESTNAME="",LINE="For test(s): ",LLEN=13
. . . . F S TESTNAME=$O(^TMP("LRPLS",$J,LRMH,LRSH,LRPLS,TESTNAME)) Q:TESTNAME="" D
. . . . . S X=$L(TESTNAME)
. . . . . I (LLEN+X)>240 S ^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",OUTCNT,0)=LINE,OUTCNT=OUTCNT+1,LINE="",LLEN=0
. . . . . S LINE=LINE_$S(LLEN>13:", ",1:"")_TESTNAME,LLEN=LLEN+X+$S(LLEN>13:2,1:0)
. . . . I LINE'="" S ^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",OUTCNT,0)=LINE,OUTCNT=OUTCNT+1
. . . S LINE=$$PLSADDR(LRPLS)
. . . S ^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",OUTCNT,0)="Performing Lab...: "_$P(LINE,"^"),OUTCNT=OUTCNT+1,CNT=CNT+1
. . . S ^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",OUTCNT,0)=" "_$P(LINE,"^",2),OUTCNT=OUTCNT+1
. . I CNT>0 S ^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",OUTCNT,0)=" ",^TMP("LRCMTINDX",$J,LRIDT)=""
;
; Miscellaneous tests
S OUTCNT=+$O(^TMP($J,LRDFN,"MISC",LRIDT,"TX",9999999),-1),OUTCNT=OUTCNT+1,CNT=0
S LRMPLS=+$O(^TMP("LRPLS",$J,"MISC",0)),LRMPLS=+$O(^TMP("LRPLS",$J,"MISC",LRMPLS)) ; More than one performing lab to report
S LRPLS=0
F S LRPLS=$O(^TMP("LRPLS",$J,"MISC",LRPLS)) Q:LRPLS<1 D
. I CNT S ^TMP($J,LRDFN,"MISC",LRIDT,"TX",OUTCNT,0)=" ",OUTCNT=OUTCNT+1
. I LRMPLS D
. . S TESTNAME="",LINE="For test(s): ",LLEN=13
. . F S TESTNAME=$O(^TMP("LRPLS",$J,"MISC",LRPLS,TESTNAME)) Q:TESTNAME="" D
. . . S X=$L(TESTNAME)
. . . I (LLEN+X)>240 S ^TMP($J,LRDFN,"MISC",LRIDT,"TX",OUTCNT,0)=LINE,OUTCNT=OUTCNT+1,LINE="",LLEN=0
. . . S LINE=LINE_$S(LLEN>13:", ",1:"")_TESTNAME,LLEN=LLEN+X+$S(LLEN>13:2,1:0)
. . I LINE'="" S ^TMP($J,LRDFN,"MISC",LRIDT,"TX",OUTCNT,0)=LINE,OUTCNT=OUTCNT+1
. S LINE=$$PLSADDR(LRPLS)
. S ^TMP($J,LRDFN,"MISC",LRIDT,"TX",OUTCNT,0)="Performing Lab...: "_$P(LINE,"^"),OUTCNT=OUTCNT+1,CNT=CNT+1
. S ^TMP($J,LRDFN,"MISC",LRIDT,"TX",OUTCNT,0)=" "_$P(LINE,"^",2),OUTCNT=OUTCNT+1
I CNT>0 S ^TMP($J,LRDFN,"MISC",LRIDT,"TX",OUTCNT,0)=" "
;
K ^TMP("LRPLS",$J),^TMP("LRPLS-ADDR",$J)
Q
;
;
PLSADDR(LRPLS) ; Performing lab name/address/CLIA
; Call with LRPLS = ien of entry in file #4
; Returns LINE = name [CLIA# nnnn] ^ address of institution
;
; Saves information in TMP("LRPLS-ADDR",$J) for subsequent use by this process.
;
N CLIA,LINE,LRX
S LINE=""
I $D(^TMP("LRPLS-ADDR",$J,LRPLS)) S LINE=^TMP("LRPLS-ADDR",$J,LRPLS)
I LINE="" D
. S LINE=$$NAME^XUAF4(LRPLS),CLIA=$$ID^XUAF4("CLIA",LRPLS)
. I CLIA'="" S LINE=LINE_" [CLIA# "_CLIA_"]"
. S LRX=$$PADD^XUAF4(LRPLS),LRX(1)=$$WHAT^XUAF4(LRPLS,1.02)
. S LINE=LINE_"^"_$P(LRX,U)_" "_$S(LRX(1)'="":LRX(1)_" ",1:"")_$P(LRX,U,2)_$S($P(LRX,U,3)'="":", ",1:"")_$P(LRX,U,3)_" "_$P(LRX,U,4)
. S ^TMP("LRPLS-ADDR",$J,LRPLS)=LINE
Q LINE
;
;
CMTINDX ; Generate comment indexes for each specimen date/time
N CNT,LRIDT,LRNX
S LRIDT=0,CNT=1
F S LRIDT=$O(^TMP("LRCMTINDX",$J,LRIDT)) Q:'LRIDT S ^TMP("LRCMTINDX",$J,LRIDT)=$$LRNX(CNT),CNT=CNT+1
Q
;
;
LRNX(CNT) ; Generate comment index
; Call with CNT = current seed value
; Returns LRNX = comment index
N LRNX
;
S LRNX=""
F S J=CNT#26,LRNX=$C(96+$S(J=0:26,1:J))_LRNX,CNT=$S(CNT#26=0:(CNT\26)-1,1:CNT\26) Q:CNT<1
;
Q LRNX
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR7OSUM2 6350 printed Dec 13, 2024@02:05:42 Page 2
LR7OSUM2 ;DALOI/staff - Silent Patient cum cont. ;08/28/09 14:13
+1 ;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
+2 ;
+3 ;
ORDBY ; List ordering provider
+1 NEW L,LRMH,LRSH,LRY
+2 SET LRY=$$NAME^XUSER(LRPROV,"G")
+3 ;
+4 SET LRMH=0
+5 FOR
SET LRMH=$ORDER(^TMP($JOB,LRDFN,LRMH))
if 'LRMH
QUIT
Begin DoDot:1
+6 SET LRSH=0
+7 FOR
SET LRSH=$ORDER(^TMP($JOB,LRDFN,LRMH,LRSH))
if 'LRSH
QUIT
Begin DoDot:2
+8 IF '$DATA(^TMP($JOB,LRDFN,LRMH,LRSH,LRIDT))
QUIT
+9 SET L=+$ORDER(^TMP($JOB,LRDFN,LRMH,LRSH,LRIDT,"TX",9999999),-1)
SET L=L+1
+10 IF L>1
SET ^TMP($JOB,LRDFN,LRMH,LRSH,LRIDT,"TX",L,0)=" "
SET L=L+1
+11 SET ^TMP($JOB,LRDFN,LRMH,LRSH,LRIDT,"TX",L,0)="Ordering Provider: "_LRY
+12 SET ^TMP("LRCMTINDX",$JOB,LRIDT)=""
End DoDot:2
End DoDot:1
+13 ;
+14 IF $DATA(^TMP($JOB,LRDFN,"MISC",LRIDT))
Begin DoDot:1
+15 SET L=+$ORDER(^TMP($JOB,LRDFN,"MISC",LRIDT,"TX",9999999),-1)
SET L=L+1
+16 SET ^TMP($JOB,LRDFN,"MISC",LRIDT,"TX",L,0)=" "
+17 SET ^TMP($JOB,LRDFN,"MISC",LRIDT,"TX",L+1,0)="Ordering Provider: "_LRY
End DoDot:1
+18 QUIT
+19 ;
+20 ;
RELDT ; List report release date/time
+1 NEW L,LRMH,LRSH,LRY
+2 SET LRY=$$FMTE^XLFDT(LRVDT,"M")
+3 ;
+4 SET LRMH=0
+5 FOR
SET LRMH=$ORDER(^TMP($JOB,LRDFN,LRMH))
if 'LRMH
QUIT
Begin DoDot:1
+6 SET LRSH=0
+7 FOR
SET LRSH=$ORDER(^TMP($JOB,LRDFN,LRMH,LRSH))
if 'LRSH
QUIT
Begin DoDot:2
+8 IF '$DATA(^TMP($JOB,LRDFN,LRMH,LRSH,LRIDT))
QUIT
+9 SET L=+$ORDER(^TMP($JOB,LRDFN,LRMH,LRSH,LRIDT,"TX",9999999),-1)
SET L=L+1
+10 SET ^TMP($JOB,LRDFN,LRMH,LRSH,LRIDT,"TX",L,0)="Report Released..: "_LRY
+11 SET ^TMP("LRCMTINDX",$JOB,LRIDT)=""
End DoDot:2
End DoDot:1
+12 ;
+13 IF $DATA(^TMP($JOB,LRDFN,"MISC",LRIDT))
Begin DoDot:1
+14 SET L=+$ORDER(^TMP($JOB,LRDFN,"MISC",LRIDT,"TX",9999999),-1)
SET L=L+1
+15 SET ^TMP($JOB,LRDFN,"MISC",LRIDT,"TX",L+1,0)="Report Released..: "_LRY
End DoDot:1
+16 QUIT
+17 ;
+18 ;
RL ; List reporting laboratory
+1 NEW L,LINE,LRMH,LRSH,LRX
+2 ; Retrieve reporting lab
+3 SET LRX=+$GET(^LR(LRDFN,"CH",LRIDT,"RF"))
+4 IF LRX<1
QUIT
+5 SET LINE=$$PLSADDR(LRX)
+6 ;
+7 SET LRMH=0
+8 FOR
SET LRMH=$ORDER(^TMP($JOB,LRDFN,LRMH))
if 'LRMH
QUIT
Begin DoDot:1
+9 SET LRSH=0
+10 FOR
SET LRSH=$ORDER(^TMP($JOB,LRDFN,LRMH,LRSH))
if 'LRSH
QUIT
Begin DoDot:2
+11 IF '$DATA(^TMP($JOB,LRDFN,LRMH,LRSH,LRIDT))
QUIT
+12 SET L=+$ORDER(^TMP($JOB,LRDFN,LRMH,LRSH,LRIDT,"TX",9999999),-1)
SET L=L+1
+13 SET ^TMP($JOB,LRDFN,LRMH,LRSH,LRIDT,"TX",L,0)="Reporting Lab....: "_$PIECE(LINE,"^")
SET L=L+1
+14 SET ^TMP($JOB,LRDFN,LRMH,LRSH,LRIDT,"TX",L,0)=" "_$PIECE(LINE,"^",2)
+15 SET ^TMP("LRCMTINDX",$JOB,LRIDT)=""
End DoDot:2
End DoDot:1
+16 ;
+17 IF $DATA(^TMP($JOB,LRDFN,"MISC",LRIDT))
Begin DoDot:1
+18 SET L=+$ORDER(^TMP($JOB,LRDFN,"MISC",LRIDT,"TX",9999999),-1)
SET L=L+1
+19 SET ^TMP($JOB,LRDFN,"MISC",LRIDT,"TX",L,0)="Reporting Lab....: "_$PIECE(LINE,"^")
SET L=L+1
+20 SET ^TMP($JOB,LRDFN,"MISC",LRIDT,"TX",L,0)=" "_$PIECE(LINE,"^",2)
End DoDot:1
+21 ;
+22 QUIT
+23 ;
+24 ;
PLS ; List performing laboratories
+1 ; If multiple performing labs then list tests associated with each lab.
+2 ;
+3 NEW CLIA,CNT,LINE,LLEN,LRMH,LRMPLS,LRPLS,LRSH,OUTCNT,TESTNAME,X
+4 ;
+5 ; Tests formatted to a header
+6 SET LRMH=0
+7 FOR
SET LRMH=$ORDER(^TMP($JOB,LRDFN,LRMH))
if 'LRMH
QUIT
Begin DoDot:1
+8 SET LRSH=0
+9 FOR
SET LRSH=$ORDER(^TMP($JOB,LRDFN,LRMH,LRSH))
if 'LRSH
QUIT
Begin DoDot:2
+10 IF '$DATA(^TMP($JOB,LRDFN,LRMH,LRSH,LRIDT))
QUIT
+11 SET OUTCNT=+$ORDER(^TMP($JOB,LRDFN,LRMH,LRSH,LRIDT,"TX",9999999),-1)
SET OUTCNT=OUTCNT+1
SET CNT=0
+12 ; More than one performing lab to report
SET LRMPLS=+$ORDER(^TMP("LRPLS",$JOB,LRMH,LRSH,0))
SET LRMPLS=+$ORDER(^TMP("LRPLS",$JOB,LRMH,LRSH,LRMPLS))
+13 SET LRPLS=0
+14 FOR
SET LRPLS=$ORDER(^TMP("LRPLS",$JOB,LRMH,LRSH,LRPLS))
if LRPLS<1
QUIT
Begin DoDot:3
+15 IF CNT
SET ^TMP($JOB,LRDFN,LRMH,LRSH,LRIDT,"TX",OUTCNT,0)=" "
SET OUTCNT=OUTCNT+1
+16 IF LRMPLS
Begin DoDot:4
+17 SET TESTNAME=""
SET LINE="For test(s): "
SET LLEN=13
+18 FOR
SET TESTNAME=$ORDER(^TMP("LRPLS",$JOB,LRMH,LRSH,LRPLS,TESTNAME))
if TESTNAME=""
QUIT
Begin DoDot:5
+19 SET X=$LENGTH(TESTNAME)
+20 IF (LLEN+X)>240
SET ^TMP($JOB,LRDFN,LRMH,LRSH,LRIDT,"TX",OUTCNT,0)=LINE
SET OUTCNT=OUTCNT+1
SET LINE=""
SET LLEN=0
+21 SET LINE=LINE_$SELECT(LLEN>13:", ",1:"")_TESTNAME
SET LLEN=LLEN+X+$SELECT(LLEN>13:2,1:0)
End DoDot:5
+22 IF LINE'=""
SET ^TMP($JOB,LRDFN,LRMH,LRSH,LRIDT,"TX",OUTCNT,0)=LINE
SET OUTCNT=OUTCNT+1
End DoDot:4
+23 SET LINE=$$PLSADDR(LRPLS)
+24 SET ^TMP($JOB,LRDFN,LRMH,LRSH,LRIDT,"TX",OUTCNT,0)="Performing Lab...: "_$PIECE(LINE,"^")
SET OUTCNT=OUTCNT+1
SET CNT=CNT+1
+25 SET ^TMP($JOB,LRDFN,LRMH,LRSH,LRIDT,"TX",OUTCNT,0)=" "_$PIECE(LINE,"^",2)
SET OUTCNT=OUTCNT+1
End DoDot:3
+26 IF CNT>0
SET ^TMP($JOB,LRDFN,LRMH,LRSH,LRIDT,"TX",OUTCNT,0)=" "
SET ^TMP("LRCMTINDX",$JOB,LRIDT)=""
End DoDot:2
End DoDot:1
+27 ;
+28 ; Miscellaneous tests
+29 SET OUTCNT=+$ORDER(^TMP($JOB,LRDFN,"MISC",LRIDT,"TX",9999999),-1)
SET OUTCNT=OUTCNT+1
SET CNT=0
+30 ; More than one performing lab to report
SET LRMPLS=+$ORDER(^TMP("LRPLS",$JOB,"MISC",0))
SET LRMPLS=+$ORDER(^TMP("LRPLS",$JOB,"MISC",LRMPLS))
+31 SET LRPLS=0
+32 FOR
SET LRPLS=$ORDER(^TMP("LRPLS",$JOB,"MISC",LRPLS))
if LRPLS<1
QUIT
Begin DoDot:1
+33 IF CNT
SET ^TMP($JOB,LRDFN,"MISC",LRIDT,"TX",OUTCNT,0)=" "
SET OUTCNT=OUTCNT+1
+34 IF LRMPLS
Begin DoDot:2
+35 SET TESTNAME=""
SET LINE="For test(s): "
SET LLEN=13
+36 FOR
SET TESTNAME=$ORDER(^TMP("LRPLS",$JOB,"MISC",LRPLS,TESTNAME))
if TESTNAME=""
QUIT
Begin DoDot:3
+37 SET X=$LENGTH(TESTNAME)
+38 IF (LLEN+X)>240
SET ^TMP($JOB,LRDFN,"MISC",LRIDT,"TX",OUTCNT,0)=LINE
SET OUTCNT=OUTCNT+1
SET LINE=""
SET LLEN=0
+39 SET LINE=LINE_$SELECT(LLEN>13:", ",1:"")_TESTNAME
SET LLEN=LLEN+X+$SELECT(LLEN>13:2,1:0)
End DoDot:3
+40 IF LINE'=""
SET ^TMP($JOB,LRDFN,"MISC",LRIDT,"TX",OUTCNT,0)=LINE
SET OUTCNT=OUTCNT+1
End DoDot:2
+41 SET LINE=$$PLSADDR(LRPLS)
+42 SET ^TMP($JOB,LRDFN,"MISC",LRIDT,"TX",OUTCNT,0)="Performing Lab...: "_$PIECE(LINE,"^")
SET OUTCNT=OUTCNT+1
SET CNT=CNT+1
+43 SET ^TMP($JOB,LRDFN,"MISC",LRIDT,"TX",OUTCNT,0)=" "_$PIECE(LINE,"^",2)
SET OUTCNT=OUTCNT+1
End DoDot:1
+44 IF CNT>0
SET ^TMP($JOB,LRDFN,"MISC",LRIDT,"TX",OUTCNT,0)=" "
+45 ;
+46 KILL ^TMP("LRPLS",$JOB),^TMP("LRPLS-ADDR",$JOB)
+47 QUIT
+48 ;
+49 ;
PLSADDR(LRPLS) ; Performing lab name/address/CLIA
+1 ; Call with LRPLS = ien of entry in file #4
+2 ; Returns LINE = name [CLIA# nnnn] ^ address of institution
+3 ;
+4 ; Saves information in TMP("LRPLS-ADDR",$J) for subsequent use by this process.
+5 ;
+6 NEW CLIA,LINE,LRX
+7 SET LINE=""
+8 IF $DATA(^TMP("LRPLS-ADDR",$JOB,LRPLS))
SET LINE=^TMP("LRPLS-ADDR",$JOB,LRPLS)
+9 IF LINE=""
Begin DoDot:1
+10 SET LINE=$$NAME^XUAF4(LRPLS)
SET CLIA=$$ID^XUAF4("CLIA",LRPLS)
+11 IF CLIA'=""
SET LINE=LINE_" [CLIA# "_CLIA_"]"
+12 SET LRX=$$PADD^XUAF4(LRPLS)
SET LRX(1)=$$WHAT^XUAF4(LRPLS,1.02)
+13 SET LINE=LINE_"^"_$PIECE(LRX,U)_" "_$SELECT(LRX(1)'="":LRX(1)_" ",1:"")_$PIECE(LRX,U,2)_$SELECT($PIECE(LRX,U,3)'="":", ",1:"")_$PIECE(LRX,U,3)_" "_$PIECE(LRX,U,4)
+14 SET ^TMP("LRPLS-ADDR",$JOB,LRPLS)=LINE
End DoDot:1
+15 QUIT LINE
+16 ;
+17 ;
CMTINDX ; Generate comment indexes for each specimen date/time
+1 NEW CNT,LRIDT,LRNX
+2 SET LRIDT=0
SET CNT=1
+3 FOR
SET LRIDT=$ORDER(^TMP("LRCMTINDX",$JOB,LRIDT))
if 'LRIDT
QUIT
SET ^TMP("LRCMTINDX",$JOB,LRIDT)=$$LRNX(CNT)
SET CNT=CNT+1
+4 QUIT
+5 ;
+6 ;
LRNX(CNT) ; Generate comment index
+1 ; Call with CNT = current seed value
+2 ; Returns LRNX = comment index
+3 NEW LRNX
+4 ;
+5 SET LRNX=""
+6 FOR
SET J=CNT#26
SET LRNX=$CHAR(96+$SELECT(J=0:26,1:J))_LRNX
SET CNT=$SELECT(CNT#26=0:(CNT\26)-1,1:CNT\26)
if CNT<1
QUIT
+7 ;
+8 QUIT LRNX
