LRAPBR3 ;VA/DALOI/WTY - AP Browser Print Cont.; 13-Aug-2013 09:16 ; MKK
;;5.2;LAB SERVICE;**259,1030,413,1033**;NOV 01, 1997
;
; This routine was created from LRSPRPT1 to be used for printing
; the SF515 to the browser and storing the report in a global format
; This routine displays any special studies. Printing of SNOMED
; codes and associated journal references (if any) has been removed.
MAIN ;
N LRTP,LRCNT1,LRA1,LRFILE,LRFILE1
N LRIENS1,LRA2
Q:$G(LRSF)=""
S LRA1=0,LRIENS=LRI_","_LRDFN_","
S LRFILE=+$$GET1^DID(LRSF,10,"","SPECIFIER")
F S LRA1=$O(^LR(LRDFN,LRSS,LRI,2,LRA1)) Q:'LRA1 D
.S LRIENS1=LRA1_","_LRIENS
.S LRTP(1)=$$GET1^DIQ(LRFILE,LRIENS1,.01)
.S LRTP(2)=$$GET1^DIQ(LRFILE,LRIENS1,.01,"I")
.S LRTP(8)=$$GET1^DIQ(LRFILE,LRIENS1,".01:2")
.D SPCSTD
.D JRNLREF
Q
SPCSTD ;Display Special Studies
Q:'$P($G(^LR(LRDFN,LRSS,LRI,2,LRA1,5,0)),"^",4)
D GLENTRY("SPECIAL STUDIES:","",1)
N LRX,DIWR,DIWL,LRC,LRTMP
S LRC=0 F S LRC=$O(^LR(LRDFN,LRSS,LRI,2,LRA1,5,LRC)) Q:'LRC D
.S LRFILE1=+$$GET1^DID(LRFILE,5,"","SPECIFIER")
.F I=.01:.01:.03 D
..S LRTP(I)=$$GET1^DIQ(LRFILE1,LRC_","_LRIENS1,I)
.D GLENTRY("","",1)
.D GLENTRY(LRTP(.01)_" "_LRTP(.03)_" Date: "_LRTP(.02),"",1)
.D GLENTRY(LRTP(1),"",1)
.K ^UTILITY($J,"W")
.S LRX=$$GET1^DIQ(LRFILE1,LRC_","_LRIENS1,1,"","LRTMP")
.S DIWR=IOM-10,DIWL=10,DIWF=""
.S LRX=+$$GET1^DID(LRFILE1,1,"","SPECIFIER")
.I $$GET1^DID(LRX,.01,"","SPECIFIER")["L" S DIWF="N"
.S LRA2=0 F S LRA2=$O(LRTMP(LRA2)) Q:'LRA2 S X=LRTMP(LRA2) D ^DIWP
.S LRA2=0 F S LRA2=$O(^UTILITY($J,"W",DIWL,LRA2)) Q:'LRA2 D
..D GLENTRY(^UTILITY($J,"W",DIWL,LRA2,0),DIWL,1)
.K ^UTILITY($J,"W")
Q
;
JRNLREF ;Display Journal References
;Topography
N LRFL,LRM,LRN
S LRFL=LRTP(2),LRFILE1=61 D JREFPRT
;Morphology
S LRFILE1=61.1,LRFILE3=+$$GET1^DID(LRFILE,4,"","SPECIFIER")
S LRM=0 F S LRM=$O(^LR(LRDFN,LRSS,LRI,2,LRA1,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,LRSS,LRI,2,LRA1,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,LRSS,LRI,2,LRA1,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,LRSS,LRI,2,LRA1,3,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
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 on 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
LRAPBR3 ;VA/DALOI/WTY - AP Browser Print Cont.; 13-Aug-2013 09:16 ; MKK
+1 ;;5.2;LAB SERVICE;**259,1030,413,1033**;NOV 01, 1997
+2 ;
+3 ; This routine was created from LRSPRPT1 to be used for printing
+4 ; the SF515 to the browser and storing the report in a global format
+5 ; This routine displays any special studies. Printing of SNOMED
+6 ; codes and associated journal references (if any) has been removed.
MAIN ;
+1 NEW LRTP,LRCNT1,LRA1,LRFILE,LRFILE1
+2 NEW LRIENS1,LRA2
+3 IF $GET(LRSF)=""
QUIT
+4 SET LRA1=0
SET LRIENS=LRI_","_LRDFN_","
+5 SET LRFILE=+$$GET1^DID(LRSF,10,"","SPECIFIER")
+6 FOR
SET LRA1=$ORDER(^LR(LRDFN,LRSS,LRI,2,LRA1))
IF 'LRA1
QUIT
Begin DoDot:1
+7 SET LRIENS1=LRA1_","_LRIENS
+8 SET LRTP(1)=$$GET1^DIQ(LRFILE,LRIENS1,.01)
+9 SET LRTP(2)=$$GET1^DIQ(LRFILE,LRIENS1,.01,"I")
+10 SET LRTP(8)=$$GET1^DIQ(LRFILE,LRIENS1,".01:2")
+11 DO SPCSTD
+12 DO JRNLREF
End DoDot:1
+13 QUIT
SPCSTD ;Display Special Studies
+1 IF '$PIECE($GET(^LR(LRDFN,LRSS,LRI,2,LRA1,5,0)),"^",4)
QUIT
+2 DO GLENTRY("SPECIAL STUDIES:","",1)
+3 NEW LRX,DIWR,DIWL,LRC,LRTMP
+4 SET LRC=0
FOR
SET LRC=$ORDER(^LR(LRDFN,LRSS,LRI,2,LRA1,5,LRC))
IF 'LRC
QUIT
Begin DoDot:1
+5 SET LRFILE1=+$$GET1^DID(LRFILE,5,"","SPECIFIER")
+6 FOR I=.01:.01:.03
Begin DoDot:2
+7 SET LRTP(I)=$$GET1^DIQ(LRFILE1,LRC_","_LRIENS1,I)
End DoDot:2
+8 DO GLENTRY("","",1)
+9 DO GLENTRY(LRTP(.01)_" "_LRTP(.03)_" Date: "_LRTP(.02),"",1)
+10 DO GLENTRY(LRTP(1),"",1)
+11 KILL ^UTILITY($JOB,"W")
+12 SET LRX=$$GET1^DIQ(LRFILE1,LRC_","_LRIENS1,1,"","LRTMP")
+13 SET DIWR=IOM-10
SET DIWL=10
SET DIWF=""
+14 SET LRX=+$$GET1^DID(LRFILE1,1,"","SPECIFIER")
+15 IF $$GET1^DID(LRX,.01,"","SPECIFIER")["L"
SET DIWF="N"
+16 SET LRA2=0
FOR
SET LRA2=$ORDER(LRTMP(LRA2))
IF 'LRA2
QUIT
SET X=LRTMP(LRA2)
DO ^DIWP
+17 SET LRA2=0
FOR
SET LRA2=$ORDER(^UTILITY($JOB,"W",DIWL,LRA2))
IF 'LRA2
QUIT
Begin DoDot:2
+18 DO GLENTRY(^UTILITY($JOB,"W",DIWL,LRA2,0),DIWL,1)
End DoDot:2
+19 KILL ^UTILITY($JOB,"W")
End DoDot:1
+20 QUIT
+21 ;
JRNLREF ;Display Journal References
+1 ;Topography
+2 NEW LRFL,LRM,LRN
+3 SET LRFL=LRTP(2)
SET LRFILE1=61
DO JREFPRT
+4 ;Morphology
+5 SET LRFILE1=61.1
SET LRFILE3=+$$GET1^DID(LRFILE,4,"","SPECIFIER")
+6 SET LRM=0
FOR
SET LRM=$ORDER(^LR(LRDFN,LRSS,LRI,2,LRA1,2,LRM))
IF 'LRM
QUIT
Begin DoDot:1
+7 SET LRIENS2=LRM_","_LRIENS1
+8 SET LRFL=$$GET1^DIQ(LRFILE3,LRIENS2,.01,"I")
+9 DO JREFPRT
+10 ;Etiology
+11 SET LRFILE1=61.2
SET LRFILE4=+$$GET1^DID(LRFILE3,1,"","SPECIFIER")
+12 SET LRN=0
FOR
SET LRN=$ORDER(^LR(LRDFN,LRSS,LRI,2,LRA1,2,LRM,1,LRN))
IF 'LRN
QUIT
Begin DoDot:2
+13 SET LRIENS3=LRN_","_LRIENS2
+14 SET LRFL=$$GET1^DIQ(LRFILE4,LRIENS3,.01,"I")
+15 DO JREFPRT
End DoDot:2
End DoDot:1
+16 ;Disease
+17 SET LRFILE1=61.4
SET LRFILE3=+$$GET1^DID(LRFILE,3,"","SPECIFIER")
+18 SET LRM=0
FOR
SET LRM=$ORDER(^LR(LRDFN,LRSS,LRI,2,LRA1,1,LRM))
IF 'LRM
QUIT
Begin DoDot:1
+19 SET LRIENS2=LRM_","_LRIENS1
+20 SET LRFL=$$GET1^DIQ(LRFILE3,LRIENS2,.01,"I")
+21 DO JREFPRT
End DoDot:1
+22 ;Function
+23 SET LRFILE1=61.3
SET LRFILE3=+$$GET1^DID(LRFILE,1,"","SPECIFIER")
+24 SET LRM=0
FOR
SET LRM=$ORDER(^LR(LRDFN,LRSS,LRI,2,LRA1,3,LRM))
IF 'LRM
QUIT
Begin DoDot:1
+25 SET LRIENS2=LRM_","_LRIENS1
+26 SET LRFL=$$GET1^DIQ(LRFILE3,LRIENS2,.01,"I")
+27 DO JREFPRT
End DoDot:1
+28 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
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 on 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
