LRAPBR5 ;DALOI/WTY;AUTOPSY BROWSER DISPLAY/TIU STORAGE;6/5/2001
;;5.2;LAB SERVICE;**259**;Sep 27, 1994
;
;This routine was copied from ^LRAPT2. It was updated with FileMan
;DBS calls and modified to be used for browser display and storage
;of the SF515 in TIU.
;
MAIN ;
N LRLLOC,LRDTDIED,LRTMP,LRNUM,LRINC,LRINC1
S LRQUIT=0
S:'$D(LRIENS) LRIENS=LRDFN_","
D HEADER
Q:LRQUIT
D WEIGHTS
D SPCSTD
D JRNLREF
D:'LRAU DIAGS
Q
D GLENTRY("","",1)
D GLENTRY(LRP,"",1)
D GLENTRY(SSN,32)
D GLENTRY("DOB: "_DOB,52)
S LR("F")=1
I 'LRTIU,'+$$GET1^DIQ(63,LRIENS,14.7,"I") D Q
.D GLENTRY("","",1)
.D GLENTRY("Autopsy protocol report not verified.","",1)
.S LRQUIT=1
S LRLLOC=$$GET1^DIQ(63,LRIENS,14.5,"E")
S DA=LRDFN D D^LRAUAW S Y=LR(63,12) D D^LRU S LRDTDIED=Y
D GLENTRY("Acc: "_$$GET1^DIQ(63,LRIENS,14),"",1)
D GLENTRY("AUTOPSY DATA",32)
D GLENTRY("Age: "_$J($$GET1^DIQ(63,LRIENS,12.5),3),52)
D GLENTRY("Date/time Died","",1)
D GLENTRY("Date/time of Autopsy",52)
D GLENTRY(LRDTDIED,"",1)
D GLENTRY($E($$GET1^DIQ(63,LRIENS,13.7,"E"),1,18),32)
D GLENTRY($$GET1^DIQ(63,LRIENS,11,"E"),52)
D GLENTRY("Resident: "_$$GET1^DIQ(63,LRIENS,13.5,"E"),"",1)
D GLENTRY("Senior: "_$E($$GET1^DIQ(63,LRIENS,13.6,"E"),1,19),52)
Q
WEIGHTS ;Display/Store Weights & Measures
D GLENTRY("","",1)
I $D(^LR(LRDFN,"AW")) D
.S LRTMP="Rt--Lung--Lt Liver Spleen Rt--Kidney--Lt Brain Body "
.S LRTMP=LRTMP_"Wt(lb) Ht(in)"
.D GLENTRY(LRTMP,"",1)
.D GLENTRY($J($$GET1^DIQ(63,LRIENS,18),4),"",1)
.D GLENTRY($J($$GET1^DIQ(63,LRIENS,19),4),8)
.D GLENTRY($J($$GET1^DIQ(63,LRIENS,20),5),14)
.D GLENTRY($J($$GET1^DIQ(63,LRIENS,21),5),21)
.D GLENTRY($J($$GET1^DIQ(63,LRIENS,22),4),28)
.D GLENTRY($J($$GET1^DIQ(63,LRIENS,23),4),38)
.D GLENTRY($J($$GET1^DIQ(63,LRIENS,25),4),45)
.D GLENTRY($$GET1^DIQ(63,LRIENS,17),55)
.D GLENTRY($$GET1^DIQ(63,LRIENS,16),68)
F LRINC=1:1:2 D GLENTRY("","",1)
D:$D(^LR(LRDFN,"AW")) GLENTRY("Heart(gm)",BTAB)
I $D(^LR(LRDFN,"AV")) D
.D GLENTRY("TV(cm) PV(cm) MV(cm) AV(cm) RV(cm) LV(cm)",12)
D GLENTRY("","",1)
D GLENTRY($J($$GET1^DIQ(63,LRIENS,24),5),BTAB)
I $D(^LR(LRDFN,"AV")) D
.S LRNUM=12
.F LRINC=26:1:31 D
..D GLENTRY($J($$GET1^DIQ(63,LRIENS,LRINC),4),LRNUM)
..S LRNUM=LRNUM+8
.D GLENTRY("","",1)
.S LRTMP="Cavities(ml): Rt--Pleural--Lt Pericardial Peritoneal"
.D GLENTRY(LRTMP,"",1)
.D GLENTRY($J($$GET1^DIQ(63,LRIENS,31.2),4),14,1)
.D GLENTRY($J($$GET1^DIQ(63,LRIENS,31.1),4),25)
.D GLENTRY($J($$GET1^DIQ(63,LRIENS,31.3),4),33)
.D GLENTRY($J($$GET1^DIQ(63,LRIENS,31.4),4),45)
I $D(^LR(LRDFN,"AW")) D
.D GLENTRY("","",1)
.F LRINC=1:1:8 D
..S LRTMP=$$GET1^DIQ(63,LRIENS,"25."_LRINC)
..Q:LRTMP=""
..D GLENTRY($$GET1^DID(63,"25."_LRINC,"","LABEL")_": "_LRTMP,"",1)
I $D(^LR(LRDFN,"AWI")) D
.D GLENTRY("","",1)
.F LRINC=1:1:5 D
..S LRNUM=$S(LRINC=1:25.9,1:25.9_(LRINC-1))
..S LRTMP=$$GET1^DIQ(63,LRIENS,LRNUM)
..Q:LRTMP=""
..D GLENTRY($$GET1^DID(63,LRNUM,"","LABEL")_": "_LRTMP,"",1)
Q
SPCSTD ;Display/store special studies
N LRARR,LRSPC,LRORGTS,LRIENS1,LRFLG,LRTEXT,LRCNT
D GLENTRY("","",1)
S (LRFLG,LRINC)=0
F S LRINC=$O(^LR(LRDFN,"AY",LRINC)) Q:'LRINC D
.S LRORGTS=$$GET1^DIQ(63.2,LRINC_","_LRIENS,".01:.01")
.S LRINC1=0
.F S LRINC1=$O(^LR(LRDFN,"AY",LRINC,5,LRINC1)) Q:'LRINC1 D
..S LRIENS1=LRINC1_","_LRINC_","_LRIENS
..D GETS^DIQ(63.26,LRIENS1,".01;.03","","LRARR")
..M LRSPC=LRARR(63.26,LRIENS1)
..S LRSPC(.02)=$$GET1^DIQ(63.26,LRIENS1,.02,"E")
..I 'LRFLG D
...D GLENTRY("","",1)
...D GLENTRY(LRORGTS,BTAB)
...S LRFLG=1
..S LRTEXT=LRSPC(.01)_" "_LRSPC(.03)_" Date: "_LRSPC(.02)
..D GLENTRY(LRTEXT,"",1)
..K ^UTILITY($J,"W"),LRTMP
..S X=$$GET1^DIQ(63.26,LRIENS1,1,"","LRTMP")
..S DIWR=IOM-10,DIWL=10,DIWF=""
..S X=+$$GET1^DID(63.27,1,"","SPECIFIER","LRDBERR")
..I $$GET1^DID(X,.01,"","SPECIFIER")["L" S DIWF="N"
..S LRCNT=0 F S LRCNT=$O(LRTMP(LRCNT)) Q:'LRCNT D
...S X=LRTMP(LRCNT) D ^DIWP
..S LRCNT=0 F S LRCNT=$O(^UTILITY($J,"W",DIWL,LRCNT)) Q:'LRCNT D
...D GLENTRY(^UTILITY($J,"W",DIWL,LRCNT,0),DIWL,1)
..K ^UTILITY($J,"W")
..D GLENTRY("","",1)
Q
JRNLREF ;Print journal references
N LRFL,LRM,LRN,LRTP,LRIENS1,LRIENS2,LRIENS3,LRFILE1,LRFILE3,LRFILE4
D GLENTRY(,,1)
S LRINC1=0,LRFILE=63.2
F S LRINC1=$O(^LR(LRDFN,"AY",LRINC1)) Q:'LRINC1 D
.S LRIENS1=LRINC1_","_LRIENS
.S LRTP=$$GET1^DIQ(LRFILE,LRIENS1,.01,"I")
.;Topography
.N LRN
.S LRFL=LRTP,LRFILE1=61 D JREFPRT
.;Morphology
.S LRFILE1=61.1,LRFILE3=+$$GET1^DID(LRFILE,4,"","SPECIFIER")
.S LRM=0 F S LRM=$O(^LR(LRDFN,"AY",LRINC1,2,LRM)) Q:'LRM D
..S LRIENS2=LRM_","_LRIENS1
..S LRFL=$$GET1^DIQ(LRFILE3,LRIENS2,.01,"I")
..D JREFPRT
..;Etiology
..S LRFILE1=61.2,LRFILE4=+$$GET1^DID(LRFILE3,1,"","SPECIFIER")
..S LRN=0 F S LRN=$O(^LR(LRDFN,"AY",LRINC1,2,LRM,1,LRN)) Q:'LRN D
...S LRIENS3=LRN_","_LRIENS2
...S LRFL=$$GET1^DIQ(LRFILE4,LRIENS3,.01,"I")
...D JREFPRT
.;Disease
.S LRFILE1=61.4,LRFILE3=+$$GET1^DID(LRFILE,3,"","SPECIFIER")
.S LRM=0 F S LRM=$O(^LR(LRDFN,"AY",LRINC1,1,LRM)) Q:'LRM D
..S LRIENS2=LRM_","_LRIENS1
..S LRFL=$$GET1^DIQ(LRFILE3,LRIENS2,.01,"I")
..D JREFPRT
.;Function
.S LRFILE1=61.3,LRFILE3=+$$GET1^DID(LRFILE,1,"","SPECIFIER")
.S LRM=0 F S LRM=$O(^LR(LRDFN,"AY",LRINC1,3,LRM)) Q:'LRM D
..S LRIENS2=LRM_","_LRIENS1
..S LRFL=$$GET1^DIQ(LRFILE3,LRIENS2,.01,"I")
..D JREFPRT
.S LRFILE1=61.5,LRFILE3=+$$GET1^DID(LRFILE,1.5,"","SPECIFIER")
.S LRM=0 F S LRM=$O(^LR(LRDFN,"AY",LRINC1,4,LRM)) Q:'LRM D
..S LRIENS2=LRM_","_LRIENS1
..S LRFL=$$GET1^DIQ(LRFILE3,LRIENS2,.01,"I")
..D JREFPRT
Q
JREFPRT ;
; Print journal reference on the patient report if the
; reference is flagged for printing.
N LRJR,LRINC
S LRFILE2=+$$GET1^DID(LRFILE1,5,"","SPECIFIER")
S LRJR=0 F S LRJR=$O(^LAB(LRFILE1,LRFL,"JR",LRJR)) Q:'LRJR D
.S LRJR(.01)=$$GET1^DIQ(LRFILE2,LRJR_","_LRFL_",",.01)
.F LRINC=1:1:5 D
..S LRJR(LRINC)=$$GET1^DIQ(LRFILE2,LRJR_","_LRFL_",",LRINC)
.S LRJR(6)=$$GET1^DIQ(LRFILE2,LRJR_","_LRFL_",",6,"I")
.Q:'LRJR(6)
.D GLENTRY(,,1),GLENTRY("Reference: ",,1)
.D GLENTRY(LRJR(.01),,1)
.D GLENTRY(LRJR(1),,1),GLENTRY(,,1)
.I LRJR(2)'="" D
..D GLENTRY(LRJR(2)_" vol."_LRJR(3),BTAB)
..D GLENTRY(" pg."_LRJR(4),BTAB)
.D GLENTRY(" Date: "_LRJR(5),BTAB)
Q
DIAGS ;
N LRV
D GLENTRY("","",1)
F LRV=81,82 D
.D GLENTRY("","",1)
.D:LRV=81 GLENTRY(LRAU(1),BTAB)
.D:LRV=82 GLENTRY(LRAU(2),BTAB)
.S LRFILE=63
.S LRFIELD=$S(LRV=81:32.2,1:32.3)
.D WP^LRAPBR4
.D GLENTRY("","",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),LRPR2=+$G(LRPR2),LRPR3=+$G(LRPR3)
D:LRPR3 NEWLN^LRAPUTL(LRPR1,LRPR2)
D:'LRPR3 GLBWRT^LRAPUTL(LRPR1,LRPR2)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRAPBR5 6941 printed Oct 16, 2024@18:07:49 Page 2
LRAPBR5 ;DALOI/WTY;AUTOPSY BROWSER DISPLAY/TIU STORAGE;6/5/2001
+1 ;;5.2;LAB SERVICE;**259**;Sep 27, 1994
+2 ;
+3 ;This routine was copied from ^LRAPT2. It was updated with FileMan
+4 ;DBS calls and modified to be used for browser display and storage
+5 ;of the SF515 in TIU.
+6 ;
MAIN ;
+1 NEW LRLLOC,LRDTDIED,LRTMP,LRNUM,LRINC,LRINC1
+2 SET LRQUIT=0
+3 if '$DATA(LRIENS)
SET LRIENS=LRDFN_","
+4 DO HEADER
+5 if LRQUIT
QUIT
+6 DO WEIGHTS
+7 DO SPCSTD
+8 DO JRNLREF
+9 if 'LRAU
DO DIAGS
+10 QUIT
+1 DO GLENTRY("","",1)
+2 DO GLENTRY(LRP,"",1)
+3 DO GLENTRY(SSN,32)
+4 DO GLENTRY("DOB: "_DOB,52)
+5 SET LR("F")=1
+6 IF 'LRTIU
IF '+$$GET1^DIQ(63,LRIENS,14.7,"I")
Begin DoDot:1
+7 DO GLENTRY("","",1)
+8 DO GLENTRY("Autopsy protocol report not verified.","",1)
+9 SET LRQUIT=1
End DoDot:1
QUIT
+10 SET LRLLOC=$$GET1^DIQ(63,LRIENS,14.5,"E")
+11 SET DA=LRDFN
DO D^LRAUAW
SET Y=LR(63,12)
DO D^LRU
SET LRDTDIED=Y
+12 DO GLENTRY("Acc: "_$$GET1^DIQ(63,LRIENS,14),"",1)
+13 DO GLENTRY("AUTOPSY DATA",32)
+14 DO GLENTRY("Age: "_$JUSTIFY($$GET1^DIQ(63,LRIENS,12.5),3),52)
+15 DO GLENTRY("Date/time Died","",1)
+16 DO GLENTRY("Date/time of Autopsy",52)
+17 DO GLENTRY(LRDTDIED,"",1)
+18 DO GLENTRY($EXTRACT($$GET1^DIQ(63,LRIENS,13.7,"E"),1,18),32)
+19 DO GLENTRY($$GET1^DIQ(63,LRIENS,11,"E"),52)
+20 DO GLENTRY("Resident: "_$$GET1^DIQ(63,LRIENS,13.5,"E"),"",1)
+21 DO GLENTRY("Senior: "_$EXTRACT($$GET1^DIQ(63,LRIENS,13.6,"E"),1,19),52)
+22 QUIT
WEIGHTS ;Display/Store Weights & Measures
+1 DO GLENTRY("","",1)
+2 IF $DATA(^LR(LRDFN,"AW"))
Begin DoDot:1
+3 SET LRTMP="Rt--Lung--Lt Liver Spleen Rt--Kidney--Lt Brain Body "
+4 SET LRTMP=LRTMP_"Wt(lb) Ht(in)"
+5 DO GLENTRY(LRTMP,"",1)
+6 DO GLENTRY($JUSTIFY($$GET1^DIQ(63,LRIENS,18),4),"",1)
+7 DO GLENTRY($JUSTIFY($$GET1^DIQ(63,LRIENS,19),4),8)
+8 DO GLENTRY($JUSTIFY($$GET1^DIQ(63,LRIENS,20),5),14)
+9 DO GLENTRY($JUSTIFY($$GET1^DIQ(63,LRIENS,21),5),21)
+10 DO GLENTRY($JUSTIFY($$GET1^DIQ(63,LRIENS,22),4),28)
+11 DO GLENTRY($JUSTIFY($$GET1^DIQ(63,LRIENS,23),4),38)
+12 DO GLENTRY($JUSTIFY($$GET1^DIQ(63,LRIENS,25),4),45)
+13 DO GLENTRY($$GET1^DIQ(63,LRIENS,17),55)
+14 DO GLENTRY($$GET1^DIQ(63,LRIENS,16),68)
End DoDot:1
+15 FOR LRINC=1:1:2
DO GLENTRY("","",1)
+16 if $DATA(^LR(LRDFN,"AW"))
DO GLENTRY("Heart(gm)",BTAB)
+17 IF $DATA(^LR(LRDFN,"AV"))
Begin DoDot:1
+18 DO GLENTRY("TV(cm) PV(cm) MV(cm) AV(cm) RV(cm) LV(cm)",12)
End DoDot:1
+19 DO GLENTRY("","",1)
+20 DO GLENTRY($JUSTIFY($$GET1^DIQ(63,LRIENS,24),5),BTAB)
+21 IF $DATA(^LR(LRDFN,"AV"))
Begin DoDot:1
+22 SET LRNUM=12
+23 FOR LRINC=26:1:31
Begin DoDot:2
+24 DO GLENTRY($JUSTIFY($$GET1^DIQ(63,LRIENS,LRINC),4),LRNUM)
+25 SET LRNUM=LRNUM+8
End DoDot:2
+26 DO GLENTRY("","",1)
+27 SET LRTMP="Cavities(ml): Rt--Pleural--Lt Pericardial Peritoneal"
+28 DO GLENTRY(LRTMP,"",1)
+29 DO GLENTRY($JUSTIFY($$GET1^DIQ(63,LRIENS,31.2),4),14,1)
+30 DO GLENTRY($JUSTIFY($$GET1^DIQ(63,LRIENS,31.1),4),25)
+31 DO GLENTRY($JUSTIFY($$GET1^DIQ(63,LRIENS,31.3),4),33)
+32 DO GLENTRY($JUSTIFY($$GET1^DIQ(63,LRIENS,31.4),4),45)
End DoDot:1
+33 IF $DATA(^LR(LRDFN,"AW"))
Begin DoDot:1
+34 DO GLENTRY("","",1)
+35 FOR LRINC=1:1:8
Begin DoDot:2
+36 SET LRTMP=$$GET1^DIQ(63,LRIENS,"25."_LRINC)
+37 if LRTMP=""
QUIT
+38 DO GLENTRY($$GET1^DID(63,"25."_LRINC,"","LABEL")_": "_LRTMP,"",1)
End DoDot:2
End DoDot:1
+39 IF $DATA(^LR(LRDFN,"AWI"))
Begin DoDot:1
+40 DO GLENTRY("","",1)
+41 FOR LRINC=1:1:5
Begin DoDot:2
+42 SET LRNUM=$SELECT(LRINC=1:25.9,1:25.9_(LRINC-1))
+43 SET LRTMP=$$GET1^DIQ(63,LRIENS,LRNUM)
+44 if LRTMP=""
QUIT
+45 DO GLENTRY($$GET1^DID(63,LRNUM,"","LABEL")_": "_LRTMP,"",1)
End DoDot:2
End DoDot:1
+46 QUIT
SPCSTD ;Display/store special studies
+1 NEW LRARR,LRSPC,LRORGTS,LRIENS1,LRFLG,LRTEXT,LRCNT
+2 DO GLENTRY("","",1)
+3 SET (LRFLG,LRINC)=0
+4 FOR
SET LRINC=$ORDER(^LR(LRDFN,"AY",LRINC))
if 'LRINC
QUIT
Begin DoDot:1
+5 SET LRORGTS=$$GET1^DIQ(63.2,LRINC_","_LRIENS,".01:.01")
+6 SET LRINC1=0
+7 FOR
SET LRINC1=$ORDER(^LR(LRDFN,"AY",LRINC,5,LRINC1))
if 'LRINC1
QUIT
Begin DoDot:2
+8 SET LRIENS1=LRINC1_","_LRINC_","_LRIENS
+9 DO GETS^DIQ(63.26,LRIENS1,".01;.03","","LRARR")
+10 MERGE LRSPC=LRARR(63.26,LRIENS1)
+11 SET LRSPC(.02)=$$GET1^DIQ(63.26,LRIENS1,.02,"E")
+12 IF 'LRFLG
Begin DoDot:3
+13 DO GLENTRY("","",1)
+14 DO GLENTRY(LRORGTS,BTAB)
+15 SET LRFLG=1
End DoDot:3
+16 SET LRTEXT=LRSPC(.01)_" "_LRSPC(.03)_" Date: "_LRSPC(.02)
+17 DO GLENTRY(LRTEXT,"",1)
+18 KILL ^UTILITY($JOB,"W"),LRTMP
+19 SET X=$$GET1^DIQ(63.26,LRIENS1,1,"","LRTMP")
+20 SET DIWR=IOM-10
SET DIWL=10
SET DIWF=""
+21 SET X=+$$GET1^DID(63.27,1,"","SPECIFIER","LRDBERR")
+22 IF $$GET1^DID(X,.01,"","SPECIFIER")["L"
SET DIWF="N"
+23 SET LRCNT=0
FOR
SET LRCNT=$ORDER(LRTMP(LRCNT))
if 'LRCNT
QUIT
Begin DoDot:3
+24 SET X=LRTMP(LRCNT)
DO ^DIWP
End DoDot:3
+25 SET LRCNT=0
FOR
SET LRCNT=$ORDER(^UTILITY($JOB,"W",DIWL,LRCNT))
if 'LRCNT
QUIT
Begin DoDot:3
+26 DO GLENTRY(^UTILITY($JOB,"W",DIWL,LRCNT,0),DIWL,1)
End DoDot:3
+27 KILL ^UTILITY($JOB,"W")
+28 DO GLENTRY("","",1)
End DoDot:2
End DoDot:1
+29 QUIT
JRNLREF ;Print journal references
+1 NEW LRFL,LRM,LRN,LRTP,LRIENS1,LRIENS2,LRIENS3,LRFILE1,LRFILE3,LRFILE4
+2 DO GLENTRY(,,1)
+3 SET LRINC1=0
SET LRFILE=63.2
+4 FOR
SET LRINC1=$ORDER(^LR(LRDFN,"AY",LRINC1))
if 'LRINC1
QUIT
Begin DoDot:1
+5 SET LRIENS1=LRINC1_","_LRIENS
+6 SET LRTP=$$GET1^DIQ(LRFILE,LRIENS1,.01,"I")
+7 ;Topography
+8 NEW LRN
+9 SET LRFL=LRTP
SET LRFILE1=61
DO JREFPRT
+10 ;Morphology
+11 SET LRFILE1=61.1
SET LRFILE3=+$$GET1^DID(LRFILE,4,"","SPECIFIER")
+12 SET LRM=0
FOR
SET LRM=$ORDER(^LR(LRDFN,"AY",LRINC1,2,LRM))
if 'LRM
QUIT
Begin DoDot:2
+13 SET LRIENS2=LRM_","_LRIENS1
+14 SET LRFL=$$GET1^DIQ(LRFILE3,LRIENS2,.01,"I")
+15 DO JREFPRT
+16 ;Etiology
+17 SET LRFILE1=61.2
SET LRFILE4=+$$GET1^DID(LRFILE3,1,"","SPECIFIER")
+18 SET LRN=0
FOR
SET LRN=$ORDER(^LR(LRDFN,"AY",LRINC1,2,LRM,1,LRN))
if 'LRN
QUIT
Begin DoDot:3
+19 SET LRIENS3=LRN_","_LRIENS2
+20 SET LRFL=$$GET1^DIQ(LRFILE4,LRIENS3,.01,"I")
+21 DO JREFPRT
End DoDot:3
End DoDot:2
+22 ;Disease
+23 SET LRFILE1=61.4
SET LRFILE3=+$$GET1^DID(LRFILE,3,"","SPECIFIER")
+24 SET LRM=0
FOR
SET LRM=$ORDER(^LR(LRDFN,"AY",LRINC1,1,LRM))
if 'LRM
QUIT
Begin DoDot:2
+25 SET LRIENS2=LRM_","_LRIENS1
+26 SET LRFL=$$GET1^DIQ(LRFILE3,LRIENS2,.01,"I")
+27 DO JREFPRT
End DoDot:2
+28 ;Function
+29 SET LRFILE1=61.3
SET LRFILE3=+$$GET1^DID(LRFILE,1,"","SPECIFIER")
+30 SET LRM=0
FOR
SET LRM=$ORDER(^LR(LRDFN,"AY",LRINC1,3,LRM))
if 'LRM
QUIT
Begin DoDot:2
+31 SET LRIENS2=LRM_","_LRIENS1
+32 SET LRFL=$$GET1^DIQ(LRFILE3,LRIENS2,.01,"I")
+33 DO JREFPRT
End DoDot:2
+34 SET LRFILE1=61.5
SET LRFILE3=+$$GET1^DID(LRFILE,1.5,"","SPECIFIER")
+35 SET LRM=0
FOR
SET LRM=$ORDER(^LR(LRDFN,"AY",LRINC1,4,LRM))
if 'LRM
QUIT
Begin DoDot:2
+36 SET LRIENS2=LRM_","_LRIENS1
+37 SET LRFL=$$GET1^DIQ(LRFILE3,LRIENS2,.01,"I")
+38 DO JREFPRT
End DoDot:2
End DoDot:1
+39 QUIT
JREFPRT ;
+1 ; Print journal reference on the patient report if the
+2 ; reference is flagged for printing.
+3 NEW LRJR,LRINC
+4 SET LRFILE2=+$$GET1^DID(LRFILE1,5,"","SPECIFIER")
+5 SET LRJR=0
FOR
SET LRJR=$ORDER(^LAB(LRFILE1,LRFL,"JR",LRJR))
if 'LRJR
QUIT
Begin DoDot:1
+6 SET LRJR(.01)=$$GET1^DIQ(LRFILE2,LRJR_","_LRFL_",",.01)
+7 FOR LRINC=1:1:5
Begin DoDot:2
+8 SET LRJR(LRINC)=$$GET1^DIQ(LRFILE2,LRJR_","_LRFL_",",LRINC)
End DoDot:2
+9 SET LRJR(6)=$$GET1^DIQ(LRFILE2,LRJR_","_LRFL_",",6,"I")
+10 if 'LRJR(6)
QUIT
+11 DO GLENTRY(,,1)
DO GLENTRY("Reference: ",,1)
+12 DO GLENTRY(LRJR(.01),,1)
+13 DO GLENTRY(LRJR(1),,1)
DO GLENTRY(,,1)
+14 IF LRJR(2)'=""
Begin DoDot:2
+15 DO GLENTRY(LRJR(2)_" vol."_LRJR(3),BTAB)
+16 DO GLENTRY(" pg."_LRJR(4),BTAB)
End DoDot:2
+17 DO GLENTRY(" Date: "_LRJR(5),BTAB)
End DoDot:1
+18 QUIT
DIAGS ;
+1 NEW LRV
+2 DO GLENTRY("","",1)
+3 FOR LRV=81,82
Begin DoDot:1
+4 DO GLENTRY("","",1)
+5 if LRV=81
DO GLENTRY(LRAU(1),BTAB)
+6 if LRV=82
DO GLENTRY(LRAU(2),BTAB)
+7 SET LRFILE=63
+8 SET LRFIELD=$SELECT(LRV=81:32.2,1:32.3)
+9 DO WP^LRAPBR4
+10 DO GLENTRY("","",1)
End DoDot:1
+11 QUIT
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)
SET LRPR2=+$GET(LRPR2)
SET LRPR3=+$GET(LRPR3)
+5 if LRPR3
DO NEWLN^LRAPUTL(LRPR1,LRPR2)
+6 if 'LRPR3
DO GLBWRT^LRAPUTL(LRPR1,LRPR2)
+7 QUIT
