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