Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRRPL

LRRPL.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;
  1. 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)
  1. ; LRDFN = File #63 IEN
  1. ; LRSS = File #63 subscript
  1. ; LRIDT = File #63 inverse date/time of specimen
  1. ; LROPT = 0 (addresses); 1 (no addresses); 2 (list/iens)
  1. ;
  1. ; Returns LRPL = array listing section and related performing lab name/address/CLIA
  1. ;
  1. N LRPLIEN,LRQUIT,LRREC,LRX
  1. S (LRPL,LRQUIT)=0
  1. S (LRX,LRREC)=LRDFN_","_LRSS_","_LRIDT_","
  1. F S LRX=$O(^LR(LRDFN,"PL","B",LRX)) Q:LRX="" D Q:LRQUIT
  1. . I $P(LRX,",",1,3)'=$P(LRREC,",",1,3) S LRQUIT=1 Q
  1. . S LRPLIEN=$O(^LR(LRDFN,"PL","B",LRX,0))
  1. . D RETSEC(.LRPL,LRDFN,LRPLIEN,LROPT)
  1. ;
  1. Q
  1. ;
  1. ;
  1. 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)
  1. ; LRDFN = File #63 IEN
  1. ; LRPLIEN = Reference to entry in "PL" subscript
  1. ; LROPT = 0 (addresses); 1 (no addresses); 2 (list/iens)
  1. ;
  1. ; Returns LRREC = array listing section and related performing lab name/address/CLIA
  1. ;
  1. N CLIA,LR4,LRREF,LRX
  1. S LRX=^LR(LRDFN,"PL",LRPLIEN,0),LRREF=$P(LRX,"^"),LR4=$P(LRX,"^",2)
  1. ;
  1. ; Check reference to determine what component of report it's associated with.
  1. ; and construct the performing laboratory statement.
  1. S LRREC=$O(LRREC(""),-1)
  1. I LRREC>1 S LRREC=LRREC+1,LRREC(LRREC)=" "
  1. S LRREC=LRREC+1,LRREC(LRREC)=""
  1. I $P(LRREF,",",2)?1(1"CH",1"MI") D @($P(LRREF,",",2)_"CHK")
  1. I $P(LRREF,",",2)?1(1"SP",1"CY",1"EM") D APCHK
  1. I $P(LRREF,",",2)="AU" D AUCHK
  1. ;
  1. I LROPT=2 S LRX=$O(LRREC(0,""),-1)+1,LRREC(0,LRX)=LRREF_"^"_LRPLIEN_"^"_LRREC(LRREC)
  1. ;
  1. S LRREC(LRREC)=LRREC(LRREC)_" Performed By: "
  1. S LRREC=LRREC+1,LRREC(LRREC)=$$NAME^XUAF4(LR4)
  1. ;
  1. S CLIA=$$ID^XUAF4("CLIA",LR4)
  1. I CLIA'="" D
  1. . I $L(LRREC(LRREC))<(IOM-20) S LRREC(LRREC)=LRREC(LRREC)_" [CLIA# "_CLIA_"]"
  1. . E S LRREC=LRREC+1,LRREC(LRREC)="CLIA# "_CLIA
  1. ;
  1. I LROPT>1 Q
  1. S LRX=$$PADD^XUAF4(LR4),LRX(1)=$$WHAT^XUAF4(LR4,1.02)
  1. I LRX="" Q
  1. S LRREC=LRREC+1
  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)
  1. ;
  1. Q
  1. ;
  1. ;
  1. CHCHK ; Check and resolve CH subscript
  1. ;
  1. Q
  1. ;
  1. ;
  1. MICHK ; Check and resolve MI subscript
  1. ;
  1. ; If entire report flagged then check if only one section and report that section
  1. ; otherwise report as "microbiology report" when multiple sections.
  1. I $P(LRREF,",",4)=0 D Q
  1. . N LRSECT,X,Y
  1. . S LRREC(LRREC)="Microbiology Report",LRSECT=0
  1. . F X=1,5,8,11,16 D Q:LRSECT=""
  1. . . I '$D(^LR(LRDFN,"MI",$P(LRREF,",",3),X)) Q
  1. . . I LRSECT=0 S LRSECT=X
  1. . . E S LRSECT=""
  1. . I LRSECT<1 Q
  1. . S X="Bacteriology^^^^Parasitology^^^Mycology^^^Mycobacteriology^^^^^Virology"
  1. . S Y=$P(X,"^",LRSECT)
  1. . I Y'="" S LRREC(LRREC)=Y_" Report"
  1. ;
  1. I $P($P(LRREF,";"),",",4)=1 D Q
  1. . I $P(LRREF,";",2)=5 S LRREC(LRREC)="Sputum Screen" Q
  1. . I $P(LRREF,";",2)=6 S LRREC(LRREC)="Urine Screen" Q
  1. . S LRREC(LRREC)="Bacteriology Report"
  1. ;
  1. I $P(LRREF,",",4)=2 D Q
  1. . I $P(LRREF,",",5)=0 S LRREC(LRREC)="Gram Stain" Q
  1. . S LRREC(LRREC)="Gram Stain Comment #"_$$CMTSEQ(LRREF)
  1. ;
  1. I $P(LRREF,",",4)=3 D Q
  1. . N LRORG
  1. . I $P(LRREF,",",5)=0 S LRREC(LRREC)="Organism Identification" Q
  1. . S LRORG=$$GETORG(LRREF)
  1. . I $P(LRREF,",",6)=1 D Q
  1. . . I $P(LRREF,",",7)>0 S LRREC(LRREC)=LRORG_" Comment #"_$$CMTSEQ(LRREF) Q
  1. . . S LRREC(LRREC)=LRORG_" Comment"
  1. . I ($P(LRREF,",",6)\1)=2 S LRREC(LRREC)=LRORG_" "_$$GETDRUG(3,$P(LRREF,",",6))_" Susceptibility" Q
  1. . I $P(LRREF,",",6)=3,$P(LRREF,",",7)>0 S LRREC(LRREC)=LRORG_" "_$$GETDRUG2(LRREF)_" Susceptibility" Q
  1. . S LRREC(LRREC)=LRORG
  1. ;
  1. I $P(LRREF,",",4)=4 D Q
  1. . I $P(LRREF,",",5)=0 S LRREC(LRREC)="Bact Report Remark" Q
  1. . S LRREC(LRREC)="Bact Report Remark #"_$$CMTSEQ(LRREF)
  1. ;
  1. I $P(LRREF,",",4)=5 S LRREC(LRREC)="Parasitology Report" Q
  1. ;
  1. I $P(LRREF,",",4)=6 D Q
  1. . I $P(LRREF,",",5)=0 S LRREC(LRREC)="Parasite Identification" Q
  1. . S LRORG=$$GETORG(LRREF)
  1. . I $P(LRREF,",",8)=1 D Q
  1. . . I $P(LRREF,",",9)>0 S LRREC(LRREC)=LRORG_" Stage Comment #"_$$CMTSEQ(LRREF) Q
  1. . . S LRREC(LRREC)=LRORG_" Stage Comment"
  1. . I $P(LRREF,",",7)>0 S LRREC(LRREC)=LRORG_" Parasite Stage" Q
  1. . S LRREC(LRREC)=LRORG
  1. ;
  1. I $P(LRREF,",",4)=7 D Q
  1. . I $P(LRREF,",",5)=0 S LRREC(LRREC)="Parasitology Report Remark" Q
  1. . S LRREC(LRREC)="Parasitology Report Remark #"_$P(LRREF,",",5)
  1. ;
  1. I $P(LRREF,",",4)=8 S LRREC(LRREC)="Mycology Report" Q
  1. ;
  1. I $P(LRREF,",",4)=9 D Q
  1. . I $P(LRREF,",",5)=0 S LRREC(LRREC)="Fungal Identification" Q
  1. . S LRORG=$$GETORG(LRREF)
  1. . I $P(LRREF,",",6)=1 D Q
  1. . . I $P(LRREF,",",7)>0 S LRREC(LRREC)=LRORG_" Comment #"_$$CMTSEQ(LRREF) Q
  1. . . S LRREC(LRREC)=LRORG_" Comment"
  1. . S LRREC(LRREC)=LRORG
  1. ;
  1. I $P(LRREF,",",4)=10 D Q
  1. . I $P(LRREF,",",5)=0 S LRREC(LRREC)="Mycology Report Remark" Q
  1. . S LRREC(LRREC)="Mycology Report Remark #"_$$CMTSEQ(LRREF) Q
  1. ;
  1. I $P($P(LRREF,";"),",",4)=11 D Q
  1. . I $P(LRREF,";",2)=3 S LRREC(LRREC)="Acid Fast Stain" Q
  1. . S LRREC(LRREC)="Mycobacteriology Report"
  1. ;
  1. I $P(LRREF,",",4)=12 D
  1. . N LRORG
  1. . I $P(LRREF,",",5)=0 S LRREC(LRREC)="Mycobacterium Identification" Q
  1. . S LRORG=$$GETORG(LRREF)
  1. . I $P(LRREF,",",6)=1 D Q
  1. . . I $P(LRREF,",",7)>0 S LRREC(LRREC)=LRORG_" Comment #"_$$CMTSEQ(LRREF) Q
  1. . . S LRREC(LRREC)=LRORG_" Comment"
  1. . I $P(LRREF,",",6)>1 S LRREC(LRREC)=LRORG_" "_$$GETDRUG(12,$P(LRREF,",",6))_" Susceptibility" Q
  1. . S LRREC(LRREC)=LRORG
  1. ;
  1. I $P(LRREF,",",4)=13 D Q
  1. . I $P(LRREF,",",5)=0 S LRREC(LRREC)="Mycobacteriology Report Remark" Q
  1. . S LRREC(LRREC)="Mycobacteriology Report Remark #"_$$CMTSEQ(LRREF)
  1. ;
  1. I $P(LRREF,",",4)=14 D Q
  1. . I $P(LRREF,",",5)=0 S LRREC(LRREC)="Antibiotic Serum Level" Q
  1. . S LRREC(LRREC)="Antibiotic Serum Level "_$$GETDRUG2(LRREF)
  1. ;
  1. I $P(LRREF,",",4)=15 D Q
  1. . I $P(LRREF,",",5)=0 S LRREC(LRREC)="Mycology Smear/Prep" Q
  1. . S LRREC(LRREC)="Mycology smear/prep Remark #"_$$CMTSEQ(LRREF)
  1. ;
  1. I $P(LRREF,",",4)=16 S LRREC(LRREC)="Virology Report" Q
  1. ;
  1. I $P(LRREF,",",4)=17 D Q
  1. . I $P(LRREF,",",5)=0 S LRREC(LRREC)="Virus Identification" Q
  1. . S LRORG=$$GETORG(LRREF)
  1. . S LRREC(LRREC)=LRORG
  1. ;
  1. I $P(LRREF,",",4)=18 D Q
  1. . I $P(LRREF,",",5)=0 S LRREC(LRREC)="Virology Report Remark" Q
  1. . S LRREC(LRREC)="Virology Report Remark #"_$$CMTSEQ(LRREF)
  1. ;
  1. I $P(LRREF,",",4)>18,$P(LRREF,",",4)<31 D Q
  1. . N LRI,LRX
  1. . S LRI=$P(LRREF,",",4)
  1. . I LRI>18,LRI<24 S LRX="Preliminary "_$S(LRI=19:"BACT",LRI=20:"VIROLOGY",LRI=21:"PARASITOLOGY",LRI=22:"MYCOLOGY",1:"TB")_" Comment"
  1. . I LRI>23,LRI<26 S LRX=$S(LRI=24:"PARASITOLOGY",1:"BACTERIOLOGY")_" SMEAR/PREP"
  1. . I LRI>25,LRI<31 S LRX=$S(LRI=26:"BACTERIOLOGY",LRI=27:"PARASITOLOGY",LRI=28:"MYCOLOGY",LRI=29:"TB",1:"VIROLOGY")_" TESTS"
  1. . I $P(LRREF,",",5)=0 S LRREC(LRREC)=LRX Q
  1. . S LRREC(LRREC)=LRX_" #"_$$CMTSEQ(LRREF)
  1. ;
  1. ; Sterility Results
  1. I $P(LRREF,",",4)=31 S LRREC(LRREC)="Sterility Results" Q
  1. ;
  1. ; Comment on specimen
  1. I $P(LRREF,",",4)=99 S LRREC(LRREC)="Comment On Specimen" Q
  1. ;
  1. Q
  1. ;
  1. ;
  1. APCHK ; Check and resolve SP, CY and EM subscript
  1. ;
  1. N LRSS
  1. S LRSS=$P(LRREF,",",2)
  1. ;
  1. ; Type of report
  1. I $P(LRREF,",",4)=0 S LRREC(LRREC)=$S(LRSS="SP":"Surgical Pathology",LRSS="CY":"Cytology",LRSS="EM":"Electron Microscopy",1:"")_" Report" Q
  1. ;
  1. ; Frozen section
  1. I LRSS="SP",$P(LRREF,",",4)=1.3 S LRREC(LRREC)="Frozen Section" Q
  1. ;
  1. ; Info accompanying request
  1. I $P(LRREF,",",4)=.2 S LRREC(LRREC)="Brief Clinical History" Q
  1. I $P(LRREF,",",4)=.3 S LRREC(LRREC)="Preoperative Diagnosis" Q
  1. I $P(LRREF,",",4)=.4 S LRREC(LRREC)="Operative Findings" Q
  1. I $P(LRREF,",",4)=.5 S LRREC(LRREC)="Post-Operative Diagnosis" Q
  1. ;
  1. ; Descriptions
  1. I $P(LRREF,",",4)=1 S LRREC(LRREC)="Gross Description" Q
  1. I $P(LRREF,",",4)=1.1 S LRREC(LRREC)="Microscopic Description" Q
  1. ;
  1. ; Surgical Path Diagnois
  1. I $P(LRREF,",",4)=1.4 S LRREC(LRREC)="Surgical Path Diagnosis" Q
  1. ;
  1. ; Supplementary Reports
  1. I $P(LRREF,",",4)=1.2 D Q
  1. . N LRI,LRX
  1. . I $P(LRREF,",",5)=0 S LRREC(LRREC)="Supplementary Report" Q
  1. . S LRI=$G(^LR($P(LRREF,","),$P(LRREF,",",2),$P(LRREF,",",3),$P(LRREF,",",4),$P(LRREF,",",5),0))
  1. . S LRX=$$FMTE^XLFDT(+LRI,"1MZ")
  1. . S LRREC(LRREC)="Supplementary Report for "_LRX
  1. ;
  1. ; Special Studies
  1. I $P(LRREF,",",4)=2 D Q
  1. . N LRI,LRX,LRSST
  1. . I $P(LRREF,",",5)=0 S LRREC(LRREC)="Special Studies" Q
  1. . S LRI=$G(^LR($P(LRREF,","),$P(LRREF,",",2),$P(LRREF,",",3),$P(LRREF,",",4),$P(LRREF,",",5),0))
  1. . S LRX=$P(^LAB(61,+LRI,0),"^")
  1. . I $P(LRREF,",",7) D Q
  1. . . S LRI=$G(^LR($P(LRREF,","),$P(LRREF,",",2),$P(LRREF,",",3),$P(LRREF,",",4),$P(LRREF,",",5),5,$P(LRREF,",",7),0))
  1. . . S LRSST=$$EXTERNAL^DILFD(63.819,.01,"",$P(LRI,"^"),"")
  1. . . S LRREC(LRREC)="Special Studies on "_LRX_" "_LRSST
  1. . S LRREC(LRREC)="Special Studies on "_LRX
  1. ;
  1. ; Delayed report comment
  1. I $P(LRREF,",",4)=97 D Q
  1. . I $P(LRREF,",",5)>0 S LRREC(LRREC)="Delayed Report Comment #"_$$CMTSEQ(LRREF) Q
  1. . S LRREC(LRREC)="Delayed Report Comment"
  1. ;
  1. I $P(LRREF,",",4)=99 D Q
  1. . I $P(LRREF,",",5)>0 S LRREC(LRREC)="Comment #"_$$CMTSEQ(LRREF) Q
  1. . S LRREC(LRREC)="Comment"
  1. Q
  1. ;
  1. ;
  1. AUCHK ; Check and resolve AU subscript
  1. ;
  1. ; Type of report
  1. I $P(LRREF,",",4)="AU",$P(LRREF,",",5)=0 S LRREC(LRREC)="Autospy" Q
  1. ;
  1. I $P(LRREF,",",4)="AZC" D
  1. . I $P(LRREF,",",5)>0 S LRREC(LRREC)="Autopsy Comment #"_$$CMTSEQ(LRREF) Q
  1. . S LRREC(LRREC)="Autopsy Comment"
  1. ;
  1. ; Descriptions
  1. I $P(LRREF,",",4)=81 S LRREC(LRREC)="Clinical Diagnoses" Q
  1. I $P(LRREF,",",4)=82 S LRREC(LRREC)="Pathological Diagnoses" Q
  1. ;
  1. ; Special Studies
  1. I $P(LRREF,",",4)="AY" D Q
  1. . N LRI,LRX,LRSST
  1. . I $P(LRREF,",",5)=0 S LRREC(LRREC)="Special Studies" Q
  1. . S LRI=$G(^LR($P(LRREF,","),$P(LRREF,",",4),$P(LRREF,",",5),0))
  1. . S LRX=$P(^LAB(61,+LRI,0),"^")
  1. . I $P(LRREF,",",5) D Q
  1. . . S LRI=$G(^LR($P(LRREF,","),$P(LRREF,",",4),$P(LRREF,",",5),$P(LRREF,",",6),$P(LRREF,",",7),0))
  1. . . S LRSST=$$EXTERNAL^DILFD(63.26,.01,"",$P(LRI,"^"),"")
  1. . . S LRREC(LRREC)="Special Studies on "_LRX_" "_LRSST
  1. . S LRREC(LRREC)="Special Studies on "_LRX
  1. ;
  1. ; Supplementary Reports
  1. I $P(LRREF,",",4)=84 D Q
  1. . N LRI,LRX
  1. . I $P(LRREF,",",5)=0 S LRREC(LRREC)="Supplementary Report" Q
  1. . S LRI=$G(^LR($P(LRREF,","),84,$P(LRREF,",",3),0))
  1. . S LRX=$$FMTE^XLFDT(+LRI,"1MZ")
  1. . S LRREC(LRREC)="Supplementary Report for "_LRX
  1. ;
  1. Q
  1. ;
  1. ;
  1. GETORG(LRREF) ; Retrieve name of organism from file #61.2
  1. ; Call with LRREF = reference to entry in file #63
  1. ;
  1. N LRI,LRX
  1. S LRI=$G(^LR($P(LRREF,","),$P(LRREF,",",2),$P(LRREF,",",3),$P(LRREF,",",4),$P(LRREF,",",5),0))
  1. S LRX=$$TITLE^XLFSTR($P($G(^LAB(61.2,+LRI,0)),"^"))
  1. ;
  1. Q LRX
  1. ;
  1. ;
  1. 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)
  1. ; LRJ = drug node
  1. ;
  1. ; Returns LRDN = name of drug
  1. ;
  1. N LRDN
  1. S LRDN=$O(^LAB(62.06,$S(LRSECT=3:"AD",1:"AD1"),LRJ,0))
  1. I LRDN S LRDN=$$TITLE^XLFSTR($P($G(^LAB(62.06,LRDN,0)),"^"))
  1. ;
  1. Q LRDN
  1. ;
  1. ;
  1. 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
  1. ;
  1. ; Returns LRDN = name of drug
  1. ;
  1. N LRDN,LRI
  1. 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)))
  1. 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)))
  1. S LRDN=$P(LRI,"^")
  1. ;
  1. Q LRDN
  1. ;
  1. ;
  1. CMTSEQ(LRREF) ; Determine the sequence # for a comment line
  1. ; Deal with intervening comments being deleted during edits resulting in the comment IEN being
  1. ; different than the display sequence #.
  1. ;
  1. ; Call with LRREF = id reference of specific comment
  1. ;
  1. ; Returns LRY = display sequence #
  1. ;
  1. N LRDFN,LRI,LRIDT,LRSECT,LRSS,LRX,LRY
  1. S (LRY,LRI)=0
  1. S LRDFN=$P(LRREF,",")
  1. 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)
  1. E S LRSS="AU",LRSECT=$P(LRREF,",",2)
  1. ;
  1. I LRSS="MI" D MISEQ
  1. ;
  1. ; Check AP comments
  1. I LRSS?1(1"SP",1"CY",1"EM"),(LRSECT=97!(LRSECT=99)) D
  1. . F S LRI=$O(^LR(LRDFN,LRSS,LRIDT,LRSECT,LRI)) Q:'LRI S LRY=LRY+1 I LRI=$P(LRREF,"^",5) Q
  1. ;
  1. I LRSS="AU" D
  1. . F S LRI=$O(^LR(LRDFN,LRSECT,LRI)) Q:'LRI S LRY=LRY+1 I LRI=$P(LRREF,"^",4) Q
  1. ;
  1. Q LRY
  1. ;
  1. ;
  1. MISEQ ; Check for comment seq on MI subscript
  1. ;
  1. ; Sections 2,4,7,10,13,14,15,18-30
  1. S LRX="^1^^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
  1. . F S LRI=$O(^LR(LRDFN,LRSS,LRIDT,LRSECT,LRI)) Q:'LRI S LRY=LRY+1 I LRI=$P(LRREF,",",5) Q
  1. ;
  1. ; Sections 3,9,12
  1. S LRX="^^1^^^^^^1^^^1^"
  1. I $P(LRX,"^",LRSECT) D Q
  1. . 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
  1. ;
  1. ; Section 6 - Parasite Stage Comment (multiple 3 levels down)
  1. I LRSECT=6 D Q
  1. . 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
  1. ;
  1. Q