LRAPMOD ;AVAMC/REG/WTY/KLL - PRINT PATH MICRO MODIFICATIONS ;9/22/00
;;5.2;LAB SERVICE;**72,248,259,413**;Sep 27, 1994;Build 2
;
;Reference to ^%DT supported by IA #10003
;
;If ESIG Switch turned ON, print from TIU if found,
; otherwise print from LR.
N LRESSW
D GETDATA^LRAPESON(.LRESSW)
I +$G(LRESSW) D TIUPRT,END Q
;Print from LR
S LRDICS="AUSPCYEM" D ^LRAP G:'$D(Y) END
W !!?15,LRO(68),!!?15,"Print pathology report modifications",!!
GETP D EN2^LRUA,EN1^LRUPS
G:LRAN["?" GETP
I LRAN=-1 D END Q
S FLGMOD=1
LRPRT I LRSS'="AU" D
.S:($D(^LR(LRDFN,LRSS,LRI,4))!($D(^(5)))!($D(^(6)))!($D(^(7)))) FLGMOD=0
I FLGMOD D K LRFILE
.S LRFILE=$S(LRSS="AU":"^LR(LRDFN,84",1:"^LR(LRDFN,LRSS,LRI,1.2")
.I $D(@(LRFILE_")")) D
..F A=0:0 S A=$O(@(LRFILE_",A)")) Q:'A!('FLGMOD) D
...S:$D(@(LRFILE_",A,2)")) FLGMOD=0
I FLGMOD W $C(7),!!?5,"No modifications to print." G END
K FLGMOD
S (LRQ(9),LRSAV)=1,LRAP=LRDFN
I LRSS'="AU" D G DEV^LRSPRPT
.S LRAP=LRAP_"^"_LRI,LRS(99)=1
S X="T",%DT="" D ^%DT,D^LRU S LRH(3)=Y,LRFLG=1
G DEV^LRAPAUSR
TIUPRT ;Print from TIU
N LRPTR,LREL,LRDATA
S (LRQUIT,LRCONT,LRPTR2)=0
S LRDICS="AUSPCYEM" D ^LRAP G:'$D(Y) END
W !!?15,LRO(68),!!?5,"Print All AP Reports for an Accession from TIU",!!
D ACCYR^LRAPMRL
I LRQUIT D END Q
S LRAU=0
I LRSS="AU" S LRAU=1
D LOOKUP^LRAPUTL(.LRDATA,LRH(0),LRO(68),LRSS,LRAD,LRAA)
Q:'LRDATA!(LRDATA=-1)
S FLGMOD=1
S LRDFN=LRDATA,LRI=LRDATA(1)
S LRIENS=LRI_","_LRDFN_","
;Check for release date
I LRSS'="AU" S LREL=$$GET1^DIQ(LRSF,LRIENS,.11,"I")
I LRSS="AU" S LREL=$$GET1^DIQ(63,LRDFN_",",14.7,"I")
I 'LREL D
.S DIR(0)="Y",DIR("B")="YES",DIR("A")="CONTINUE?"
.S DIR("A",1)="Report not verified. Check for and print"
.S DIR("A",2)=" previous versions?"
.D ^DIR
.I Y=0 S LRQUIT=1
I LRQUIT D END Q
I 'LREL D
.D GETPREV
.;No previous versions found, retrieve from LR?
.I '+$G(LRPTR) D
..S DIR(0)="Y",DIR("B")="YES",DIR("A")="CONTINUE?"
..S DIR("A",1)="No previous versions found in TIU."
..S DIR("A",2)=" Print from LR?"
..D ^DIR
..I Y=0 S LRQUIT=1
..I Y=1 S LRCONT=1
G:LRCONT GETP
I LRQUIT D END Q
;Release date found, check TIU
I LREL D
.D TIUCHK^LRAPUTL(.LRPTR,LRDFN,LRSS,LRI)
.I '+$G(LRPTR) D
..S DIR(0)="Y",DIR("B")="YES",DIR("A")="CONTINUE?"
..S DIR("A",1)="Report not found in TIU."
..S DIR("A",2)=" Print from LR?"
..D ^DIR
..I Y=0 S LRQUIT=1
..I Y=1 S LRCONT=1
I LRQUIT D END Q
G:LRCONT GETP
;Found in TIU, print from TIU
I +$G(LRPTR) D
.S LRPTR2=1
.W !
.S %ZIS="Q" D ^%ZIS
.I POP W ! D END Q
.I $D(IO("Q")) D Q
..S ZTDESC="Print Anat Path Reports"
..S ZTSAVE("LR*")="",ZTRTN="PRTRPT^LRAPMOD"
..D ^%ZTLOAD W:$D(ZTSK) !,"Request Queued, #",ZTSK W !
..K ZTSK,IO("Q") D HOME^%ZIS
.D PRTRPT
D ^%ZISC
;Allow print of LR even if stored in TIU
I LRPTR2=1 D
.S DIR(0)="Y",DIR("B")="YES",DIR("A")="CONTINUE?"
.S DIR("A",1)="Print a copy from LR in addition to TIU print?"
.D ^DIR
.I Y=0 S LRQUIT=1
.I Y=1 S LRCONT=1,LRPTR=0
Q:LRQUIT
G:LRCONT GETP
Q
PRTRPT ;Print from TIU
N LRSAVPTR
U IO
F D Q:'LRPTR!(LRQUIT)
.S LRSAVPTR=LRPTR
.D MAIN^LRAPTIUP(LRPTR,0)
.S LRPTR=$$GET1^DIQ(8925,LRSAVPTR,1406,"I")
Q
GETPREV ;
I LRSS="AU" D
.S LRROOT="^LR(LRDFN,101,""A"")",LRIENS=LRDFN_","
.S LRFILE=63.101
I LRSS'="AU" D
.S LRROOT="^LR(LRDFN,LRSS,LRI,.05,""A"")"
.S LRIENS=LRI_","_LRDFN_","
.S LRFILE=$S(LRSS="SP":63.19,LRSS="CY":63.47,LRSS="EM":63.49,1:"")
S LRTREC=$O(@(LRROOT),-1)
I LRFILE=""!(LRTREC="") S LRPTR=0 Q
S LRIENS=LRTREC_","_LRIENS
S LRPTR=+$$GET1^DIQ(LRFILE,LRIENS,1,"I")
I '+$G(LRPTR) D
.W $C(7),"Report not found in TIU",!
.S LRQUIT=1
Q
END ;
D V^LRU
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRAPMOD 3756 printed Dec 13, 2024@02:07:41 Page 2
LRAPMOD ;AVAMC/REG/WTY/KLL - PRINT PATH MICRO MODIFICATIONS ;9/22/00
+1 ;;5.2;LAB SERVICE;**72,248,259,413**;Sep 27, 1994;Build 2
+2 ;
+3 ;Reference to ^%DT supported by IA #10003
+4 ;
+5 ;If ESIG Switch turned ON, print from TIU if found,
+6 ; otherwise print from LR.
+7 NEW LRESSW
+8 DO GETDATA^LRAPESON(.LRESSW)
+9 IF +$GET(LRESSW)
DO TIUPRT
DO END
QUIT
+10 ;Print from LR
+11 SET LRDICS="AUSPCYEM"
DO ^LRAP
if '$DATA(Y)
GOTO END
+12 WRITE !!?15,LRO(68),!!?15,"Print pathology report modifications",!!
GETP DO EN2^LRUA
DO EN1^LRUPS
+1 if LRAN["?"
GOTO GETP
+2 IF LRAN=-1
DO END
QUIT
+3 SET FLGMOD=1
LRPRT IF LRSS'="AU"
Begin DoDot:1
+1 if ($DATA(^LR(LRDFN,LRSS,LRI,4))!($DATA(^(5)))!($DATA(^(6)))!($DATA(^(7))))
SET FLGMOD=0
End DoDot:1
+2 IF FLGMOD
Begin DoDot:1
+3 SET LRFILE=$SELECT(LRSS="AU":"^LR(LRDFN,84",1:"^LR(LRDFN,LRSS,LRI,1.2")
+4 IF $DATA(@(LRFILE_")"))
Begin DoDot:2
+5 FOR A=0:0
SET A=$ORDER(@(LRFILE_",A)"))
if 'A!('FLGMOD)
QUIT
Begin DoDot:3
+6 if $DATA(@(LRFILE_",A,2)"))
SET FLGMOD=0
End DoDot:3
End DoDot:2
End DoDot:1
KILL LRFILE
+7 IF FLGMOD
WRITE $CHAR(7),!!?5,"No modifications to print."
GOTO END
+8 KILL FLGMOD
+9 SET (LRQ(9),LRSAV)=1
SET LRAP=LRDFN
+10 IF LRSS'="AU"
Begin DoDot:1
+11 SET LRAP=LRAP_"^"_LRI
SET LRS(99)=1
End DoDot:1
GOTO DEV^LRSPRPT
+12 SET X="T"
SET %DT=""
DO ^%DT
DO D^LRU
SET LRH(3)=Y
SET LRFLG=1
+13 GOTO DEV^LRAPAUSR
TIUPRT ;Print from TIU
+1 NEW LRPTR,LREL,LRDATA
+2 SET (LRQUIT,LRCONT,LRPTR2)=0
+3 SET LRDICS="AUSPCYEM"
DO ^LRAP
if '$DATA(Y)
GOTO END
+4 WRITE !!?15,LRO(68),!!?5,"Print All AP Reports for an Accession from TIU",!!
+5 DO ACCYR^LRAPMRL
+6 IF LRQUIT
DO END
QUIT
+7 SET LRAU=0
+8 IF LRSS="AU"
SET LRAU=1
+9 DO LOOKUP^LRAPUTL(.LRDATA,LRH(0),LRO(68),LRSS,LRAD,LRAA)
+10 if 'LRDATA!(LRDATA=-1)
QUIT
+11 SET FLGMOD=1
+12 SET LRDFN=LRDATA
SET LRI=LRDATA(1)
+13 SET LRIENS=LRI_","_LRDFN_","
+14 ;Check for release date
+15 IF LRSS'="AU"
SET LREL=$$GET1^DIQ(LRSF,LRIENS,.11,"I")
+16 IF LRSS="AU"
SET LREL=$$GET1^DIQ(63,LRDFN_",",14.7,"I")
+17 IF 'LREL
Begin DoDot:1
+18 SET DIR(0)="Y"
SET DIR("B")="YES"
SET DIR("A")="CONTINUE?"
+19 SET DIR("A",1)="Report not verified. Check for and print"
+20 SET DIR("A",2)=" previous versions?"
+21 DO ^DIR
+22 IF Y=0
SET LRQUIT=1
End DoDot:1
+23 IF LRQUIT
DO END
QUIT
+24 IF 'LREL
Begin DoDot:1
+25 DO GETPREV
+26 ;No previous versions found, retrieve from LR?
+27 IF '+$GET(LRPTR)
Begin DoDot:2
+28 SET DIR(0)="Y"
SET DIR("B")="YES"
SET DIR("A")="CONTINUE?"
+29 SET DIR("A",1)="No previous versions found in TIU."
+30 SET DIR("A",2)=" Print from LR?"
+31 DO ^DIR
+32 IF Y=0
SET LRQUIT=1
+33 IF Y=1
SET LRCONT=1
End DoDot:2
End DoDot:1
+34 if LRCONT
GOTO GETP
+35 IF LRQUIT
DO END
QUIT
+36 ;Release date found, check TIU
+37 IF LREL
Begin DoDot:1
+38 DO TIUCHK^LRAPUTL(.LRPTR,LRDFN,LRSS,LRI)
+39 IF '+$GET(LRPTR)
Begin DoDot:2
+40 SET DIR(0)="Y"
SET DIR("B")="YES"
SET DIR("A")="CONTINUE?"
+41 SET DIR("A",1)="Report not found in TIU."
+42 SET DIR("A",2)=" Print from LR?"
+43 DO ^DIR
+44 IF Y=0
SET LRQUIT=1
+45 IF Y=1
SET LRCONT=1
End DoDot:2
End DoDot:1
+46 IF LRQUIT
DO END
QUIT
+47 if LRCONT
GOTO GETP
+48 ;Found in TIU, print from TIU
+49 IF +$GET(LRPTR)
Begin DoDot:1
+50 SET LRPTR2=1
+51 WRITE !
+52 SET %ZIS="Q"
DO ^%ZIS
+53 IF POP
WRITE !
DO END
QUIT
+54 IF $DATA(IO("Q"))
Begin DoDot:2
+55 SET ZTDESC="Print Anat Path Reports"
+56 SET ZTSAVE("LR*")=""
SET ZTRTN="PRTRPT^LRAPMOD"
+57 DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE !,"Request Queued, #",ZTSK
WRITE !
+58 KILL ZTSK,IO("Q")
DO HOME^%ZIS
End DoDot:2
QUIT
+59 DO PRTRPT
End DoDot:1
+60 DO ^%ZISC
+61 ;Allow print of LR even if stored in TIU
+62 IF LRPTR2=1
Begin DoDot:1
+63 SET DIR(0)="Y"
SET DIR("B")="YES"
SET DIR("A")="CONTINUE?"
+64 SET DIR("A",1)="Print a copy from LR in addition to TIU print?"
+65 DO ^DIR
+66 IF Y=0
SET LRQUIT=1
+67 IF Y=1
SET LRCONT=1
SET LRPTR=0
End DoDot:1
+68 if LRQUIT
QUIT
+69 if LRCONT
GOTO GETP
+70 QUIT
PRTRPT ;Print from TIU
+1 NEW LRSAVPTR
+2 USE IO
+3 FOR
Begin DoDot:1
+4 SET LRSAVPTR=LRPTR
+5 DO MAIN^LRAPTIUP(LRPTR,0)
+6 SET LRPTR=$$GET1^DIQ(8925,LRSAVPTR,1406,"I")
End DoDot:1
if 'LRPTR!(LRQUIT)
QUIT
+7 QUIT
GETPREV ;
+1 IF LRSS="AU"
Begin DoDot:1
+2 SET LRROOT="^LR(LRDFN,101,""A"")"
SET LRIENS=LRDFN_","
+3 SET LRFILE=63.101
End DoDot:1
+4 IF LRSS'="AU"
Begin DoDot:1
+5 SET LRROOT="^LR(LRDFN,LRSS,LRI,.05,""A"")"
+6 SET LRIENS=LRI_","_LRDFN_","
+7 SET LRFILE=$SELECT(LRSS="SP":63.19,LRSS="CY":63.47,LRSS="EM":63.49,1:"")
End DoDot:1
+8 SET LRTREC=$ORDER(@(LRROOT),-1)
+9 IF LRFILE=""!(LRTREC="")
SET LRPTR=0
QUIT
+10 SET LRIENS=LRTREC_","_LRIENS
+11 SET LRPTR=+$$GET1^DIQ(LRFILE,LRIENS,1,"I")
+12 IF '+$GET(LRPTR)
Begin DoDot:1
+13 WRITE $CHAR(7),"Report not found in TIU",!
+14 SET LRQUIT=1
End DoDot:1
+15 QUIT
END ;
+1 DO V^LRU
+2 QUIT
