- 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 Jan 18, 2025@03:06:25 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