- 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 Feb 18, 2025@23:46 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