source: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRAPMOD.m@ 636

LRAPMOD ;AVAMC/REG/WTY/KLL - PRINT PATH MICRO MODIFICATIONS ;9/22/00
 ;;5.2;LAB SERVICE;**72,248,259**;Sep 27, 1994
 ;
 ;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
 U IO
 F  D  Q:'LRPTR!(LRQUIT)
 .D MAIN^LRAPTIUP(LRPTR,0)
 .S LRPTR=$$GET1^DIQ(8925,LRPTR,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