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

LR7OSAP.m

Go to the documentation of this file.
  1. LR7OSAP ;DALOI/STAFF - Silent AP rpt (compare to LRAPCUM) ;03/21/13 15:30
  1. ;;5.2;LAB SERVICE;**121,187,230,256,259,317,350,427**;Sep 27, 1994;Build 33
  1. ;
  1. GET I '$D(^LR(LRDFN,LRSS)) Q
  1. N FST,X
  1. S (A,FST)=0,LRI=LRIN
  1. F S LRI=$O(^LR(LRDFN,LRSS,LRI)) Q:'LRI!(CT1>COUNT)!(LRI>LROUT) S B=$G(^(LRI,0)),CT1=CT1+1 I B D
  1. . D W
  1. . S X="",$P(X,"=",GIOM)=""
  1. . D LN
  1. . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,X)
  1. . D LINE^LR7OSUM4
  1. ;
  1. I 'FST D
  1. . I LRSS="SP",'$D(SUBHEAD("SURGICAL PATHOLOGY")) Q
  1. . I LRSS="CY",'$D(SUBHEAD("CYTOPATHOLOGY")) Q
  1. . I LRSS="EM",'$D(SUBHEAD("EM")) Q
  1. . D LINE^LR7OSUM4,LN
  1. . S X=GIOM/2-($L(LRAA(1))/2+5)
  1. . S ^TMP("LRH",$J,LRAA(1))=GCNT
  1. . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(X,CCNT,"---- "_LRAA(1)_" ----")
  1. . D LN
  1. . S ^TMP("LRC",$J,GCNT,0)="No "_$S(LRSS="SP":"Surgical Pathology",LRSS="CY":"Cytology",LRSS="EM":"EM",1:"")_" reports available for date range ..."
  1. Q
  1. ;
  1. ;
  1. F(PIECE) ;
  1. ;If PIECE=1, then only get 1st piece; otherwise get whole node
  1. I '$G(PIECE) D WRAP^LR7OSAP1("^LR("_LRDFN_","""_LRSS_""","_LRI_","_LRV_")",79) Q
  1. S C=0
  1. F S C=$O(^LR(LRDFN,LRSS,LRI,LRV,C)) Q:'C S X=$P(^(C,0),"^") D LN S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,X)
  1. Q
  1. ;
  1. ;
  1. W ; Called from above and LR7OSAP4
  1. N LR,LRPTR,LRMD,LRTEXT,LRV,LRW,LRX
  1. I 'FST D
  1. . D LINE^LR7OSUM4,LN
  1. . S X=GIOM/2-($L(LRAA(1))/2+5)
  1. . S ^TMP("LRH",$J,LRAA(1))=GCNT
  1. . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(X,CCNT,"---- "_LRAA(1)_" ----")
  1. I FST D LN S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Next "_LRAA(1)_" Specimen...")
  1. S FST=1
  1. ;
  1. ; Check for TIU document report and use instead and quit
  1. D TIUCHK^LRAPUTL(.LRPTR,LRDFN,LRSS,LRI)
  1. I +$G(LRPTR) D Q
  1. . N LRCKSUM,LRCNT,LRCNTT,LRENCRYP,LRFLG,LRHFLG,LROR,LRQUIT,LRTXT
  1. . D MAIN^LR7OSAP3(LRPTR)
  1. ;
  1. ; Display reporting lab
  1. I $$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")#2 D
  1. . S LRX=+$G(^LR(LRDFN,LRSS,LRI,"RF"))
  1. . I LRX D RL^LR7OSMZU(LRX)
  1. ;
  1. S Y=+B
  1. D D^LRU
  1. S LRW(1)=Y,Y=$P(B,"^",10)
  1. D D^LRU
  1. S LRW(10)=Y,Y=$P(B,"^",3)
  1. D D^LRU
  1. S LRW(3)=Y,X=$P(B,"^",2)
  1. D:X D^LRUA
  1. S LRW(2)=X,LRW(11)=$P(B,"^",11),X=$P(B,"^",4)
  1. D:X D^LRUA
  1. S LRW(4)=X,X=$P(B,"^",7)
  1. D:X D^LRUA
  1. S LRW(7)=X
  1. D LN
  1. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Date Spec taken: "_LRW(1)),^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(38,CCNT,"Pathologist:"_LRW(2))
  1. D LN
  1. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Date Spec rec'd: "_LRW(10)),^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(38,CCNT,$S(LRSS="SP":"Resident: ",1:"Tech: ")_LRW(4))
  1. D LN
  1. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,$S($L(LRW(3)):"Date completed: ",1:"REPORT INCOMPLETE")_LRW(3)),^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(38,CCNT,"Accession #: "_$P(B,"^",6))
  1. D LN
  1. S $P(LR("%"),"-",GIOM)=""
  1. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Submitted by: "_$P(B,"^",5)),^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(38,CCNT,"Practitioner:"_LRW(7))
  1. D LN
  1. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,LR("%"))
  1. ;
  1. I $D(^LR(LRDFN,LRSS,LRI,.1)) D
  1. . D LN
  1. . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Specimen: ")
  1. . S LRV=.1
  1. . D F(1)
  1. ;
  1. ; Don't show anymore data if not verified.
  1. I LRW(11)="" D Q
  1. . D A,LN
  1. . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Report not verified")
  1. ;
  1. I $P($G(^LR(LRDFN,LRSS,LRI,1.2,0)),"^",4) D
  1. . D LN
  1. . S LRTEXT="SUPPLEMENTARY REPORT HAS BEEN ADDED"
  1. . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(14,CCNT,"*+* "_LRTEXT_" *+*")
  1. . D LN
  1. . S LRTEXT="REFER TO BOTTOM OF REPORT"
  1. . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(19,CCNT,"*+* "_LRTEXT_" *+*")
  1. . D LN
  1. ;
  1. I $D(^LR(LRDFN,LRSS,LRI,.2)) D
  1. . D LN
  1. . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Brief Clinical History:")
  1. . S LRV=.2 D F()
  1. ;
  1. I $D(^LR(LRDFN,LRSS,LRI,.3)) D
  1. . D LN
  1. . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Preoperative Diagnosis:")
  1. . S LRV=.3 D F()
  1. ;
  1. I $D(^LR(LRDFN,LRSS,LRI,.4)) D
  1. . D LN
  1. . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Operative Findings:")
  1. . S LRV=.4 D F()
  1. ;
  1. I $D(^LR(LRDFN,LRSS,LRI,.5)) D
  1. . D LN
  1. . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Postoperative Diagnosis:")
  1. . S LRV=.5 D F()
  1. ;
  1. D SET^LRUA
  1. ;
  1. I $O(^LR(LRDFN,LRSS,LRI,1.3,0)) D LN S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,LR(69.2,.13)) I $P($G(^LR(LRDFN,LRSS,LRI,6,0)),U,4) S LR(0)=6 D MOD^LR7OSAP1
  1. S LRV=1.3
  1. D F()
  1. ;
  1. I $O(^LR(LRDFN,LRSS,LRI,1,0)) D LN S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,LR(69.2,.03)) I $P($G(^LR(LRDFN,LRSS,LRI,7,0)),U,4) S LR(0)=7 D MOD^LR7OSAP1
  1. S LRV=1
  1. D F()
  1. ;
  1. I $O(^LR(LRDFN,LRSS,LRI,1.1,0)) D LN S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,LR(69.2,.04)_" (Date Spec taken: "_LRW(1)_")") I $P($G(^LR(LRDFN,LRSS,LRI,4,0)),U,4) S LR(0)=4 D MOD^LR7OSAP1
  1. S LRV=1.1
  1. D F()
  1. ;
  1. I $O(^LR(LRDFN,LRSS,LRI,1.4,0)) D LN S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,LR(69.2,.14)) I $P($G(^LR(LRDFN,LRSS,LRI,5,0)),U,4) S LR(0)=5 D MOD^LR7OSAP1
  1. S LRV=1.4
  1. D F()
  1. ;
  1. I $O(^LR(LRDFN,LRSS,LRI,1.2,0)) D
  1. . D LN
  1. . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Supplementary Report:")
  1. . S C=0 F S C=$O(^LR(LRDFN,LRSS,LRI,1.2,C)) Q:'C D
  1. .. S X=^LR(LRDFN,LRSS,LRI,1.2,C,0),Y=+X,X=$P(X,U,2)
  1. .. ;Don't even print supp date if supp is not released
  1. .. Q:'X
  1. .. D D^LRU,LN
  1. .. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(3,CCNT,"Date: "_Y)
  1. .. I 'X S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(1,CCNT," not verified")
  1. .. I $O(^LR(LRDFN,LRSS,LRI,1.2,C,2,0)) D MODSR^LR7OSAP1
  1. .. D:X U
  1. I $D(^LR(LRDFN,LRSS,LRI,2)) D B
  1. ;
  1. ; DALOI/LMT - LR,427 - Removed comments from report to restore pre-LR,350 behavior
  1. ;I $D(^LR(LRDFN,LRSS,LRI,99)) D LN S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Comments:") S LRV=99 D F(1)
  1. ;
  1. ; List performing labs
  1. D PPL^LR7OSMZ1(LRDFN,LRSS,LRI)
  1. ;
  1. Q
  1. ;
  1. ;
  1. U ;
  1. D WRAP^LR7OSAP1("^LR("_LRDFN_","""_LRSS_""","_LRI_",1.2,"_C_",1)",79)
  1. Q
  1. ;
  1. ;
  1. B ;
  1. S C=0
  1. F S C=$O(^LR(LRDFN,LRSS,LRI,2,C)) Q:'C D SP
  1. Q
  1. ;
  1. ;
  1. SP ;
  1. S G=0
  1. F S G=$O(^LR(LRDFN,LRSS,LRI,2,C,5,G)) Q:'G S X=^(G,0),Y=$P(X,"^",2),E=$P(X,"^",3),E(1)=$P(X,"^")_":",E(1)=$P($P($G(LR(LRSS)),E(1),2),";") D D^LRU S T(2)=Y D WP
  1. Q
  1. ;
  1. ;
  1. WP ;
  1. D LN
  1. S X=E(1)_" "_E_" Date: "_T(2)_" ",^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,X)
  1. D WRAP^LR7OSAP1("^LR("_LRDFN_","""_LRSS_""","_LRI_",2,"_C_",5,"_G_",1)",79)
  1. Q
  1. ;
  1. ;
  1. A ;
  1. D WRAP^LR7OSAP1("^LR("_LRDFN_","""_LRSS_""","_LRI_",97)",79)
  1. Q
  1. ;
  1. ;
  1. LN ;Increment the counter
  1. S GCNT=GCNT+1,CCNT=1
  1. Q
  1. ;
  1. ;
  1. EN ; Get AP results
  1. ; Called by LR7OSUM
  1. ;
  1. N GIOM
  1. S GIOM=$G(LRGIOM)
  1. I GIOM="" D
  1. . S GIOM=$$GET^XPAR("USR^DIV^PKG","LR AP GUI REPORT RIGHT MARGIN",1,"Q")
  1. . I GIOM="" S GIOM=80
  1. ;
  1. ; Display "Printed at:" notice
  1. I '$O(^TMP("LRC",$J,0)),$$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")>1 D PFAC^LR7OSMZU
  1. ;
  1. I $S('$D(SUBHEAD):1,1:$D(SUBHEAD("SURGICAL PATHOLOGY"))) D SPA
  1. I $S('$D(SUBHEAD):1,1:$D(SUBHEAD("CYTOPATHOLOGY"))) D CY
  1. I $S('$D(SUBHEAD):1,1:$D(SUBHEAD("EM"))) D EM
  1. I $S('$D(SUBHEAD):1,1:$D(SUBHEAD("AUTOPSY"))) D AU
  1. Q
  1. ;
  1. ;
  1. CY ; Cytology results
  1. ;
  1. I '$D(^LR(LRDFN,"CY")) D Q
  1. . I '$D(SUBHEAD("CYTOPATHOLOGY")) Q
  1. . D LINE^LR7OSUM4
  1. . D LN S ^TMP("LRC",$J,GCNT,0)="No Cytology reports available..."
  1. ;
  1. S LRSS="CY",LRAA(1)="CYTOPATHOLOGY",LRAA=+$O(^LRO(68,"B",LRAA(1),0)) S:'LRAA LRAA=$$FIND(LRSS)
  1. D GET
  1. Q
  1. ;
  1. ;
  1. SPA ; Surgical Pathology results
  1. ;
  1. I '$D(^LR(LRDFN,"SP")) D Q
  1. . I '$D(SUBHEAD("SURGICAL PATHOLOGY")) Q
  1. . D LINE^LR7OSUM4
  1. . D LN S ^TMP("LRC",$J,GCNT,0)="No Surgical Pathology reports available..."
  1. ;
  1. S LRSS="SP",LRAA(1)="SURGICAL PATHOLOGY",LRAA=+$O(^LRO(68,"B",LRAA(1),0)) S:'LRAA LRAA=$$FIND(LRSS)
  1. D GET
  1. Q
  1. ;
  1. ;
  1. EM ; Electron Microscopy results
  1. ;
  1. I '$D(^LR(LRDFN,"EM")) D Q
  1. . I '$D(SUBHEAD("EM")) Q
  1. . D LINE^LR7OSUM4
  1. . D LN S ^TMP("LRC",$J,GCNT,0)="No EM reports available..."
  1. ;
  1. S LRSS="EM",LRAA(1)="ELECTRON MICROSCOPY",LRAA=+$O(^LRO(68,"B","EM",0)) S:'LRAA LRAA=$$FIND(LRSS)
  1. D GET
  1. Q
  1. ;
  1. ;
  1. AU ; Autopsy results
  1. ;
  1. I '$D(^LR(LRDFN,"AU")) D Q
  1. . I '$D(SUBHEAD("AUTOPSY")) Q
  1. . D LINE^LR7OSUM4
  1. . D LN S ^TMP("LRC",$J,GCNT,0)="No Autopsy report available..."
  1. ;
  1. D EN^LR7OSAP2(LRDFN)
  1. Q
  1. ;
  1. ;
  1. FIND(SS) ; Find a valid entry in 68
  1. ;SS=LRSS value to look for
  1. N I,Y
  1. S I=0,Y="" F S I=$O(^LRO(68,I)) Q:I<1 I $P($G(^LRO(68,I,0)),"^",2)=SS S Y=I Q
  1. Q Y