LRAPBR1 ;DALOI/WTY/KLL - AP Browser Print Cont.;11/08/01
;;5.2;LAB SERVICE;**1030,1031**;NOV 1, 1997
;
;;VA LR Patche(s): 259,317,363
;
;
ENTER ; EP - from LRAPBR
N LRCNT,LRTMP,LRA1,LRADESC,LRLENG1,LRLENG2,LRFILE,LRAPMD
N LRFLD,LRV,LRV1,LRV2,LRB1,LRTEXT,LRSPCE,LRIENS,LRAPMR
Q:'$D(^LR(LRDFN,LRSS,LRI,0))
S:'LRTIU GROOT="^TMP(""LRAPBR"",$J,"
S:LRTIU GROOT="^TMP(""TIUP"",$J,"
D INP^VADPT S LRPRAC=+VAIN(2)
S:'LRPRAC LRPRAC(1)=""
I LRPRAC S X=LRPRAC D D^LRUA S LRPRAC(1)=X
S LRQ=0 D ^LRUA,HEADER
S LR("F")=1
D DASH
D:LRTIU GLENTRY("$TEXT",,1)
D GLENTRY("Submitted by: "_LRW(5),"",1)
D GLENTRY("Date obtained: "_LRTK,44)
D:LRA DASH
;
MAIN ;
D SPEC
D MODCHK
D SUPBNNR
D DIAG
D DOC
D WPFLD
D SUPRPT
D SSJR
Q
;
SPEC ;List specimens
D GLENTRY("Specimen (Received "_LRTK(1)_"):","",1)
S LRCNT=$P(^LR(LRDFN,LRSS,LRI,.1,0),U,4)
Q:'LRCNT
S LRFILE=+$$GET1^DID(LRSF,.012,"","SPECIFIER")
S LRIENS=LRI_","_LRDFN_","
S LRCT2=0
F LRB1=1:1 D Q:LRCT2=LRCNT
.D GETS^DIQ(LRFILE,LRB1_","_LRIENS,.01,"","LRTMP("_LRB1_")")
.I $D(LRTMP(LRB1)) S LRCT2=LRCT2+1
S LRA1=0 F S LRA1=$O(LRTMP(LRA1)) Q:'LRA1 D
.S LRTEXT=LRTMP(LRA1,LRFILE,LRA1_","_LRIENS,.01)
.D GLENTRY(LRTEXT,"",1)
Q
;
MODCHK ;Display modified banner if required
S LRAPMR=$$GET1^DIQ(LRSF,LRIENS,.17,"I")
Q:'LRAPMR
S LRAPMD=$$GET1^DIQ(LRSF,LRIENS,.172,"I")
D GLENTRY("","",1)
S LRTEXT=""
F LRCNT=1:1:$S(LRAPMD:14,1:15) D
.S LRTEXT=LRTEXT_"*+"
S LRTEXT=LRTEXT_" MODIFIED "
S LRTEXT=LRTEXT_$S(LRAPMD:"DIAGNOSIS ",1:"REPORT ")
F LRCNT=1:1:$S(LRAPMD:14,1:15) D
.S LRTEXT=LRTEXT_"*+"
D GLENTRY(LRTEXT,"",1)
D GLENTRY("","",1)
Q
;
SUPBNNR ;Display supplementary report header if one or more has been added
I $P($G(^LR(LRDFN,LRSS,LRI,1.2,0)),U,4) D
.S LRTEXT="*+* SUPPLEMENTARY REPORT HAS BEEN ADDED *+*"
.D GLENTRY($$CJ^XLFSTR(LRTEXT,IOM),"",1)
.S LRTEXT="*+* REFER TO BOTTOM OF REPORT *+*"
.D GLENTRY($$CJ^XLFSTR(LRTEXT,IOM),"",1)
.D GLENTRY("","",1)
Q
;
DIAG ;
;Display the Brief Clinical History, Preoperative Diagnosis,
;Operative Findings, and Postoperative Diagnosis
S LRFILE=LRSF,LRCNT=0,LRIENS=LRI_","_LRDFN_","
F LRFLD=.013:.001:.016 D
.D:LRA DASH
.S LRCNT=LRCNT+1
.D GLENTRY($P($T(TEXT1+LRCNT),";",2),"",1)
.D WP
Q
;
DOC ;
;Pathologist information
D GLENTRY("","",1)
D GLENTRY("Surgeon/physician: "_LRMD,27,1)
D:LRA GLENTRY(LR("%1"),"",1)
D DASH
D HEADER2
D:LRA DASH
I LRRC="" D
.D GLENTRY("+*+* REPORT INCOMPLETE *+*+",20,1)
.D GLENTRY("","",1)
D GLENTRY("","",1)
I LRRMD'="" D
.S LRCNT=0 F LRA1="SP","CY","EM" D
..S LRCNT=LRCNT+1
..S LRTMP(LRA1)=$P($T(TEXT2+LRCNT),";",3)
.S LRTMP=LRTMP(LRSS)
.D GLENTRY(LRTMP_" "_LRRMD,31)
Q
;
WPFLD ;
;Display Frozen Section, Gross Description, Microscopic Description
;and Surgical Path Diagnosis
F LRCNT=1:1:4 D
.S X=$T(FIELDS+LRCNT)
.S LRV=$P(X,";",2),LRV1=$P(X,";",3),LRV2=$P(X,";",4)
.D TEXTCHK
.I $P($G(^LR(LRDFN,LRSS,LRI,LRV,0)),U,4) D
..D GLENTRY("","",1),GLENTRY(LR(69.2,LRV1),"",1)
..S LRFILE=LRSF,LRIENS=LRI_","_LRDFN_",",LRFLD=LRV
..I $P($G(^LR(LRDFN,LRSS,LRI,LRV2,0)),U,4) D
...S LRFILE1=+$$GET1^DID(LRSF,LRV2,"","SPECIFIER")
...D GLENTRY("*+* MODIFIED REPORT *+*",28,1)
...D GLENTRY("(Last modified: ","",1)
...S (LRA1,LRB1)=0
...F S LRA1=$O(^LR(LRDFN,LRSS,LRI,LRV2,LRA1)) Q:'LRA1 S LRB1=LRA1
...Q:'$D(^LR(LRDFN,LRSS,LRI,LRV2,LRB1,0))
...S LRSR1=$$GET1^DIQ(LRFILE1,LRB1_","_LRIENS,.01)
...S LRSR2=$$GET1^DIQ(LRFILE1,LRB1_","_LRIENS,.02)
...S LRTEXT=LRSR1_" typed by "_LRSR2_")"
...D GLENTRY(LRTEXT,BTAB)
..D WP
Q
;
SUPRPT ;Supplementary Report
I $P($G(^LR(LRDFN,LRSS,LRI,1.2,0)),U,4) D
.S LRFILE=+$$GET1^DID(LRSF,1.2,"","SPECIFIER")
.S LRIENS1=LRI_","_LRDFN_","
.D GLENTRY("","",1),GLENTRY("SUPPLEMENTARY REPORT(S):","",1)
.S LRV=0 F S LRV=$O(^LR(LRDFN,LRSS,LRI,1.2,LRV)) Q:'LRV D
..S LRIENS=LRV_","_LRIENS1
..S LRSR1=$$GET1^DIQ(LRFILE,LRIENS,.01)
..S LRSR2=+$$GET1^DIQ(LRFILE,LRIENS,.02)
..D GLENTRY("Supplementary Report Date: "_LRSR1,3,1)
..I $D(LR("R")),'LRSR2 D GLENTRY(" not verified",BTAB) Q
..I $P($G(^LR(LRDFN,LRSS,LRI,1.2,LRV,2,0)),U,4) D
...S LRTEXT="*+* SUPPLEMENTARY REPORT HAS BEEN ADDED/MODIFIED *+*"
...D GLENTRY($$CJ^XLFSTR(LRTEXT,IOM),"",1)
...D GLENTRY("(Added/Last","",1)
...S (LRA1,LRB1)=0
...F S LRA1=$O(^LR(LRDFN,LRSS,LRI,1.2,LRV,2,LRA1)) Q:'LRA1 D
....S LRB1=LRA1
...Q:'$D(^LR(LRDFN,LRSS,LRI,1.2,LRV,2,LRB1,0))
...S LRA2=^(0),Y=+LRA2,LRA2A=$P(LRA2,"^",2),LRSGN=" Typed by ",LRDSC=" modified: "
...I $P(LRA2,"^",3) S LRSGN=" Signed by ",LRDSC=" released: ",LRA2A=$P(LRA2,"^",3),Y=$P(LRA2,"^",4)
...S LRA2A=$S($D(^VA(200,LRA2A,0)):$P(^(0),"^"),1:LRA2A)
...D D^LRU
...D GLENTRY(LRDSC_Y_LRSGN_LRA2A_")",BTAB)
..S LRFLD=1 D WP
..D GLENTRY("","",1)
Q
;
SSJR ;Print special studies/journal references
D ^LRAPBR3
S LREFLG=1
Q
;
WP ;Display word procesing fields
K LRTMP,^UTILITY($J,"W")
N X,DIWR,DIWL,LRINC
S X=$$GET1^DIQ(LRFILE,LRIENS,LRFLD,"","LRTMP",)
S DIWR=IOM-5,DIWL=5,DIWF=""
S X=+$$GET1^DID(LRFILE,LRFLD,"","SPECIFIER")
I $$GET1^DID(X,.01,"","SPECIFIER")["L" S DIWF="N"
S LRINC=0
F S LRINC=$O(LRTMP(LRINC)) Q:'LRINC S X=LRTMP(LRINC) D ^DIWP
S LRINC=0
F S LRINC=$O(^UTILITY($J,"W",DIWL,LRINC)) Q:'LRINC D
.D GLENTRY(^UTILITY($J,"W",DIWL,LRINC,0),DIWL,1)
K ^UTILITY($J,"W")
Q
;
D:LRTIU GLENTRY("$APHDR",,1)
D GLENTRY("","",1)
D DASH
D GLENTRY("MEDICAL RECORD |",5,1)
D GLENTRY(LRAA1,40)
D DASH
;
S LRADESC="Accession No. "_$S(LRQ(8)]"":LRQ(8)_LRW(1)_" "_LRAC,1:LRAC)
S LRLENG1=$L(LRQ(1)),LRLENG2=$L(LRADESC),LRSPCE=IOM-LRLENG2-14
S:LRLENG1>LRSPCE LRQ(1)=$E(LRQ(1),1,LRSPCE)
D GLENTRY("PATHOLOGY REPORT",30,1)
D GLENTRY("Laboratory: "_LRQ(1),"",1)
D GLENTRY(LRADESC,IOM-LRLENG2-1)
Q
;
D:LRTIU GLENTRY("$FTR",,1)
D DASH
S LRTEXT=$S('$D(LR("W")):"",1:"See signed copy in chart")
D GLENTRY(LRTEXT,"",1)
S LRTEXT="("_$S($D(LREFLG):"End of report",1:"See next page")_")"
D GLENTRY(LRTEXT,57)
D GLENTRY(LRPMD,"",1),GLENTRY(LRW(9),52),GLENTRY("| Date "_LRRC,55)
D DASH
D GLENTRY(LRP,"",1)
S LRTEXT=$S('$D(LR("W")):"STANDARD FORM 515",1:"WORK COPY ONLY !!")
D GLENTRY(LRTEXT,50)
; D GLENTRY("ID:"_SSN,"",1)
D GLENTRY("ID:"_HRCN,"",1) ; IHS/MSC/MKK - LR*5.2*1031
D GLENTRY("SEX:"_SEX,16),GLENTRY(" DOB:"_DOB,BTAB)
I AGE D
.S LRTEXT=$S($G(VADM(6))]"":" AGE AT DEATH: ",1:" AGE: ")_AGE
.D GLENTRY(LRTEXT,BTAB)
D GLENTRY(" LOC:"_LRLLOC,BTAB)
D GLENTRY("","",1)
D:$L(LRADM) GLENTRY("ADM:"_$P(LRADM,"@"),BTAB)
D:$L(LRADX) GLENTRY("DX:"_$E(LRADX,1,26),17)
D GLENTRY("PCP:",46)
D:$L(LRPRAC) GLENTRY($E(LRPRAC(1),1,28),51)
Q
;
ESIGLN ;Write signature block name, title, and date of signature
D GLENTRY(,,1)
I $D(^VA(200,DUZ,0)) D
.S LRFILE=200,LRFLD=20.2,LRFLD2=20.3
.S X=$$GET1^DIQ(LRFILE,DUZ,LRFLD)
;Compare DUZ to pathologist, if different, use proxy signature
S:LRSS="AU" LRPATH=$$GET1^DIQ(63,LRDFN,13.6,"I")
I LRSS'="AU" D
.S LRFL2=$S(LRSS="EM":63.02,LRSS="CY":63.09,LRSS="SP":63.08,1:0)
.S LRIENS=LRI_","_LRDFN_","
.S LRPATH=$$GET1^DIQ(LRFL2,LRIENS,.02,"I")
S LRPATH2=""
S:LRPATH'=DUZ LRPATH2=" FOR "_$$GET1^DIQ(LRFILE,LRPATH,LRFLD)
S LRTEXT="/es/ "_X_LRPATH2
;S LRTEXT="/es/ "_X
D GLENTRY(LRTEXT,,1)
S X=$$GET1^DIQ(LRFILE,DUZ,LRFLD2)
S LRTEXT=X
D GLENTRY(LRTEXT,,1)
S Y=LRNTIME D DD^%DT
S LRTEXT="Signed "_Y
D GLENTRY(LRTEXT,,1)
Q
;
DASH ;Display a line of dashes
D GLENTRY(LR("%"),"",1)
Q
;
GLENTRY(LRPR1,LRPR2,LRPR3) ;Write to global
;LRPR1 = Text to be written to global
;LRPR2 = Tab position
;LRPR3 = 1 means start a new line. Othewise, write an current line.
S LRPR1=$G(LRPR1)
S LRPR2=+$G(LRPR2)
S LRPR3=+$G(LRPR3)
D:LRPR3 NEWLN^LRAPUTL(LRPR1,LRPR2)
D:'LRPR3 GLBWRT^LRAPUTL(LRPR1,LRPR2)
Q
;
TEXT1 ;Text for top of report
;BRIEF CLINICAL HISTORY:
;PREOPERATIVE DIAGNOSIS:
;OPERATIVE FINDINGS:
;POSTOPERATIVE DIAGNOSIS:
TEXT2 ;Descriptive text based on section
;SP;Pathology Resident:
;CY;Screened by:
;EM;Prepared by:
FIELDS ;Field numbers for word processing fields
;1.3;.13;6
;1;.03;7
;1.1;.04;4
;1.4;.14;5
TEXTCHK ; update text line counter if it is missing (Remedy 116253)
N I,X,DATA
S I=0
K ^TMP("WP",$J)
S X=$G(^LR(LRDFN,LRSS,LRI,LRV,0))
I X'="",$L(X,"^")=1 D
. F S I=$O(^LR(LRDFN,LRSS,LRI,LRV,I)) Q:I="" D
. . S DATA=$G(^LR(LRDFN,LRSS,LRI,LRV,I,0))
. . S ^TMP("WP",$J,I,0)=DATA
I $D(^TMP("WP",$J)) D
. D WP^DIE(63.08,LRI_","_LRDFN_",",LRV,"","^TMP(""WP"",$J)")
. K ^TMP("WP",$J)
Q
LRAPBR1 ;DALOI/WTY/KLL - AP Browser Print Cont.;11/08/01
+1 ;;5.2;LAB SERVICE;**1030,1031**;NOV 1, 1997
+2 ;
+3 ;;VA LR Patche(s): 259,317,363
+4 ;
+5 ;
ENTER ; EP - from LRAPBR
+1 NEW LRCNT,LRTMP,LRA1,LRADESC,LRLENG1,LRLENG2,LRFILE,LRAPMD
+2 NEW LRFLD,LRV,LRV1,LRV2,LRB1,LRTEXT,LRSPCE,LRIENS,LRAPMR
+3 IF '$DATA(^LR(LRDFN,LRSS,LRI,0))
QUIT
+4 IF 'LRTIU
SET GROOT="^TMP(""LRAPBR"",$J,"
+5 IF LRTIU
SET GROOT="^TMP(""TIUP"",$J,"
+6 DO INP^VADPT
SET LRPRAC=+VAIN(2)
+7 IF 'LRPRAC
SET LRPRAC(1)=""
+8 IF LRPRAC
SET X=LRPRAC
DO D^LRUA
SET LRPRAC(1)=X
+9 SET LRQ=0
DO ^LRUA
DO HEADER
+10 SET LR("F")=1
+11 DO DASH
+12 IF LRTIU
DO GLENTRY("$TEXT",,1)
+13 DO GLENTRY("Submitted by: "_LRW(5),"",1)
+14 DO GLENTRY("Date obtained: "_LRTK,44)
+15 IF LRA
DO DASH
+16 ;
MAIN ;
+1 DO SPEC
+2 DO MODCHK
+3 DO SUPBNNR
+4 DO DIAG
+5 DO DOC
+6 DO WPFLD
+7 DO SUPRPT
+8 DO SSJR
+9 QUIT
+10 ;
SPEC ;List specimens
+1 DO GLENTRY("Specimen (Received "_LRTK(1)_"):","",1)
+2 SET LRCNT=$PIECE(^LR(LRDFN,LRSS,LRI,.1,0),U,4)
+3 IF 'LRCNT
QUIT
+4 SET LRFILE=+$$GET1^DID(LRSF,.012,"","SPECIFIER")
+5 SET LRIENS=LRI_","_LRDFN_","
+6 SET LRCT2=0
+7 FOR LRB1=1:1
Begin DoDot:1
+8 DO GETS^DIQ(LRFILE,LRB1_","_LRIENS,.01,"","LRTMP("_LRB1_")")
+9 IF $DATA(LRTMP(LRB1))
SET LRCT2=LRCT2+1
End DoDot:1
IF LRCT2=LRCNT
QUIT
+10 SET LRA1=0
FOR
SET LRA1=$ORDER(LRTMP(LRA1))
IF 'LRA1
QUIT
Begin DoDot:1
+11 SET LRTEXT=LRTMP(LRA1,LRFILE,LRA1_","_LRIENS,.01)
+12 DO GLENTRY(LRTEXT,"",1)
End DoDot:1
+13 QUIT
+14 ;
MODCHK ;Display modified banner if required
+1 SET LRAPMR=$$GET1^DIQ(LRSF,LRIENS,.17,"I")
+2 IF 'LRAPMR
QUIT
+3 SET LRAPMD=$$GET1^DIQ(LRSF,LRIENS,.172,"I")
+4 DO GLENTRY("","",1)
+5 SET LRTEXT=""
+6 FOR LRCNT=1:1:$SELECT(LRAPMD:14,1:15)
Begin DoDot:1
+7 SET LRTEXT=LRTEXT_"*+"
End DoDot:1
+8 SET LRTEXT=LRTEXT_" MODIFIED "
+9 SET LRTEXT=LRTEXT_$SELECT(LRAPMD:"DIAGNOSIS ",1:"REPORT ")
+10 FOR LRCNT=1:1:$SELECT(LRAPMD:14,1:15)
Begin DoDot:1
+11 SET LRTEXT=LRTEXT_"*+"
End DoDot:1
+12 DO GLENTRY(LRTEXT,"",1)
+13 DO GLENTRY("","",1)
+14 QUIT
+15 ;
SUPBNNR ;Display supplementary report header if one or more has been added
+1 IF $PIECE($GET(^LR(LRDFN,LRSS,LRI,1.2,0)),U,4)
Begin DoDot:1
+2 SET LRTEXT="*+* SUPPLEMENTARY REPORT HAS BEEN ADDED *+*"
+3 DO GLENTRY($$CJ^XLFSTR(LRTEXT,IOM),"",1)
+4 SET LRTEXT="*+* REFER TO BOTTOM OF REPORT *+*"
+5 DO GLENTRY($$CJ^XLFSTR(LRTEXT,IOM),"",1)
+6 DO GLENTRY("","",1)
End DoDot:1
+7 QUIT
+8 ;
DIAG ;
+1 ;Display the Brief Clinical History, Preoperative Diagnosis,
+2 ;Operative Findings, and Postoperative Diagnosis
+3 SET LRFILE=LRSF
SET LRCNT=0
SET LRIENS=LRI_","_LRDFN_","
+4 FOR LRFLD=.013:.001:.016
Begin DoDot:1
+5 IF LRA
DO DASH
+6 SET LRCNT=LRCNT+1
+7 DO GLENTRY($PIECE($TEXT(TEXT1+LRCNT),";",2),"",1)
+8 DO WP
End DoDot:1
+9 QUIT
+10 ;
DOC ;
+1 ;Pathologist information
+2 DO GLENTRY("","",1)
+3 DO GLENTRY("Surgeon/physician: "_LRMD,27,1)
+4 IF LRA
DO GLENTRY(LR("%1"),"",1)
+5 DO DASH
+6 DO HEADER2
+7 IF LRA
DO DASH
+8 IF LRRC=""
Begin DoDot:1
+9 DO GLENTRY("+*+* REPORT INCOMPLETE *+*+",20,1)
+10 DO GLENTRY("","",1)
End DoDot:1
+11 DO GLENTRY("","",1)
+12 IF LRRMD'=""
Begin DoDot:1
+13 SET LRCNT=0
FOR LRA1="SP","CY","EM"
Begin DoDot:2
+14 SET LRCNT=LRCNT+1
+15 SET LRTMP(LRA1)=$PIECE($TEXT(TEXT2+LRCNT),";",3)
End DoDot:2
+16 SET LRTMP=LRTMP(LRSS)
+17 DO GLENTRY(LRTMP_" "_LRRMD,31)
End DoDot:1
+18 QUIT
+19 ;
WPFLD ;
+1 ;Display Frozen Section, Gross Description, Microscopic Description
+2 ;and Surgical Path Diagnosis
+3 FOR LRCNT=1:1:4
Begin DoDot:1
+4 SET X=$TEXT(FIELDS+LRCNT)
+5 SET LRV=$PIECE(X,";",2)
SET LRV1=$PIECE(X,";",3)
SET LRV2=$PIECE(X,";",4)
+6 DO TEXTCHK
+7 IF $PIECE($GET(^LR(LRDFN,LRSS,LRI,LRV,0)),U,4)
Begin DoDot:2
+8 DO GLENTRY("","",1)
DO GLENTRY(LR(69.2,LRV1),"",1)
+9 SET LRFILE=LRSF
SET LRIENS=LRI_","_LRDFN_","
SET LRFLD=LRV
+10 IF $PIECE($GET(^LR(LRDFN,LRSS,LRI,LRV2,0)),U,4)
Begin DoDot:3
+11 SET LRFILE1=+$$GET1^DID(LRSF,LRV2,"","SPECIFIER")
+12 DO GLENTRY("*+* MODIFIED REPORT *+*",28,1)
+13 DO GLENTRY("(Last modified: ","",1)
+14 SET (LRA1,LRB1)=0
+15 FOR
SET LRA1=$ORDER(^LR(LRDFN,LRSS,LRI,LRV2,LRA1))
IF 'LRA1
QUIT
SET LRB1=LRA1
+16 IF '$DATA(^LR(LRDFN,LRSS,LRI,LRV2,LRB1,0))
QUIT
+17 SET LRSR1=$$GET1^DIQ(LRFILE1,LRB1_","_LRIENS,.01)
+18 SET LRSR2=$$GET1^DIQ(LRFILE1,LRB1_","_LRIENS,.02)
+19 SET LRTEXT=LRSR1_" typed by "_LRSR2_")"
+20 DO GLENTRY(LRTEXT,BTAB)
End DoDot:3
+21 DO WP
End DoDot:2
End DoDot:1
+22 QUIT
+23 ;
SUPRPT ;Supplementary Report
+1 IF $PIECE($GET(^LR(LRDFN,LRSS,LRI,1.2,0)),U,4)
Begin DoDot:1
+2 SET LRFILE=+$$GET1^DID(LRSF,1.2,"","SPECIFIER")
+3 SET LRIENS1=LRI_","_LRDFN_","
+4 DO GLENTRY("","",1)
DO GLENTRY("SUPPLEMENTARY REPORT(S):","",1)
+5 SET LRV=0
FOR
SET LRV=$ORDER(^LR(LRDFN,LRSS,LRI,1.2,LRV))
IF 'LRV
QUIT
Begin DoDot:2
+6 SET LRIENS=LRV_","_LRIENS1
+7 SET LRSR1=$$GET1^DIQ(LRFILE,LRIENS,.01)
+8 SET LRSR2=+$$GET1^DIQ(LRFILE,LRIENS,.02)
+9 DO GLENTRY("Supplementary Report Date: "_LRSR1,3,1)
+10 IF $DATA(LR("R"))
IF 'LRSR2
DO GLENTRY(" not verified",BTAB)
QUIT
+11 IF $PIECE($GET(^LR(LRDFN,LRSS,LRI,1.2,LRV,2,0)),U,4)
Begin DoDot:3
+12 SET LRTEXT="*+* SUPPLEMENTARY REPORT HAS BEEN ADDED/MODIFIED *+*"
+13 DO GLENTRY($$CJ^XLFSTR(LRTEXT,IOM),"",1)
+14 DO GLENTRY("(Added/Last","",1)
+15 SET (LRA1,LRB1)=0
+16 FOR
SET LRA1=$ORDER(^LR(LRDFN,LRSS,LRI,1.2,LRV,2,LRA1))
IF 'LRA1
QUIT
Begin DoDot:4
+17 SET LRB1=LRA1
End DoDot:4
+18 IF '$DATA(^LR(LRDFN,LRSS,LRI,1.2,LRV,2,LRB1,0))
QUIT
+19 SET LRA2=^(0)
SET Y=+LRA2
SET LRA2A=$PIECE(LRA2,"^",2)
SET LRSGN=" Typed by "
SET LRDSC=" modified: "
+20 IF $PIECE(LRA2,"^",3)
SET LRSGN=" Signed by "
SET LRDSC=" released: "
SET LRA2A=$PIECE(LRA2,"^",3)
SET Y=$PIECE(LRA2,"^",4)
+21 SET LRA2A=$SELECT($DATA(^VA(200,LRA2A,0)):$PIECE(^(0),"^"),1:LRA2A)
+22 DO D^LRU
+23 DO GLENTRY(LRDSC_Y_LRSGN_LRA2A_")",BTAB)
End DoDot:3
+24 SET LRFLD=1
DO WP
+25 DO GLENTRY("","",1)
End DoDot:2
End DoDot:1
+26 QUIT
+27 ;
SSJR ;Print special studies/journal references
+1 DO ^LRAPBR3
+2 SET LREFLG=1
+3 QUIT
+4 ;
WP ;Display word procesing fields
+1 KILL LRTMP,^UTILITY($JOB,"W")
+2 NEW X,DIWR,DIWL,LRINC
+3 SET X=$$GET1^DIQ(LRFILE,LRIENS,LRFLD,"","LRTMP",)
+4 SET DIWR=IOM-5
SET DIWL=5
SET DIWF=""
+5 SET X=+$$GET1^DID(LRFILE,LRFLD,"","SPECIFIER")
+6 IF $$GET1^DID(X,.01,"","SPECIFIER")["L"
SET DIWF="N"
+7 SET LRINC=0
+8 FOR
SET LRINC=$ORDER(LRTMP(LRINC))
IF 'LRINC
QUIT
SET X=LRTMP(LRINC)
DO ^DIWP
+9 SET LRINC=0
+10 FOR
SET LRINC=$ORDER(^UTILITY($JOB,"W",DIWL,LRINC))
IF 'LRINC
QUIT
Begin DoDot:1
+11 DO GLENTRY(^UTILITY($JOB,"W",DIWL,LRINC,0),DIWL,1)
End DoDot:1
+12 KILL ^UTILITY($JOB,"W")
+13 QUIT
+14 ;
+1 IF LRTIU
DO GLENTRY("$APHDR",,1)
+2 DO GLENTRY("","",1)
+3 DO DASH
+4 DO GLENTRY("MEDICAL RECORD |",5,1)
+5 DO GLENTRY(LRAA1,40)
+6 DO DASH
+7 ;
+1 SET LRADESC="Accession No. "_$SELECT(LRQ(8)]"":LRQ(8)_LRW(1)_" "_LRAC,1:LRAC)
+2 SET LRLENG1=$LENGTH(LRQ(1))
SET LRLENG2=$LENGTH(LRADESC)
SET LRSPCE=IOM-LRLENG2-14
+3 IF LRLENG1>LRSPCE
SET LRQ(1)=$EXTRACT(LRQ(1),1,LRSPCE)
+4 DO GLENTRY("PATHOLOGY REPORT",30,1)
+5 DO GLENTRY("Laboratory: "_LRQ(1),"",1)
+6 DO GLENTRY(LRADESC,IOM-LRLENG2-1)
+7 QUIT
+8 ;
+1 IF LRTIU
DO GLENTRY("$FTR",,1)
+2 DO DASH
+3 SET LRTEXT=$SELECT('$DATA(LR("W")):"",1:"See signed copy in chart")
+4 DO GLENTRY(LRTEXT,"",1)
+5 SET LRTEXT="("_$SELECT($DATA(LREFLG):"End of report",1:"See next page")_")"
+6 DO GLENTRY(LRTEXT,57)
+7 DO GLENTRY(LRPMD,"",1)
DO GLENTRY(LRW(9),52)
DO GLENTRY("| Date "_LRRC,55)
+8 DO DASH
+9 DO GLENTRY(LRP,"",1)
+10 SET LRTEXT=$SELECT('$DATA(LR("W")):"STANDARD FORM 515",1:"WORK COPY ONLY !!")
+11 DO GLENTRY(LRTEXT,50)
+12 ; D GLENTRY("ID:"_SSN,"",1)
+13 ; IHS/MSC/MKK - LR*5.2*1031
DO GLENTRY("ID:"_HRCN,"",1)
+14 DO GLENTRY("SEX:"_SEX,16)
DO GLENTRY(" DOB:"_DOB,BTAB)
+15 IF AGE
Begin DoDot:1
+16 SET LRTEXT=$SELECT($GET(VADM(6))]"":" AGE AT DEATH: ",1:" AGE: ")_AGE
+17 DO GLENTRY(LRTEXT,BTAB)
End DoDot:1
+18 DO GLENTRY(" LOC:"_LRLLOC,BTAB)
+19 DO GLENTRY("","",1)
+20 IF $LENGTH(LRADM)
DO GLENTRY("ADM:"_$PIECE(LRADM,"@"),BTAB)
+21 IF $LENGTH(LRADX)
DO GLENTRY("DX:"_$EXTRACT(LRADX,1,26),17)
+22 DO GLENTRY("PCP:",46)
+23 IF $LENGTH(LRPRAC)
DO GLENTRY($EXTRACT(LRPRAC(1),1,28),51)
+24 QUIT
+25 ;
ESIGLN ;Write signature block name, title, and date of signature
+1 DO GLENTRY(,,1)
+2 IF $DATA(^VA(200,DUZ,0))
Begin DoDot:1
+3 SET LRFILE=200
SET LRFLD=20.2
SET LRFLD2=20.3
+4 SET X=$$GET1^DIQ(LRFILE,DUZ,LRFLD)
End DoDot:1
+5 ;Compare DUZ to pathologist, if different, use proxy signature
+6 IF LRSS="AU"
SET LRPATH=$$GET1^DIQ(63,LRDFN,13.6,"I")
+7 IF LRSS'="AU"
Begin DoDot:1
+8 SET LRFL2=$SELECT(LRSS="EM":63.02,LRSS="CY":63.09,LRSS="SP":63.08,1:0)
+9 SET LRIENS=LRI_","_LRDFN_","
+10 SET LRPATH=$$GET1^DIQ(LRFL2,LRIENS,.02,"I")
End DoDot:1
+11 SET LRPATH2=""
+12 IF LRPATH'=DUZ
SET LRPATH2=" FOR "_$$GET1^DIQ(LRFILE,LRPATH,LRFLD)
+13 SET LRTEXT="/es/ "_X_LRPATH2
+14 ;S LRTEXT="/es/ "_X
+15 DO GLENTRY(LRTEXT,,1)
+16 SET X=$$GET1^DIQ(LRFILE,DUZ,LRFLD2)
+17 SET LRTEXT=X
+18 DO GLENTRY(LRTEXT,,1)
+19 SET Y=LRNTIME
DO DD^%DT
+20 SET LRTEXT="Signed "_Y
+21 DO GLENTRY(LRTEXT,,1)
+22 QUIT
+23 ;
DASH ;Display a line of dashes
+1 DO GLENTRY(LR("%"),"",1)
+2 QUIT
+3 ;
GLENTRY(LRPR1,LRPR2,LRPR3) ;Write to global
+1 ;LRPR1 = Text to be written to global
+2 ;LRPR2 = Tab position
+3 ;LRPR3 = 1 means start a new line. Othewise, write an current line.
+4 SET LRPR1=$GET(LRPR1)
+5 SET LRPR2=+$GET(LRPR2)
+6 SET LRPR3=+$GET(LRPR3)
+7 IF LRPR3
DO NEWLN^LRAPUTL(LRPR1,LRPR2)
+8 IF 'LRPR3
DO GLBWRT^LRAPUTL(LRPR1,LRPR2)
+9 QUIT
+10 ;
TEXT1 ;Text for top of report
+1 ;BRIEF CLINICAL HISTORY:
+2 ;PREOPERATIVE DIAGNOSIS:
+3 ;OPERATIVE FINDINGS:
+4 ;POSTOPERATIVE DIAGNOSIS:
TEXT2 ;Descriptive text based on section
+1 ;SP;Pathology Resident:
+2 ;CY;Screened by:
+3 ;EM;Prepared by:
FIELDS ;Field numbers for word processing fields
+1 ;1.3;.13;6
+2 ;1;.03;7
+3 ;1.1;.04;4
+4 ;1.4;.14;5
TEXTCHK ; update text line counter if it is missing (Remedy 116253)
+1 NEW I,X,DATA
+2 SET I=0
+3 KILL ^TMP("WP",$JOB)
+4 SET X=$GET(^LR(LRDFN,LRSS,LRI,LRV,0))
+5 IF X'=""
IF $LENGTH(X,"^")=1
Begin DoDot:1
+6 FOR
SET I=$ORDER(^LR(LRDFN,LRSS,LRI,LRV,I))
IF I=""
QUIT
Begin DoDot:2
+7 SET DATA=$GET(^LR(LRDFN,LRSS,LRI,LRV,I,0))
+8 SET ^TMP("WP",$JOB,I,0)=DATA
End DoDot:2
End DoDot:1
+9 IF $DATA(^TMP("WP",$JOB))
Begin DoDot:1
+10 DO WP^DIE(63.08,LRI_","_LRDFN_",",LRV,"","^TMP(""WP"",$J)")
+11 KILL ^TMP("WP",$JOB)
End DoDot:1
+12 QUIT
