LR7OSAP ;DALOI/STAFF - Silent AP rpt (compare to LRAPCUM) ;03/21/13 15:30
;;5.2;LAB SERVICE;**121,187,230,256,259,317,350,427**;Sep 27, 1994;Build 33
;
GET I '$D(^LR(LRDFN,LRSS)) Q
N FST,X
S (A,FST)=0,LRI=LRIN
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
. D W
. S X="",$P(X,"=",GIOM)=""
. D LN
. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,X)
. D LINE^LR7OSUM4
;
I 'FST D
. I LRSS="SP",'$D(SUBHEAD("SURGICAL PATHOLOGY")) Q
. I LRSS="CY",'$D(SUBHEAD("CYTOPATHOLOGY")) Q
. I LRSS="EM",'$D(SUBHEAD("EM")) Q
. D LINE^LR7OSUM4,LN
. S X=GIOM/2-($L(LRAA(1))/2+5)
. S ^TMP("LRH",$J,LRAA(1))=GCNT
. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(X,CCNT,"---- "_LRAA(1)_" ----")
. D LN
. S ^TMP("LRC",$J,GCNT,0)="No "_$S(LRSS="SP":"Surgical Pathology",LRSS="CY":"Cytology",LRSS="EM":"EM",1:"")_" reports available for date range ..."
Q
;
;
F(PIECE) ;
;If PIECE=1, then only get 1st piece; otherwise get whole node
I '$G(PIECE) D WRAP^LR7OSAP1("^LR("_LRDFN_","""_LRSS_""","_LRI_","_LRV_")",79) Q
S C=0
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)
Q
;
;
W ; Called from above and LR7OSAP4
N LR,LRPTR,LRMD,LRTEXT,LRV,LRW,LRX
I 'FST D
. D LINE^LR7OSUM4,LN
. S X=GIOM/2-($L(LRAA(1))/2+5)
. S ^TMP("LRH",$J,LRAA(1))=GCNT
. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(X,CCNT,"---- "_LRAA(1)_" ----")
I FST D LN S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Next "_LRAA(1)_" Specimen...")
S FST=1
;
; Check for TIU document report and use instead and quit
D TIUCHK^LRAPUTL(.LRPTR,LRDFN,LRSS,LRI)
I +$G(LRPTR) D Q
. N LRCKSUM,LRCNT,LRCNTT,LRENCRYP,LRFLG,LRHFLG,LROR,LRQUIT,LRTXT
. D MAIN^LR7OSAP3(LRPTR)
;
; Display reporting lab
I $$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")#2 D
. S LRX=+$G(^LR(LRDFN,LRSS,LRI,"RF"))
. I LRX D RL^LR7OSMZU(LRX)
;
S Y=+B
D D^LRU
S LRW(1)=Y,Y=$P(B,"^",10)
D D^LRU
S LRW(10)=Y,Y=$P(B,"^",3)
D D^LRU
S LRW(3)=Y,X=$P(B,"^",2)
D:X D^LRUA
S LRW(2)=X,LRW(11)=$P(B,"^",11),X=$P(B,"^",4)
D:X D^LRUA
S LRW(4)=X,X=$P(B,"^",7)
D:X D^LRUA
S LRW(7)=X
D LN
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))
D LN
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))
D LN
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))
D LN
S $P(LR("%"),"-",GIOM)=""
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))
D LN
S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,LR("%"))
;
I $D(^LR(LRDFN,LRSS,LRI,.1)) D
. D LN
. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Specimen: ")
. S LRV=.1
. D F(1)
;
; Don't show anymore data if not verified.
I LRW(11)="" D Q
. D A,LN
. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Report not verified")
;
I $P($G(^LR(LRDFN,LRSS,LRI,1.2,0)),"^",4) D
. D LN
. S LRTEXT="SUPPLEMENTARY REPORT HAS BEEN ADDED"
. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(14,CCNT,"*+* "_LRTEXT_" *+*")
. D LN
. S LRTEXT="REFER TO BOTTOM OF REPORT"
. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(19,CCNT,"*+* "_LRTEXT_" *+*")
. D LN
;
I $D(^LR(LRDFN,LRSS,LRI,.2)) D
. D LN
. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Brief Clinical History:")
. S LRV=.2 D F()
;
I $D(^LR(LRDFN,LRSS,LRI,.3)) D
. D LN
. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Preoperative Diagnosis:")
. S LRV=.3 D F()
;
I $D(^LR(LRDFN,LRSS,LRI,.4)) D
. D LN
. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Operative Findings:")
. S LRV=.4 D F()
;
I $D(^LR(LRDFN,LRSS,LRI,.5)) D
. D LN
. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Postoperative Diagnosis:")
. S LRV=.5 D F()
;
D SET^LRUA
;
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
S LRV=1.3
D F()
;
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
S LRV=1
D F()
;
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
S LRV=1.1
D F()
;
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
S LRV=1.4
D F()
;
I $O(^LR(LRDFN,LRSS,LRI,1.2,0)) D
. D LN
. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Supplementary Report:")
. S C=0 F S C=$O(^LR(LRDFN,LRSS,LRI,1.2,C)) Q:'C D
.. S X=^LR(LRDFN,LRSS,LRI,1.2,C,0),Y=+X,X=$P(X,U,2)
.. ;Don't even print supp date if supp is not released
.. Q:'X
.. D D^LRU,LN
.. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(3,CCNT,"Date: "_Y)
.. I 'X S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(1,CCNT," not verified")
.. I $O(^LR(LRDFN,LRSS,LRI,1.2,C,2,0)) D MODSR^LR7OSAP1
.. D:X U
I $D(^LR(LRDFN,LRSS,LRI,2)) D B
;
; DALOI/LMT - LR,427 - Removed comments from report to restore pre-LR,350 behavior
;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)
;
; List performing labs
D PPL^LR7OSMZ1(LRDFN,LRSS,LRI)
;
Q
;
;
U ;
D WRAP^LR7OSAP1("^LR("_LRDFN_","""_LRSS_""","_LRI_",1.2,"_C_",1)",79)
Q
;
;
B ;
S C=0
F S C=$O(^LR(LRDFN,LRSS,LRI,2,C)) Q:'C D SP
Q
;
;
SP ;
S G=0
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
Q
;
;
WP ;
D LN
S X=E(1)_" "_E_" Date: "_T(2)_" ",^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,X)
D WRAP^LR7OSAP1("^LR("_LRDFN_","""_LRSS_""","_LRI_",2,"_C_",5,"_G_",1)",79)
Q
;
;
A ;
D WRAP^LR7OSAP1("^LR("_LRDFN_","""_LRSS_""","_LRI_",97)",79)
Q
;
;
LN ;Increment the counter
S GCNT=GCNT+1,CCNT=1
Q
;
;
EN ; Get AP results
; Called by LR7OSUM
;
N GIOM
S GIOM=$G(LRGIOM)
I GIOM="" D
. S GIOM=$$GET^XPAR("USR^DIV^PKG","LR AP GUI REPORT RIGHT MARGIN",1,"Q")
. I GIOM="" S GIOM=80
;
; Display "Printed at:" notice
I '$O(^TMP("LRC",$J,0)),$$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")>1 D PFAC^LR7OSMZU
;
I $S('$D(SUBHEAD):1,1:$D(SUBHEAD("SURGICAL PATHOLOGY"))) D SPA
I $S('$D(SUBHEAD):1,1:$D(SUBHEAD("CYTOPATHOLOGY"))) D CY
I $S('$D(SUBHEAD):1,1:$D(SUBHEAD("EM"))) D EM
I $S('$D(SUBHEAD):1,1:$D(SUBHEAD("AUTOPSY"))) D AU
Q
;
;
CY ; Cytology results
;
I '$D(^LR(LRDFN,"CY")) D Q
. I '$D(SUBHEAD("CYTOPATHOLOGY")) Q
. D LINE^LR7OSUM4
. D LN S ^TMP("LRC",$J,GCNT,0)="No Cytology reports available..."
;
S LRSS="CY",LRAA(1)="CYTOPATHOLOGY",LRAA=+$O(^LRO(68,"B",LRAA(1),0)) S:'LRAA LRAA=$$FIND(LRSS)
D GET
Q
;
;
SPA ; Surgical Pathology results
;
I '$D(^LR(LRDFN,"SP")) D Q
. I '$D(SUBHEAD("SURGICAL PATHOLOGY")) Q
. D LINE^LR7OSUM4
. D LN S ^TMP("LRC",$J,GCNT,0)="No Surgical Pathology reports available..."
;
S LRSS="SP",LRAA(1)="SURGICAL PATHOLOGY",LRAA=+$O(^LRO(68,"B",LRAA(1),0)) S:'LRAA LRAA=$$FIND(LRSS)
D GET
Q
;
;
EM ; Electron Microscopy results
;
I '$D(^LR(LRDFN,"EM")) D Q
. I '$D(SUBHEAD("EM")) Q
. D LINE^LR7OSUM4
. D LN S ^TMP("LRC",$J,GCNT,0)="No EM reports available..."
;
S LRSS="EM",LRAA(1)="ELECTRON MICROSCOPY",LRAA=+$O(^LRO(68,"B","EM",0)) S:'LRAA LRAA=$$FIND(LRSS)
D GET
Q
;
;
AU ; Autopsy results
;
I '$D(^LR(LRDFN,"AU")) D Q
. I '$D(SUBHEAD("AUTOPSY")) Q
. D LINE^LR7OSUM4
. D LN S ^TMP("LRC",$J,GCNT,0)="No Autopsy report available..."
;
D EN^LR7OSAP2(LRDFN)
Q
;
;
FIND(SS) ; Find a valid entry in 68
;SS=LRSS value to look for
N I,Y
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
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR7OSAP 8201 printed Apr 09, 2024@21:21:01 Page 2
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
+2 ;
GET IF '$DATA(^LR(LRDFN,LRSS))
QUIT
+1 NEW FST,X
+2 SET (A,FST)=0
SET LRI=LRIN
+3 FOR
SET LRI=$ORDER(^LR(LRDFN,LRSS,LRI))
if 'LRI!(CT1>COUNT)!(LRI>LROUT)
QUIT
SET B=$GET(^(LRI,0))
SET CT1=CT1+1
IF B
Begin DoDot:1
+4 DO W
+5 SET X=""
SET $PIECE(X,"=",GIOM)=""
+6 DO LN
+7 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,X)
+8 DO LINE^LR7OSUM4
End DoDot:1
+9 ;
+10 IF 'FST
Begin DoDot:1
+11 IF LRSS="SP"
IF '$DATA(SUBHEAD("SURGICAL PATHOLOGY"))
QUIT
+12 IF LRSS="CY"
IF '$DATA(SUBHEAD("CYTOPATHOLOGY"))
QUIT
+13 IF LRSS="EM"
IF '$DATA(SUBHEAD("EM"))
QUIT
+14 DO LINE^LR7OSUM4
DO LN
+15 SET X=GIOM/2-($LENGTH(LRAA(1))/2+5)
+16 SET ^TMP("LRH",$JOB,LRAA(1))=GCNT
+17 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(X,CCNT,"---- "_LRAA(1)_" ----")
+18 DO LN
+19 SET ^TMP("LRC",$JOB,GCNT,0)="No "_$SELECT(LRSS="SP":"Surgical Pathology",LRSS="CY":"Cytology",LRSS="EM":"EM",1:"")_" reports available for date range ..."
End DoDot:1
+20 QUIT
+21 ;
+22 ;
F(PIECE) ;
+1 ;If PIECE=1, then only get 1st piece; otherwise get whole node
+2 IF '$GET(PIECE)
DO WRAP^LR7OSAP1("^LR("_LRDFN_","""_LRSS_""","_LRI_","_LRV_")",79)
QUIT
+3 SET C=0
+4 FOR
SET C=$ORDER(^LR(LRDFN,LRSS,LRI,LRV,C))
if 'C
QUIT
SET X=$PIECE(^(C,0),"^")
DO LN
SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,X)
+5 QUIT
+6 ;
+7 ;
W ; Called from above and LR7OSAP4
+1 NEW LR,LRPTR,LRMD,LRTEXT,LRV,LRW,LRX
+2 IF 'FST
Begin DoDot:1
+3 DO LINE^LR7OSUM4
DO LN
+4 SET X=GIOM/2-($LENGTH(LRAA(1))/2+5)
+5 SET ^TMP("LRH",$JOB,LRAA(1))=GCNT
+6 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(X,CCNT,"---- "_LRAA(1)_" ----")
End DoDot:1
+7 IF FST
DO LN
SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,"Next "_LRAA(1)_" Specimen...")
+8 SET FST=1
+9 ;
+10 ; Check for TIU document report and use instead and quit
+11 DO TIUCHK^LRAPUTL(.LRPTR,LRDFN,LRSS,LRI)
+12 IF +$GET(LRPTR)
Begin DoDot:1
+13 NEW LRCKSUM,LRCNT,LRCNTT,LRENCRYP,LRFLG,LRHFLG,LROR,LRQUIT,LRTXT
+14 DO MAIN^LR7OSAP3(LRPTR)
End DoDot:1
QUIT
+15 ;
+16 ; Display reporting lab
+17 IF $$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")#2
Begin DoDot:1
+18 SET LRX=+$GET(^LR(LRDFN,LRSS,LRI,"RF"))
+19 IF LRX
DO RL^LR7OSMZU(LRX)
End DoDot:1
+20 ;
+21 SET Y=+B
+22 DO D^LRU
+23 SET LRW(1)=Y
SET Y=$PIECE(B,"^",10)
+24 DO D^LRU
+25 SET LRW(10)=Y
SET Y=$PIECE(B,"^",3)
+26 DO D^LRU
+27 SET LRW(3)=Y
SET X=$PIECE(B,"^",2)
+28 if X
DO D^LRUA
+29 SET LRW(2)=X
SET LRW(11)=$PIECE(B,"^",11)
SET X=$PIECE(B,"^",4)
+30 if X
DO D^LRUA
+31 SET LRW(4)=X
SET X=$PIECE(B,"^",7)
+32 if X
DO D^LRUA
+33 SET LRW(7)=X
+34 DO LN
+35 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,"Date Spec taken: "_LRW(1))
SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(38,CCNT,"Pathologist:"_LRW(2))
+36 DO LN
+37 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,"Date Spec rec'd: "_LRW(10))
SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(38,CCNT,$SELECT(LRSS="SP":"Resident: ",1:"Tech: ")_LRW(4))
+38 DO LN
+39 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,$SELECT($LENGTH(LRW(3)):"Date completed: ",1:"REPORT INCOMPLETE")_LRW(3))
SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(38,CCNT,"Accession #: "_$PIECE(B,"^",6))
+40 DO LN
+41 SET $PIECE(LR("%"),"-",GIOM)=""
+42 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,"Submitted by: "_$PIECE(B,"^",5))
SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(38,CCNT,"Practitioner:"_LRW(7))
+43 DO LN
+44 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,LR("%"))
+45 ;
+46 IF $DATA(^LR(LRDFN,LRSS,LRI,.1))
Begin DoDot:1
+47 DO LN
+48 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,"Specimen: ")
+49 SET LRV=.1
+50 DO F(1)
End DoDot:1
+51 ;
+52 ; Don't show anymore data if not verified.
+53 IF LRW(11)=""
Begin DoDot:1
+54 DO A
DO LN
+55 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,"Report not verified")
End DoDot:1
QUIT
+56 ;
+57 IF $PIECE($GET(^LR(LRDFN,LRSS,LRI,1.2,0)),"^",4)
Begin DoDot:1
+58 DO LN
+59 SET LRTEXT="SUPPLEMENTARY REPORT HAS BEEN ADDED"
+60 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(14,CCNT,"*+* "_LRTEXT_" *+*")
+61 DO LN
+62 SET LRTEXT="REFER TO BOTTOM OF REPORT"
+63 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(19,CCNT,"*+* "_LRTEXT_" *+*")
+64 DO LN
End DoDot:1
+65 ;
+66 IF $DATA(^LR(LRDFN,LRSS,LRI,.2))
Begin DoDot:1
+67 DO LN
+68 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,"Brief Clinical History:")
+69 SET LRV=.2
DO F()
End DoDot:1
+70 ;
+71 IF $DATA(^LR(LRDFN,LRSS,LRI,.3))
Begin DoDot:1
+72 DO LN
+73 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,"Preoperative Diagnosis:")
+74 SET LRV=.3
DO F()
End DoDot:1
+75 ;
+76 IF $DATA(^LR(LRDFN,LRSS,LRI,.4))
Begin DoDot:1
+77 DO LN
+78 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,"Operative Findings:")
+79 SET LRV=.4
DO F()
End DoDot:1
+80 ;
+81 IF $DATA(^LR(LRDFN,LRSS,LRI,.5))
Begin DoDot:1
+82 DO LN
+83 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,"Postoperative Diagnosis:")
+84 SET LRV=.5
DO F()
End DoDot:1
+85 ;
+86 DO SET^LRUA
+87 ;
+88 IF $ORDER(^LR(LRDFN,LRSS,LRI,1.3,0))
DO LN
SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,LR(69.2,.13))
IF $PIECE($GET(^LR(LRDFN,LRSS,LRI,6,0)),U,4)
SET LR(0)=6
DO MOD^LR7OSAP1
+89 SET LRV=1.3
+90 DO F()
+91 ;
+92 IF $ORDER(^LR(LRDFN,LRSS,LRI,1,0))
DO LN
SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,LR(69.2,.03))
IF $PIECE($GET(^LR(LRDFN,LRSS,LRI,7,0)),U,4)
SET LR(0)=7
DO MOD^LR7OSAP1
+93 SET LRV=1
+94 DO F()
+95 ;
+96 IF $ORDER(^LR(LRDFN,LRSS,LRI,1.1,0))
DO LN
SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,LR(69.2,.04)_" (Date Spec taken: "_LRW(1)_")")
IF $PIECE($GET(^LR(LRDFN,LRSS,LRI,4,0)),U,4)
SET LR(0)=4
DO MOD^LR7OSAP1
+97 SET LRV=1.1
+98 DO F()
+99 ;
+100 IF $ORDER(^LR(LRDFN,LRSS,LRI,1.4,0))
DO LN
SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,LR(69.2,.14))
IF $PIECE($GET(^LR(LRDFN,LRSS,LRI,5,0)),U,4)
SET LR(0)=5
DO MOD^LR7OSAP1
+101 SET LRV=1.4
+102 DO F()
+103 ;
+104 IF $ORDER(^LR(LRDFN,LRSS,LRI,1.2,0))
Begin DoDot:1
+105 DO LN
+106 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,"Supplementary Report:")
+107 SET C=0
FOR
SET C=$ORDER(^LR(LRDFN,LRSS,LRI,1.2,C))
if 'C
QUIT
Begin DoDot:2
+108 SET X=^LR(LRDFN,LRSS,LRI,1.2,C,0)
SET Y=+X
SET X=$PIECE(X,U,2)
+109 ;Don't even print supp date if supp is not released
+110 if 'X
QUIT
+111 DO D^LRU
DO LN
+112 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(3,CCNT,"Date: "_Y)
+113 IF 'X
SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(1,CCNT," not verified")
+114 IF $ORDER(^LR(LRDFN,LRSS,LRI,1.2,C,2,0))
DO MODSR^LR7OSAP1
+115 if X
DO U
End DoDot:2
End DoDot:1
+116 IF $DATA(^LR(LRDFN,LRSS,LRI,2))
DO B
+117 ;
+118 ; DALOI/LMT - LR,427 - Removed comments from report to restore pre-LR,350 behavior
+119 ;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)
+120 ;
+121 ; List performing labs
+122 DO PPL^LR7OSMZ1(LRDFN,LRSS,LRI)
+123 ;
+124 QUIT
+125 ;
+126 ;
U ;
+1 DO WRAP^LR7OSAP1("^LR("_LRDFN_","""_LRSS_""","_LRI_",1.2,"_C_",1)",79)
+2 QUIT
+3 ;
+4 ;
B ;
+1 SET C=0
+2 FOR
SET C=$ORDER(^LR(LRDFN,LRSS,LRI,2,C))
if 'C
QUIT
DO SP
+3 QUIT
+4 ;
+5 ;
SP ;
+1 SET G=0
+2 FOR
SET G=$ORDER(^LR(LRDFN,LRSS,LRI,2,C,5,G))
if 'G
QUIT
SET X=^(G,0)
SET Y=$PIECE(X,"^",2)
SET E=$PIECE(X,"^",3)
SET E(1)=$PIECE(X,"^")_":"
SET E(1)=$PIECE($PIECE($GET(LR(LRSS)),E(1),2),";")
DO D^LRU
SET T(2)=Y
DO WP
+3 QUIT
+4 ;
+5 ;
WP ;
+1 DO LN
+2 SET X=E(1)_" "_E_" Date: "_T(2)_" "
SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,X)
+3 DO WRAP^LR7OSAP1("^LR("_LRDFN_","""_LRSS_""","_LRI_",2,"_C_",5,"_G_",1)",79)
+4 QUIT
+5 ;
+6 ;
A ;
+1 DO WRAP^LR7OSAP1("^LR("_LRDFN_","""_LRSS_""","_LRI_",97)",79)
+2 QUIT
+3 ;
+4 ;
LN ;Increment the counter
+1 SET GCNT=GCNT+1
SET CCNT=1
+2 QUIT
+3 ;
+4 ;
EN ; Get AP results
+1 ; Called by LR7OSUM
+2 ;
+3 NEW GIOM
+4 SET GIOM=$GET(LRGIOM)
+5 IF GIOM=""
Begin DoDot:1
+6 SET GIOM=$$GET^XPAR("USR^DIV^PKG","LR AP GUI REPORT RIGHT MARGIN",1,"Q")
+7 IF GIOM=""
SET GIOM=80
End DoDot:1
+8 ;
+9 ; Display "Printed at:" notice
+10 IF '$ORDER(^TMP("LRC",$JOB,0))
IF $$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")>1
DO PFAC^LR7OSMZU
+11 ;
+12 IF $SELECT('$DATA(SUBHEAD):1,1:$DATA(SUBHEAD("SURGICAL PATHOLOGY")))
DO SPA
+13 IF $SELECT('$DATA(SUBHEAD):1,1:$DATA(SUBHEAD("CYTOPATHOLOGY")))
DO CY
+14 IF $SELECT('$DATA(SUBHEAD):1,1:$DATA(SUBHEAD("EM")))
DO EM
+15 IF $SELECT('$DATA(SUBHEAD):1,1:$DATA(SUBHEAD("AUTOPSY")))
DO AU
+16 QUIT
+17 ;
+18 ;
CY ; Cytology results
+1 ;
+2 IF '$DATA(^LR(LRDFN,"CY"))
Begin DoDot:1
+3 IF '$DATA(SUBHEAD("CYTOPATHOLOGY"))
QUIT
+4 DO LINE^LR7OSUM4
+5 DO LN
SET ^TMP("LRC",$JOB,GCNT,0)="No Cytology reports available..."
End DoDot:1
QUIT
+6 ;
+7 SET LRSS="CY"
SET LRAA(1)="CYTOPATHOLOGY"
SET LRAA=+$ORDER(^LRO(68,"B",LRAA(1),0))
if 'LRAA
SET LRAA=$$FIND(LRSS)
+8 DO GET
+9 QUIT
+10 ;
+11 ;
SPA ; Surgical Pathology results
+1 ;
+2 IF '$DATA(^LR(LRDFN,"SP"))
Begin DoDot:1
+3 IF '$DATA(SUBHEAD("SURGICAL PATHOLOGY"))
QUIT
+4 DO LINE^LR7OSUM4
+5 DO LN
SET ^TMP("LRC",$JOB,GCNT,0)="No Surgical Pathology reports available..."
End DoDot:1
QUIT
+6 ;
+7 SET LRSS="SP"
SET LRAA(1)="SURGICAL PATHOLOGY"
SET LRAA=+$ORDER(^LRO(68,"B",LRAA(1),0))
if 'LRAA
SET LRAA=$$FIND(LRSS)
+8 DO GET
+9 QUIT
+10 ;
+11 ;
EM ; Electron Microscopy results
+1 ;
+2 IF '$DATA(^LR(LRDFN,"EM"))
Begin DoDot:1
+3 IF '$DATA(SUBHEAD("EM"))
QUIT
+4 DO LINE^LR7OSUM4
+5 DO LN
SET ^TMP("LRC",$JOB,GCNT,0)="No EM reports available..."
End DoDot:1
QUIT
+6 ;
+7 SET LRSS="EM"
SET LRAA(1)="ELECTRON MICROSCOPY"
SET LRAA=+$ORDER(^LRO(68,"B","EM",0))
if 'LRAA
SET LRAA=$$FIND(LRSS)
+8 DO GET
+9 QUIT
+10 ;
+11 ;
AU ; Autopsy results
+1 ;
+2 IF '$DATA(^LR(LRDFN,"AU"))
Begin DoDot:1
+3 IF '$DATA(SUBHEAD("AUTOPSY"))
QUIT
+4 DO LINE^LR7OSUM4
+5 DO LN
SET ^TMP("LRC",$JOB,GCNT,0)="No Autopsy report available..."
End DoDot:1
QUIT
+6 ;
+7 DO EN^LR7OSAP2(LRDFN)
+8 QUIT
+9 ;
+10 ;
FIND(SS) ; Find a valid entry in 68
+1 ;SS=LRSS value to look for
+2 NEW I,Y
+3 SET I=0
SET Y=""
FOR
SET I=$ORDER(^LRO(68,I))
if I<1
QUIT
IF $PIECE($GET(^LRO(68,I,0)),"^",2)=SS
SET Y=I
QUIT
+4 QUIT Y
