LRRPL ;DALOI/JMC - Interim Report Performing Lab Utility ;03/12/13 09:46
;;5.2;LAB SERVICE;**350,427**;Sep 27, 1994;Build 33
;
;
RETLST(LRPL,LRDFN,LRSS,LRIDT,LROPT) ; Retreive list of Report sections and related performing labs.
; Call with LRPL = array listing section and related performing lab name/address/CLIA (by reference)
; LRDFN = File #63 IEN
; LRSS = File #63 subscript
; LRIDT = File #63 inverse date/time of specimen
; LROPT = 0 (addresses); 1 (no addresses); 2 (list/iens)
;
; Returns LRPL = array listing section and related performing lab name/address/CLIA
;
N LRPLIEN,LRQUIT,LRREC,LRX
S (LRPL,LRQUIT)=0
S (LRX,LRREC)=LRDFN_","_LRSS_","_LRIDT_","
F S LRX=$O(^LR(LRDFN,"PL","B",LRX)) Q:LRX="" D Q:LRQUIT
. I $P(LRX,",",1,3)'=$P(LRREC,",",1,3) S LRQUIT=1 Q
. S LRPLIEN=$O(^LR(LRDFN,"PL","B",LRX,0))
. D RETSEC(.LRPL,LRDFN,LRPLIEN,LROPT)
;
Q
;
;
RETSEC(LRREC,LRDFN,LRPLIEN,LROPT) ; Retrieve Report section and related performing lab.
; Call with LRREC = array listing section and related performing lab name/address/CLIA (by reference)
; LRDFN = File #63 IEN
; LRPLIEN = Reference to entry in "PL" subscript
; LROPT = 0 (addresses); 1 (no addresses); 2 (list/iens)
;
; Returns LRREC = array listing section and related performing lab name/address/CLIA
;
N CLIA,LR4,LRREF,LRX
S LRX=^LR(LRDFN,"PL",LRPLIEN,0),LRREF=$P(LRX,"^"),LR4=$P(LRX,"^",2)
;
; Check reference to determine what component of report it's associated with.
; and construct the performing laboratory statement.
S LRREC=$O(LRREC(""),-1)
I LRREC>1 S LRREC=LRREC+1,LRREC(LRREC)=" "
S LRREC=LRREC+1,LRREC(LRREC)=""
I $P(LRREF,",",2)?1(1"CH",1"MI") D @($P(LRREF,",",2)_"CHK")
I $P(LRREF,",",2)?1(1"SP",1"CY",1"EM") D APCHK
I $P(LRREF,",",2)="AU" D AUCHK
;
I LROPT=2 S LRX=$O(LRREC(0,""),-1)+1,LRREC(0,LRX)=LRREF_"^"_LRPLIEN_"^"_LRREC(LRREC)
;
S LRREC(LRREC)=LRREC(LRREC)_" Performed By: "
S LRREC=LRREC+1,LRREC(LRREC)=$$NAME^XUAF4(LR4)
;
S CLIA=$$ID^XUAF4("CLIA",LR4)
I CLIA'="" D
. I $L(LRREC(LRREC))<(IOM-20) S LRREC(LRREC)=LRREC(LRREC)_" [CLIA# "_CLIA_"]"
. E S LRREC=LRREC+1,LRREC(LRREC)="CLIA# "_CLIA
;
I LROPT>1 Q
S LRX=$$PADD^XUAF4(LR4),LRX(1)=$$WHAT^XUAF4(LR4,1.02)
I LRX="" Q
S LRREC=LRREC+1
S LRREC(LRREC)=$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)
;
Q
;
;
CHCHK ; Check and resolve CH subscript
;
Q
;
;
MICHK ; Check and resolve MI subscript
;
; If entire report flagged then check if only one section and report that section
; otherwise report as "microbiology report" when multiple sections.
I $P(LRREF,",",4)=0 D Q
. N LRSECT,X,Y
. S LRREC(LRREC)="Microbiology Report",LRSECT=0
. F X=1,5,8,11,16 D Q:LRSECT=""
. . I '$D(^LR(LRDFN,"MI",$P(LRREF,",",3),X)) Q
. . I LRSECT=0 S LRSECT=X
. . E S LRSECT=""
. I LRSECT<1 Q
. S X="Bacteriology^^^^Parasitology^^^Mycology^^^Mycobacteriology^^^^^Virology"
. S Y=$P(X,"^",LRSECT)
. I Y'="" S LRREC(LRREC)=Y_" Report"
;
I $P($P(LRREF,";"),",",4)=1 D Q
. I $P(LRREF,";",2)=5 S LRREC(LRREC)="Sputum Screen" Q
. I $P(LRREF,";",2)=6 S LRREC(LRREC)="Urine Screen" Q
. S LRREC(LRREC)="Bacteriology Report"
;
I $P(LRREF,",",4)=2 D Q
. I $P(LRREF,",",5)=0 S LRREC(LRREC)="Gram Stain" Q
. S LRREC(LRREC)="Gram Stain Comment #"_$$CMTSEQ(LRREF)
;
I $P(LRREF,",",4)=3 D Q
. N LRORG
. I $P(LRREF,",",5)=0 S LRREC(LRREC)="Organism Identification" Q
. S LRORG=$$GETORG(LRREF)
. I $P(LRREF,",",6)=1 D Q
. . I $P(LRREF,",",7)>0 S LRREC(LRREC)=LRORG_" Comment #"_$$CMTSEQ(LRREF) Q
. . S LRREC(LRREC)=LRORG_" Comment"
. I ($P(LRREF,",",6)\1)=2 S LRREC(LRREC)=LRORG_" "_$$GETDRUG(3,$P(LRREF,",",6))_" Susceptibility" Q
. I $P(LRREF,",",6)=3,$P(LRREF,",",7)>0 S LRREC(LRREC)=LRORG_" "_$$GETDRUG2(LRREF)_" Susceptibility" Q
. S LRREC(LRREC)=LRORG
;
I $P(LRREF,",",4)=4 D Q
. I $P(LRREF,",",5)=0 S LRREC(LRREC)="Bact Report Remark" Q
. S LRREC(LRREC)="Bact Report Remark #"_$$CMTSEQ(LRREF)
;
I $P(LRREF,",",4)=5 S LRREC(LRREC)="Parasitology Report" Q
;
I $P(LRREF,",",4)=6 D Q
. I $P(LRREF,",",5)=0 S LRREC(LRREC)="Parasite Identification" Q
. S LRORG=$$GETORG(LRREF)
. I $P(LRREF,",",8)=1 D Q
. . I $P(LRREF,",",9)>0 S LRREC(LRREC)=LRORG_" Stage Comment #"_$$CMTSEQ(LRREF) Q
. . S LRREC(LRREC)=LRORG_" Stage Comment"
. I $P(LRREF,",",7)>0 S LRREC(LRREC)=LRORG_" Parasite Stage" Q
. S LRREC(LRREC)=LRORG
;
I $P(LRREF,",",4)=7 D Q
. I $P(LRREF,",",5)=0 S LRREC(LRREC)="Parasitology Report Remark" Q
. S LRREC(LRREC)="Parasitology Report Remark #"_$P(LRREF,",",5)
;
I $P(LRREF,",",4)=8 S LRREC(LRREC)="Mycology Report" Q
;
I $P(LRREF,",",4)=9 D Q
. I $P(LRREF,",",5)=0 S LRREC(LRREC)="Fungal Identification" Q
. S LRORG=$$GETORG(LRREF)
. I $P(LRREF,",",6)=1 D Q
. . I $P(LRREF,",",7)>0 S LRREC(LRREC)=LRORG_" Comment #"_$$CMTSEQ(LRREF) Q
. . S LRREC(LRREC)=LRORG_" Comment"
. S LRREC(LRREC)=LRORG
;
I $P(LRREF,",",4)=10 D Q
. I $P(LRREF,",",5)=0 S LRREC(LRREC)="Mycology Report Remark" Q
. S LRREC(LRREC)="Mycology Report Remark #"_$$CMTSEQ(LRREF) Q
;
I $P($P(LRREF,";"),",",4)=11 D Q
. I $P(LRREF,";",2)=3 S LRREC(LRREC)="Acid Fast Stain" Q
. S LRREC(LRREC)="Mycobacteriology Report"
;
I $P(LRREF,",",4)=12 D
. N LRORG
. I $P(LRREF,",",5)=0 S LRREC(LRREC)="Mycobacterium Identification" Q
. S LRORG=$$GETORG(LRREF)
. I $P(LRREF,",",6)=1 D Q
. . I $P(LRREF,",",7)>0 S LRREC(LRREC)=LRORG_" Comment #"_$$CMTSEQ(LRREF) Q
. . S LRREC(LRREC)=LRORG_" Comment"
. I $P(LRREF,",",6)>1 S LRREC(LRREC)=LRORG_" "_$$GETDRUG(12,$P(LRREF,",",6))_" Susceptibility" Q
. S LRREC(LRREC)=LRORG
;
I $P(LRREF,",",4)=13 D Q
. I $P(LRREF,",",5)=0 S LRREC(LRREC)="Mycobacteriology Report Remark" Q
. S LRREC(LRREC)="Mycobacteriology Report Remark #"_$$CMTSEQ(LRREF)
;
I $P(LRREF,",",4)=14 D Q
. I $P(LRREF,",",5)=0 S LRREC(LRREC)="Antibiotic Serum Level" Q
. S LRREC(LRREC)="Antibiotic Serum Level "_$$GETDRUG2(LRREF)
;
I $P(LRREF,",",4)=15 D Q
. I $P(LRREF,",",5)=0 S LRREC(LRREC)="Mycology Smear/Prep" Q
. S LRREC(LRREC)="Mycology smear/prep Remark #"_$$CMTSEQ(LRREF)
;
I $P(LRREF,",",4)=16 S LRREC(LRREC)="Virology Report" Q
;
I $P(LRREF,",",4)=17 D Q
. I $P(LRREF,",",5)=0 S LRREC(LRREC)="Virus Identification" Q
. S LRORG=$$GETORG(LRREF)
. S LRREC(LRREC)=LRORG
;
I $P(LRREF,",",4)=18 D Q
. I $P(LRREF,",",5)=0 S LRREC(LRREC)="Virology Report Remark" Q
. S LRREC(LRREC)="Virology Report Remark #"_$$CMTSEQ(LRREF)
;
I $P(LRREF,",",4)>18,$P(LRREF,",",4)<31 D Q
. N LRI,LRX
. S LRI=$P(LRREF,",",4)
. I LRI>18,LRI<24 S LRX="Preliminary "_$S(LRI=19:"BACT",LRI=20:"VIROLOGY",LRI=21:"PARASITOLOGY",LRI=22:"MYCOLOGY",1:"TB")_" Comment"
. I LRI>23,LRI<26 S LRX=$S(LRI=24:"PARASITOLOGY",1:"BACTERIOLOGY")_" SMEAR/PREP"
. I LRI>25,LRI<31 S LRX=$S(LRI=26:"BACTERIOLOGY",LRI=27:"PARASITOLOGY",LRI=28:"MYCOLOGY",LRI=29:"TB",1:"VIROLOGY")_" TESTS"
. I $P(LRREF,",",5)=0 S LRREC(LRREC)=LRX Q
. S LRREC(LRREC)=LRX_" #"_$$CMTSEQ(LRREF)
;
; Sterility Results
I $P(LRREF,",",4)=31 S LRREC(LRREC)="Sterility Results" Q
;
; Comment on specimen
I $P(LRREF,",",4)=99 S LRREC(LRREC)="Comment On Specimen" Q
;
Q
;
;
APCHK ; Check and resolve SP, CY and EM subscript
;
N LRSS
S LRSS=$P(LRREF,",",2)
;
; Type of report
I $P(LRREF,",",4)=0 S LRREC(LRREC)=$S(LRSS="SP":"Surgical Pathology",LRSS="CY":"Cytology",LRSS="EM":"Electron Microscopy",1:"")_" Report" Q
;
; Frozen section
I LRSS="SP",$P(LRREF,",",4)=1.3 S LRREC(LRREC)="Frozen Section" Q
;
; Info accompanying request
I $P(LRREF,",",4)=.2 S LRREC(LRREC)="Brief Clinical History" Q
I $P(LRREF,",",4)=.3 S LRREC(LRREC)="Preoperative Diagnosis" Q
I $P(LRREF,",",4)=.4 S LRREC(LRREC)="Operative Findings" Q
I $P(LRREF,",",4)=.5 S LRREC(LRREC)="Post-Operative Diagnosis" Q
;
; Descriptions
I $P(LRREF,",",4)=1 S LRREC(LRREC)="Gross Description" Q
I $P(LRREF,",",4)=1.1 S LRREC(LRREC)="Microscopic Description" Q
;
; Surgical Path Diagnois
I $P(LRREF,",",4)=1.4 S LRREC(LRREC)="Surgical Path Diagnosis" Q
;
; Supplementary Reports
I $P(LRREF,",",4)=1.2 D Q
. N LRI,LRX
. I $P(LRREF,",",5)=0 S LRREC(LRREC)="Supplementary Report" Q
. S LRI=$G(^LR($P(LRREF,","),$P(LRREF,",",2),$P(LRREF,",",3),$P(LRREF,",",4),$P(LRREF,",",5),0))
. S LRX=$$FMTE^XLFDT(+LRI,"1MZ")
. S LRREC(LRREC)="Supplementary Report for "_LRX
;
; Special Studies
I $P(LRREF,",",4)=2 D Q
. N LRI,LRX,LRSST
. I $P(LRREF,",",5)=0 S LRREC(LRREC)="Special Studies" Q
. S LRI=$G(^LR($P(LRREF,","),$P(LRREF,",",2),$P(LRREF,",",3),$P(LRREF,",",4),$P(LRREF,",",5),0))
. S LRX=$P(^LAB(61,+LRI,0),"^")
. I $P(LRREF,",",7) D Q
. . S LRI=$G(^LR($P(LRREF,","),$P(LRREF,",",2),$P(LRREF,",",3),$P(LRREF,",",4),$P(LRREF,",",5),5,$P(LRREF,",",7),0))
. . S LRSST=$$EXTERNAL^DILFD(63.819,.01,"",$P(LRI,"^"),"")
. . S LRREC(LRREC)="Special Studies on "_LRX_" "_LRSST
. S LRREC(LRREC)="Special Studies on "_LRX
;
; Delayed report comment
I $P(LRREF,",",4)=97 D Q
. I $P(LRREF,",",5)>0 S LRREC(LRREC)="Delayed Report Comment #"_$$CMTSEQ(LRREF) Q
. S LRREC(LRREC)="Delayed Report Comment"
;
I $P(LRREF,",",4)=99 D Q
. I $P(LRREF,",",5)>0 S LRREC(LRREC)="Comment #"_$$CMTSEQ(LRREF) Q
. S LRREC(LRREC)="Comment"
Q
;
;
AUCHK ; Check and resolve AU subscript
;
; Type of report
I $P(LRREF,",",4)="AU",$P(LRREF,",",5)=0 S LRREC(LRREC)="Autospy" Q
;
I $P(LRREF,",",4)="AZC" D
. I $P(LRREF,",",5)>0 S LRREC(LRREC)="Autopsy Comment #"_$$CMTSEQ(LRREF) Q
. S LRREC(LRREC)="Autopsy Comment"
;
; Descriptions
I $P(LRREF,",",4)=81 S LRREC(LRREC)="Clinical Diagnoses" Q
I $P(LRREF,",",4)=82 S LRREC(LRREC)="Pathological Diagnoses" Q
;
; Special Studies
I $P(LRREF,",",4)="AY" D Q
. N LRI,LRX,LRSST
. I $P(LRREF,",",5)=0 S LRREC(LRREC)="Special Studies" Q
. S LRI=$G(^LR($P(LRREF,","),$P(LRREF,",",4),$P(LRREF,",",5),0))
. S LRX=$P(^LAB(61,+LRI,0),"^")
. I $P(LRREF,",",5) D Q
. . S LRI=$G(^LR($P(LRREF,","),$P(LRREF,",",4),$P(LRREF,",",5),$P(LRREF,",",6),$P(LRREF,",",7),0))
. . S LRSST=$$EXTERNAL^DILFD(63.26,.01,"",$P(LRI,"^"),"")
. . S LRREC(LRREC)="Special Studies on "_LRX_" "_LRSST
. S LRREC(LRREC)="Special Studies on "_LRX
;
; Supplementary Reports
I $P(LRREF,",",4)=84 D Q
. N LRI,LRX
. I $P(LRREF,",",5)=0 S LRREC(LRREC)="Supplementary Report" Q
. S LRI=$G(^LR($P(LRREF,","),84,$P(LRREF,",",3),0))
. S LRX=$$FMTE^XLFDT(+LRI,"1MZ")
. S LRREC(LRREC)="Supplementary Report for "_LRX
;
Q
;
;
GETORG(LRREF) ; Retrieve name of organism from file #61.2
; Call with LRREF = reference to entry in file #63
;
N LRI,LRX
S LRI=$G(^LR($P(LRREF,","),$P(LRREF,",",2),$P(LRREF,",",3),$P(LRREF,",",4),$P(LRREF,",",5),0))
S LRX=$$TITLE^XLFSTR($P($G(^LAB(61.2,+LRI,0)),"^"))
;
Q LRX
;
;
GETDRUG(LRSECT,LRJ) ; Retreive name of drug in file #62.06 from drug data name
; Call with LRSECT = drug section in MI subscript (3=bacteria/12-TB)
; LRJ = drug node
;
; Returns LRDN = name of drug
;
N LRDN
S LRDN=$O(^LAB(62.06,$S(LRSECT=3:"AD",1:"AD1"),LRJ,0))
I LRDN S LRDN=$$TITLE^XLFSTR($P($G(^LAB(62.06,LRDN,0)),"^"))
;
Q LRDN
;
;
GETDRUG2(LRREF) ; Retreive name of drug in file 63.32 (#200) ANTIBIOTIC or file 63.42A (#28) ANTIBIOTIC LEVEL
; Call with LRREF = reference to entry in file #63
;
; Returns LRDN = name of drug
;
N LRDN,LRI
I $P(LRREF,",",7)="" S LRI=$G(^LR($P(LRREF,","),$P(LRREF,",",2),$P(LRREF,",",3),$P(LRREF,",",4),$P(LRREF,",",5),$P(LRREF,",",6)))
E S LRI=$G(^LR($P(LRREF,","),$P(LRREF,",",2),$P(LRREF,",",3),$P(LRREF,",",4),$P(LRREF,",",5),$P(LRREF,",",6),$P(LRREF,",",7),$P(LRREF,",",8)))
S LRDN=$P(LRI,"^")
;
Q LRDN
;
;
CMTSEQ(LRREF) ; Determine the sequence # for a comment line
; Deal with intervening comments being deleted during edits resulting in the comment IEN being
; different than the display sequence #.
;
; Call with LRREF = id reference of specific comment
;
; Returns LRY = display sequence #
;
N LRDFN,LRI,LRIDT,LRSECT,LRSS,LRX,LRY
S (LRY,LRI)=0
S LRDFN=$P(LRREF,",")
I $P(LRREF,",",2)?1(1"CH",1"MI",1"SP",1"CY",1"EM") S LRSS=$P(LRREF,",",2),LRIDT=$P(LRREF,",",3),LRSECT=$P(LRREF,",",4)
E S LRSS="AU",LRSECT=$P(LRREF,",",2)
;
I LRSS="MI" D MISEQ
;
; Check AP comments
I LRSS?1(1"SP",1"CY",1"EM"),(LRSECT=97!(LRSECT=99)) D
. F S LRI=$O(^LR(LRDFN,LRSS,LRIDT,LRSECT,LRI)) Q:'LRI S LRY=LRY+1 I LRI=$P(LRREF,"^",5) Q
;
I LRSS="AU" D
. F S LRI=$O(^LR(LRDFN,LRSECT,LRI)) Q:'LRI S LRY=LRY+1 I LRI=$P(LRREF,"^",4) Q
;
Q LRY
;
;
MISEQ ; Check for comment seq on MI subscript
;
; Sections 2,4,7,10,13,14,15,18-30
S LRX="^1^^1^^^1^^^1^^^1^1^1^^^1^1^1^1^1^1^1^1^1^1^1^1^1^"
I $P(LRX,"^",LRSECT) D Q
. F S LRI=$O(^LR(LRDFN,LRSS,LRIDT,LRSECT,LRI)) Q:'LRI S LRY=LRY+1 I LRI=$P(LRREF,",",5) Q
;
; Sections 3,9,12
S LRX="^^1^^^^^^1^^^1^"
I $P(LRX,"^",LRSECT) D Q
. F S LRI=$O(^LR(LRDFN,LRSS,LRIDT,LRSECT,$P(LRREF,",",5),1,LRI)) Q:'LRI S LRY=LRY+1 I LRI=$P(LRREF,",",7) Q
;
; Section 6 - Parasite Stage Comment (multiple 3 levels down)
I LRSECT=6 D Q
. F S LRI=$O(^LR(LRDFN,LRSS,LRIDT,LRSECT,$P(LRREF,",",5),1,$P(LRREF,",",6),1,LRI)) Q:'LRI S LRY=LRY+1 I LRI=$P(LRREF,",",9) Q
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRRPL 13556 printed Dec 13, 2024@02:20:08 Page 2
LRRPL ;DALOI/JMC - Interim Report Performing Lab Utility ;03/12/13 09:46
+1 ;;5.2;LAB SERVICE;**350,427**;Sep 27, 1994;Build 33
+2 ;
+3 ;
RETLST(LRPL,LRDFN,LRSS,LRIDT,LROPT) ; Retreive list of Report sections and related performing labs.
+1 ; Call with LRPL = array listing section and related performing lab name/address/CLIA (by reference)
+2 ; LRDFN = File #63 IEN
+3 ; LRSS = File #63 subscript
+4 ; LRIDT = File #63 inverse date/time of specimen
+5 ; LROPT = 0 (addresses); 1 (no addresses); 2 (list/iens)
+6 ;
+7 ; Returns LRPL = array listing section and related performing lab name/address/CLIA
+8 ;
+9 NEW LRPLIEN,LRQUIT,LRREC,LRX
+10 SET (LRPL,LRQUIT)=0
+11 SET (LRX,LRREC)=LRDFN_","_LRSS_","_LRIDT_","
+12 FOR
SET LRX=$ORDER(^LR(LRDFN,"PL","B",LRX))
if LRX=""
QUIT
Begin DoDot:1
+13 IF $PIECE(LRX,",",1,3)'=$PIECE(LRREC,",",1,3)
SET LRQUIT=1
QUIT
+14 SET LRPLIEN=$ORDER(^LR(LRDFN,"PL","B",LRX,0))
+15 DO RETSEC(.LRPL,LRDFN,LRPLIEN,LROPT)
End DoDot:1
if LRQUIT
QUIT
+16 ;
+17 QUIT
+18 ;
+19 ;
RETSEC(LRREC,LRDFN,LRPLIEN,LROPT) ; Retrieve Report section and related performing lab.
+1 ; Call with LRREC = array listing section and related performing lab name/address/CLIA (by reference)
+2 ; LRDFN = File #63 IEN
+3 ; LRPLIEN = Reference to entry in "PL" subscript
+4 ; LROPT = 0 (addresses); 1 (no addresses); 2 (list/iens)
+5 ;
+6 ; Returns LRREC = array listing section and related performing lab name/address/CLIA
+7 ;
+8 NEW CLIA,LR4,LRREF,LRX
+9 SET LRX=^LR(LRDFN,"PL",LRPLIEN,0)
SET LRREF=$PIECE(LRX,"^")
SET LR4=$PIECE(LRX,"^",2)
+10 ;
+11 ; Check reference to determine what component of report it's associated with.
+12 ; and construct the performing laboratory statement.
+13 SET LRREC=$ORDER(LRREC(""),-1)
+14 IF LRREC>1
SET LRREC=LRREC+1
SET LRREC(LRREC)=" "
+15 SET LRREC=LRREC+1
SET LRREC(LRREC)=""
+16 IF $PIECE(LRREF,",",2)?1(1"CH",1"MI")
DO @($PIECE(LRREF,",",2)_"CHK")
+17 IF $PIECE(LRREF,",",2)?1(1"SP",1"CY",1"EM")
DO APCHK
+18 IF $PIECE(LRREF,",",2)="AU"
DO AUCHK
+19 ;
+20 IF LROPT=2
SET LRX=$ORDER(LRREC(0,""),-1)+1
SET LRREC(0,LRX)=LRREF_"^"_LRPLIEN_"^"_LRREC(LRREC)
+21 ;
+22 SET LRREC(LRREC)=LRREC(LRREC)_" Performed By: "
+23 SET LRREC=LRREC+1
SET LRREC(LRREC)=$$NAME^XUAF4(LR4)
+24 ;
+25 SET CLIA=$$ID^XUAF4("CLIA",LR4)
+26 IF CLIA'=""
Begin DoDot:1
+27 IF $LENGTH(LRREC(LRREC))<(IOM-20)
SET LRREC(LRREC)=LRREC(LRREC)_" [CLIA# "_CLIA_"]"
+28 IF '$TEST
SET LRREC=LRREC+1
SET LRREC(LRREC)="CLIA# "_CLIA
End DoDot:1
+29 ;
+30 IF LROPT>1
QUIT
+31 SET LRX=$$PADD^XUAF4(LR4)
SET LRX(1)=$$WHAT^XUAF4(LR4,1.02)
+32 IF LRX=""
QUIT
+33 SET LRREC=LRREC+1
+34 SET LRREC(LRREC)=$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)
+35 ;
+36 QUIT
+37 ;
+38 ;
CHCHK ; Check and resolve CH subscript
+1 ;
+2 QUIT
+3 ;
+4 ;
MICHK ; Check and resolve MI subscript
+1 ;
+2 ; If entire report flagged then check if only one section and report that section
+3 ; otherwise report as "microbiology report" when multiple sections.
+4 IF $PIECE(LRREF,",",4)=0
Begin DoDot:1
+5 NEW LRSECT,X,Y
+6 SET LRREC(LRREC)="Microbiology Report"
SET LRSECT=0
+7 FOR X=1,5,8,11,16
Begin DoDot:2
+8 IF '$DATA(^LR(LRDFN,"MI",$PIECE(LRREF,",",3),X))
QUIT
+9 IF LRSECT=0
SET LRSECT=X
+10 IF '$TEST
SET LRSECT=""
End DoDot:2
if LRSECT=""
QUIT
+11 IF LRSECT<1
QUIT
+12 SET X="Bacteriology^^^^Parasitology^^^Mycology^^^Mycobacteriology^^^^^Virology"
+13 SET Y=$PIECE(X,"^",LRSECT)
+14 IF Y'=""
SET LRREC(LRREC)=Y_" Report"
End DoDot:1
QUIT
+15 ;
+16 IF $PIECE($PIECE(LRREF,";"),",",4)=1
Begin DoDot:1
+17 IF $PIECE(LRREF,";",2)=5
SET LRREC(LRREC)="Sputum Screen"
QUIT
+18 IF $PIECE(LRREF,";",2)=6
SET LRREC(LRREC)="Urine Screen"
QUIT
+19 SET LRREC(LRREC)="Bacteriology Report"
End DoDot:1
QUIT
+20 ;
+21 IF $PIECE(LRREF,",",4)=2
Begin DoDot:1
+22 IF $PIECE(LRREF,",",5)=0
SET LRREC(LRREC)="Gram Stain"
QUIT
+23 SET LRREC(LRREC)="Gram Stain Comment #"_$$CMTSEQ(LRREF)
End DoDot:1
QUIT
+24 ;
+25 IF $PIECE(LRREF,",",4)=3
Begin DoDot:1
+26 NEW LRORG
+27 IF $PIECE(LRREF,",",5)=0
SET LRREC(LRREC)="Organism Identification"
QUIT
+28 SET LRORG=$$GETORG(LRREF)
+29 IF $PIECE(LRREF,",",6)=1
Begin DoDot:2
+30 IF $PIECE(LRREF,",",7)>0
SET LRREC(LRREC)=LRORG_" Comment #"_$$CMTSEQ(LRREF)
QUIT
+31 SET LRREC(LRREC)=LRORG_" Comment"
End DoDot:2
QUIT
+32 IF ($PIECE(LRREF,",",6)\1)=2
SET LRREC(LRREC)=LRORG_" "_$$GETDRUG(3,$PIECE(LRREF,",",6))_" Susceptibility"
QUIT
+33 IF $PIECE(LRREF,",",6)=3
IF $PIECE(LRREF,",",7)>0
SET LRREC(LRREC)=LRORG_" "_$$GETDRUG2(LRREF)_" Susceptibility"
QUIT
+34 SET LRREC(LRREC)=LRORG
End DoDot:1
QUIT
+35 ;
+36 IF $PIECE(LRREF,",",4)=4
Begin DoDot:1
+37 IF $PIECE(LRREF,",",5)=0
SET LRREC(LRREC)="Bact Report Remark"
QUIT
+38 SET LRREC(LRREC)="Bact Report Remark #"_$$CMTSEQ(LRREF)
End DoDot:1
QUIT
+39 ;
+40 IF $PIECE(LRREF,",",4)=5
SET LRREC(LRREC)="Parasitology Report"
QUIT
+41 ;
+42 IF $PIECE(LRREF,",",4)=6
Begin DoDot:1
+43 IF $PIECE(LRREF,",",5)=0
SET LRREC(LRREC)="Parasite Identification"
QUIT
+44 SET LRORG=$$GETORG(LRREF)
+45 IF $PIECE(LRREF,",",8)=1
Begin DoDot:2
+46 IF $PIECE(LRREF,",",9)>0
SET LRREC(LRREC)=LRORG_" Stage Comment #"_$$CMTSEQ(LRREF)
QUIT
+47 SET LRREC(LRREC)=LRORG_" Stage Comment"
End DoDot:2
QUIT
+48 IF $PIECE(LRREF,",",7)>0
SET LRREC(LRREC)=LRORG_" Parasite Stage"
QUIT
+49 SET LRREC(LRREC)=LRORG
End DoDot:1
QUIT
+50 ;
+51 IF $PIECE(LRREF,",",4)=7
Begin DoDot:1
+52 IF $PIECE(LRREF,",",5)=0
SET LRREC(LRREC)="Parasitology Report Remark"
QUIT
+53 SET LRREC(LRREC)="Parasitology Report Remark #"_$PIECE(LRREF,",",5)
End DoDot:1
QUIT
+54 ;
+55 IF $PIECE(LRREF,",",4)=8
SET LRREC(LRREC)="Mycology Report"
QUIT
+56 ;
+57 IF $PIECE(LRREF,",",4)=9
Begin DoDot:1
+58 IF $PIECE(LRREF,",",5)=0
SET LRREC(LRREC)="Fungal Identification"
QUIT
+59 SET LRORG=$$GETORG(LRREF)
+60 IF $PIECE(LRREF,",",6)=1
Begin DoDot:2
+61 IF $PIECE(LRREF,",",7)>0
SET LRREC(LRREC)=LRORG_" Comment #"_$$CMTSEQ(LRREF)
QUIT
+62 SET LRREC(LRREC)=LRORG_" Comment"
End DoDot:2
QUIT
+63 SET LRREC(LRREC)=LRORG
End DoDot:1
QUIT
+64 ;
+65 IF $PIECE(LRREF,",",4)=10
Begin DoDot:1
+66 IF $PIECE(LRREF,",",5)=0
SET LRREC(LRREC)="Mycology Report Remark"
QUIT
+67 SET LRREC(LRREC)="Mycology Report Remark #"_$$CMTSEQ(LRREF)
QUIT
End DoDot:1
QUIT
+68 ;
+69 IF $PIECE($PIECE(LRREF,";"),",",4)=11
Begin DoDot:1
+70 IF $PIECE(LRREF,";",2)=3
SET LRREC(LRREC)="Acid Fast Stain"
QUIT
+71 SET LRREC(LRREC)="Mycobacteriology Report"
End DoDot:1
QUIT
+72 ;
+73 IF $PIECE(LRREF,",",4)=12
Begin DoDot:1
+74 NEW LRORG
+75 IF $PIECE(LRREF,",",5)=0
SET LRREC(LRREC)="Mycobacterium Identification"
QUIT
+76 SET LRORG=$$GETORG(LRREF)
+77 IF $PIECE(LRREF,",",6)=1
Begin DoDot:2
+78 IF $PIECE(LRREF,",",7)>0
SET LRREC(LRREC)=LRORG_" Comment #"_$$CMTSEQ(LRREF)
QUIT
+79 SET LRREC(LRREC)=LRORG_" Comment"
End DoDot:2
QUIT
+80 IF $PIECE(LRREF,",",6)>1
SET LRREC(LRREC)=LRORG_" "_$$GETDRUG(12,$PIECE(LRREF,",",6))_" Susceptibility"
QUIT
+81 SET LRREC(LRREC)=LRORG
End DoDot:1
+82 ;
+83 IF $PIECE(LRREF,",",4)=13
Begin DoDot:1
+84 IF $PIECE(LRREF,",",5)=0
SET LRREC(LRREC)="Mycobacteriology Report Remark"
QUIT
+85 SET LRREC(LRREC)="Mycobacteriology Report Remark #"_$$CMTSEQ(LRREF)
End DoDot:1
QUIT
+86 ;
+87 IF $PIECE(LRREF,",",4)=14
Begin DoDot:1
+88 IF $PIECE(LRREF,",",5)=0
SET LRREC(LRREC)="Antibiotic Serum Level"
QUIT
+89 SET LRREC(LRREC)="Antibiotic Serum Level "_$$GETDRUG2(LRREF)
End DoDot:1
QUIT
+90 ;
+91 IF $PIECE(LRREF,",",4)=15
Begin DoDot:1
+92 IF $PIECE(LRREF,",",5)=0
SET LRREC(LRREC)="Mycology Smear/Prep"
QUIT
+93 SET LRREC(LRREC)="Mycology smear/prep Remark #"_$$CMTSEQ(LRREF)
End DoDot:1
QUIT
+94 ;
+95 IF $PIECE(LRREF,",",4)=16
SET LRREC(LRREC)="Virology Report"
QUIT
+96 ;
+97 IF $PIECE(LRREF,",",4)=17
Begin DoDot:1
+98 IF $PIECE(LRREF,",",5)=0
SET LRREC(LRREC)="Virus Identification"
QUIT
+99 SET LRORG=$$GETORG(LRREF)
+100 SET LRREC(LRREC)=LRORG
End DoDot:1
QUIT
+101 ;
+102 IF $PIECE(LRREF,",",4)=18
Begin DoDot:1
+103 IF $PIECE(LRREF,",",5)=0
SET LRREC(LRREC)="Virology Report Remark"
QUIT
+104 SET LRREC(LRREC)="Virology Report Remark #"_$$CMTSEQ(LRREF)
End DoDot:1
QUIT
+105 ;
+106 IF $PIECE(LRREF,",",4)>18
IF $PIECE(LRREF,",",4)<31
Begin DoDot:1
+107 NEW LRI,LRX
+108 SET LRI=$PIECE(LRREF,",",4)
+109 IF LRI>18
IF LRI<24
SET LRX="Preliminary "_$SELECT(LRI=19:"BACT",LRI=20:"VIROLOGY",LRI=21:"PARASITOLOGY",LRI=22:"MYCOLOGY",1:"TB")_" Comment"
+110 IF LRI>23
IF LRI<26
SET LRX=$SELECT(LRI=24:"PARASITOLOGY",1:"BACTERIOLOGY")_" SMEAR/PREP"
+111 IF LRI>25
IF LRI<31
SET LRX=$SELECT(LRI=26:"BACTERIOLOGY",LRI=27:"PARASITOLOGY",LRI=28:"MYCOLOGY",LRI=29:"TB",1:"VIROLOGY")_" TESTS"
+112 IF $PIECE(LRREF,",",5)=0
SET LRREC(LRREC)=LRX
QUIT
+113 SET LRREC(LRREC)=LRX_" #"_$$CMTSEQ(LRREF)
End DoDot:1
QUIT
+114 ;
+115 ; Sterility Results
+116 IF $PIECE(LRREF,",",4)=31
SET LRREC(LRREC)="Sterility Results"
QUIT
+117 ;
+118 ; Comment on specimen
+119 IF $PIECE(LRREF,",",4)=99
SET LRREC(LRREC)="Comment On Specimen"
QUIT
+120 ;
+121 QUIT
+122 ;
+123 ;
APCHK ; Check and resolve SP, CY and EM subscript
+1 ;
+2 NEW LRSS
+3 SET LRSS=$PIECE(LRREF,",",2)
+4 ;
+5 ; Type of report
+6 IF $PIECE(LRREF,",",4)=0
SET LRREC(LRREC)=$SELECT(LRSS="SP":"Surgical Pathology",LRSS="CY":"Cytology",LRSS="EM":"Electron Microscopy",1:"")_" Report"
QUIT
+7 ;
+8 ; Frozen section
+9 IF LRSS="SP"
IF $PIECE(LRREF,",",4)=1.3
SET LRREC(LRREC)="Frozen Section"
QUIT
+10 ;
+11 ; Info accompanying request
+12 IF $PIECE(LRREF,",",4)=.2
SET LRREC(LRREC)="Brief Clinical History"
QUIT
+13 IF $PIECE(LRREF,",",4)=.3
SET LRREC(LRREC)="Preoperative Diagnosis"
QUIT
+14 IF $PIECE(LRREF,",",4)=.4
SET LRREC(LRREC)="Operative Findings"
QUIT
+15 IF $PIECE(LRREF,",",4)=.5
SET LRREC(LRREC)="Post-Operative Diagnosis"
QUIT
+16 ;
+17 ; Descriptions
+18 IF $PIECE(LRREF,",",4)=1
SET LRREC(LRREC)="Gross Description"
QUIT
+19 IF $PIECE(LRREF,",",4)=1.1
SET LRREC(LRREC)="Microscopic Description"
QUIT
+20 ;
+21 ; Surgical Path Diagnois
+22 IF $PIECE(LRREF,",",4)=1.4
SET LRREC(LRREC)="Surgical Path Diagnosis"
QUIT
+23 ;
+24 ; Supplementary Reports
+25 IF $PIECE(LRREF,",",4)=1.2
Begin DoDot:1
+26 NEW LRI,LRX
+27 IF $PIECE(LRREF,",",5)=0
SET LRREC(LRREC)="Supplementary Report"
QUIT
+28 SET LRI=$GET(^LR($PIECE(LRREF,","),$PIECE(LRREF,",",2),$PIECE(LRREF,",",3),$PIECE(LRREF,",",4),$PIECE(LRREF,",",5),0))
+29 SET LRX=$$FMTE^XLFDT(+LRI,"1MZ")
+30 SET LRREC(LRREC)="Supplementary Report for "_LRX
End DoDot:1
QUIT
+31 ;
+32 ; Special Studies
+33 IF $PIECE(LRREF,",",4)=2
Begin DoDot:1
+34 NEW LRI,LRX,LRSST
+35 IF $PIECE(LRREF,",",5)=0
SET LRREC(LRREC)="Special Studies"
QUIT
+36 SET LRI=$GET(^LR($PIECE(LRREF,","),$PIECE(LRREF,",",2),$PIECE(LRREF,",",3),$PIECE(LRREF,",",4),$PIECE(LRREF,",",5),0))
+37 SET LRX=$PIECE(^LAB(61,+LRI,0),"^")
+38 IF $PIECE(LRREF,",",7)
Begin DoDot:2
+39 SET LRI=$GET(^LR($PIECE(LRREF,","),$PIECE(LRREF,",",2),$PIECE(LRREF,",",3),$PIECE(LRREF,",",4),$PIECE(LRREF,",",5),5,$PIECE(LRREF,",",7),0))
+40 SET LRSST=$$EXTERNAL^DILFD(63.819,.01,"",$PIECE(LRI,"^"),"")
+41 SET LRREC(LRREC)="Special Studies on "_LRX_" "_LRSST
End DoDot:2
QUIT
+42 SET LRREC(LRREC)="Special Studies on "_LRX
End DoDot:1
QUIT
+43 ;
+44 ; Delayed report comment
+45 IF $PIECE(LRREF,",",4)=97
Begin DoDot:1
+46 IF $PIECE(LRREF,",",5)>0
SET LRREC(LRREC)="Delayed Report Comment #"_$$CMTSEQ(LRREF)
QUIT
+47 SET LRREC(LRREC)="Delayed Report Comment"
End DoDot:1
QUIT
+48 ;
+49 IF $PIECE(LRREF,",",4)=99
Begin DoDot:1
+50 IF $PIECE(LRREF,",",5)>0
SET LRREC(LRREC)="Comment #"_$$CMTSEQ(LRREF)
QUIT
+51 SET LRREC(LRREC)="Comment"
End DoDot:1
QUIT
+52 QUIT
+53 ;
+54 ;
AUCHK ; Check and resolve AU subscript
+1 ;
+2 ; Type of report
+3 IF $PIECE(LRREF,",",4)="AU"
IF $PIECE(LRREF,",",5)=0
SET LRREC(LRREC)="Autospy"
QUIT
+4 ;
+5 IF $PIECE(LRREF,",",4)="AZC"
Begin DoDot:1
+6 IF $PIECE(LRREF,",",5)>0
SET LRREC(LRREC)="Autopsy Comment #"_$$CMTSEQ(LRREF)
QUIT
+7 SET LRREC(LRREC)="Autopsy Comment"
End DoDot:1
+8 ;
+9 ; Descriptions
+10 IF $PIECE(LRREF,",",4)=81
SET LRREC(LRREC)="Clinical Diagnoses"
QUIT
+11 IF $PIECE(LRREF,",",4)=82
SET LRREC(LRREC)="Pathological Diagnoses"
QUIT
+12 ;
+13 ; Special Studies
+14 IF $PIECE(LRREF,",",4)="AY"
Begin DoDot:1
+15 NEW LRI,LRX,LRSST
+16 IF $PIECE(LRREF,",",5)=0
SET LRREC(LRREC)="Special Studies"
QUIT
+17 SET LRI=$GET(^LR($PIECE(LRREF,","),$PIECE(LRREF,",",4),$PIECE(LRREF,",",5),0))
+18 SET LRX=$PIECE(^LAB(61,+LRI,0),"^")
+19 IF $PIECE(LRREF,",",5)
Begin DoDot:2
+20 SET LRI=$GET(^LR($PIECE(LRREF,","),$PIECE(LRREF,",",4),$PIECE(LRREF,",",5),$PIECE(LRREF,",",6),$PIECE(LRREF,",",7),0))
+21 SET LRSST=$$EXTERNAL^DILFD(63.26,.01,"",$PIECE(LRI,"^"),"")
+22 SET LRREC(LRREC)="Special Studies on "_LRX_" "_LRSST
End DoDot:2
QUIT
+23 SET LRREC(LRREC)="Special Studies on "_LRX
End DoDot:1
QUIT
+24 ;
+25 ; Supplementary Reports
+26 IF $PIECE(LRREF,",",4)=84
Begin DoDot:1
+27 NEW LRI,LRX
+28 IF $PIECE(LRREF,",",5)=0
SET LRREC(LRREC)="Supplementary Report"
QUIT
+29 SET LRI=$GET(^LR($PIECE(LRREF,","),84,$PIECE(LRREF,",",3),0))
+30 SET LRX=$$FMTE^XLFDT(+LRI,"1MZ")
+31 SET LRREC(LRREC)="Supplementary Report for "_LRX
End DoDot:1
QUIT
+32 ;
+33 QUIT
+34 ;
+35 ;
GETORG(LRREF) ; Retrieve name of organism from file #61.2
+1 ; Call with LRREF = reference to entry in file #63
+2 ;
+3 NEW LRI,LRX
+4 SET LRI=$GET(^LR($PIECE(LRREF,","),$PIECE(LRREF,",",2),$PIECE(LRREF,",",3),$PIECE(LRREF,",",4),$PIECE(LRREF,",",5),0))
+5 SET LRX=$$TITLE^XLFSTR($PIECE($GET(^LAB(61.2,+LRI,0)),"^"))
+6 ;
+7 QUIT LRX
+8 ;
+9 ;
GETDRUG(LRSECT,LRJ) ; Retreive name of drug in file #62.06 from drug data name
+1 ; Call with LRSECT = drug section in MI subscript (3=bacteria/12-TB)
+2 ; LRJ = drug node
+3 ;
+4 ; Returns LRDN = name of drug
+5 ;
+6 NEW LRDN
+7 SET LRDN=$ORDER(^LAB(62.06,$SELECT(LRSECT=3:"AD",1:"AD1"),LRJ,0))
+8 IF LRDN
SET LRDN=$$TITLE^XLFSTR($PIECE($GET(^LAB(62.06,LRDN,0)),"^"))
+9 ;
+10 QUIT LRDN
+11 ;
+12 ;
GETDRUG2(LRREF) ; Retreive name of drug in file 63.32 (#200) ANTIBIOTIC or file 63.42A (#28) ANTIBIOTIC LEVEL
+1 ; Call with LRREF = reference to entry in file #63
+2 ;
+3 ; Returns LRDN = name of drug
+4 ;
+5 NEW LRDN,LRI
+6 IF $PIECE(LRREF,",",7)=""
SET LRI=$GET(^LR($PIECE(LRREF,","),$PIECE(LRREF,",",2),$PIECE(LRREF,",",3),$PIECE(LRREF,",",4),$PIECE(LRREF,",",5),$PIECE(LRREF,",",6)))
+7 IF '$TEST
SET LRI=$GET(^LR($PIECE(LRREF,","),$PIECE(LRREF,",",2),$PIECE(LRREF,",",3),$PIECE(LRREF,",",4),$PIECE(LRREF,",",5),$PIECE(LRREF,",",6),$PIECE(LRREF,",",7),$PIECE(LRREF,",",8)))
+8 SET LRDN=$PIECE(LRI,"^")
+9 ;
+10 QUIT LRDN
+11 ;
+12 ;
CMTSEQ(LRREF) ; Determine the sequence # for a comment line
+1 ; Deal with intervening comments being deleted during edits resulting in the comment IEN being
+2 ; different than the display sequence #.
+3 ;
+4 ; Call with LRREF = id reference of specific comment
+5 ;
+6 ; Returns LRY = display sequence #
+7 ;
+8 NEW LRDFN,LRI,LRIDT,LRSECT,LRSS,LRX,LRY
+9 SET (LRY,LRI)=0
+10 SET LRDFN=$PIECE(LRREF,",")
+11 IF $PIECE(LRREF,",",2)?1(1"CH",1"MI",1"SP",1"CY",1"EM")
SET LRSS=$PIECE(LRREF,",",2)
SET LRIDT=$PIECE(LRREF,",",3)
SET LRSECT=$PIECE(LRREF,",",4)
+12 IF '$TEST
SET LRSS="AU"
SET LRSECT=$PIECE(LRREF,",",2)
+13 ;
+14 IF LRSS="MI"
DO MISEQ
+15 ;
+16 ; Check AP comments
+17 IF LRSS?1(1"SP",1"CY",1"EM")
IF (LRSECT=97!(LRSECT=99))
Begin DoDot:1
+18 FOR
SET LRI=$ORDER(^LR(LRDFN,LRSS,LRIDT,LRSECT,LRI))
if 'LRI
QUIT
SET LRY=LRY+1
IF LRI=$PIECE(LRREF,"^",5)
QUIT
End DoDot:1
+19 ;
+20 IF LRSS="AU"
Begin DoDot:1
+21 FOR
SET LRI=$ORDER(^LR(LRDFN,LRSECT,LRI))
if 'LRI
QUIT
SET LRY=LRY+1
IF LRI=$PIECE(LRREF,"^",4)
QUIT
End DoDot:1
+22 ;
+23 QUIT LRY
+24 ;
+25 ;
MISEQ ; Check for comment seq on MI subscript
+1 ;
+2 ; Sections 2,4,7,10,13,14,15,18-30
+3 SET LRX="^1^^1^^^1^^^1^^^1^1^1^^^1^1^1^1^1^1^1^1^1^1^1^1^1^"
+4 IF $PIECE(LRX,"^",LRSECT)
Begin DoDot:1
+5 FOR
SET LRI=$ORDER(^LR(LRDFN,LRSS,LRIDT,LRSECT,LRI))
if 'LRI
QUIT
SET LRY=LRY+1
IF LRI=$PIECE(LRREF,",",5)
QUIT
End DoDot:1
QUIT
+6 ;
+7 ; Sections 3,9,12
+8 SET LRX="^^1^^^^^^1^^^1^"
+9 IF $PIECE(LRX,"^",LRSECT)
Begin DoDot:1
+10 FOR
SET LRI=$ORDER(^LR(LRDFN,LRSS,LRIDT,LRSECT,$PIECE(LRREF,",",5),1,LRI))
if 'LRI
QUIT
SET LRY=LRY+1
IF LRI=$PIECE(LRREF,",",7)
QUIT
End DoDot:1
QUIT
+11 ;
+12 ; Section 6 - Parasite Stage Comment (multiple 3 levels down)
+13 IF LRSECT=6
Begin DoDot:1
+14 FOR
SET LRI=$ORDER(^LR(LRDFN,LRSS,LRIDT,LRSECT,$PIECE(LRREF,",",5),1,$PIECE(LRREF,",",6),1,LRI))
if 'LRI
QUIT
SET LRY=LRY+1
IF LRI=$PIECE(LRREF,",",9)
QUIT
End DoDot:1
QUIT
+15 ;
+16 QUIT
