LRAPQAM ;AVAMC/REG/WTY - PRINT PATH MICRO MODIFICATIONS ;9/25/00
;;5.2;LAB SERVICE;**58,72,248**;Sep 27, 1994
;
S LRDICS="SPCYEM" D ^LRAP G:'$D(Y) END D B^LRU G:Y<0 END
S LRSDT=LRSDT-.01,LRLDT=LRLDT+.99
S ZTRTN="QUE^LRAPQAM" D BEG^LRUTL G:POP!($D(ZTSK)) END
QUE U IO S LRA=1,LR("DIWF")="W"
D XR^LRU,L^LRU,S^LRU,L1^LRU,EN2^LRUA,SET^LRUA
F LRX=0:0 S LRSDT=$O(^LR(LRXR,LRSDT)) Q:'LRSDT!(LRSDT>LRLDT) D
.F LRDFN=0:0 S LRDFN=$O(^LR(LRXR,LRSDT,LRDFN)) Q:'LRDFN!(LR("Q")) D L
W:'$D(LRSAV) !,"No modifications to print" D END^LRUTL,END Q
L F LRI=0:0 S LRI=$O(^LR(LRXR,LRSDT,LRDFN,LRI)) Q:'LRI!(LR("Q")) D
.I $D(^LR(LRDFN,LRSS,LRI,4))!($D(^(5)))!($D(^(6)))!($D(^(7))) D W Q
.;Check for supplementary report changes
.I $D(^LR(LRDFN,LRSS,LRI,1.2)) D
..S LRFLG=0
..F I=0:0 S I=$O(^LR(LRDFN,LRSS,LRI,1.2,I)) Q:'I!(LR("Q"))!(LRFLG) D
...I $D(^LR(LRDFN,LRSS,LRI,1.2,I,2)) S LRFLG=1
..I LRFLG D W K LRFLG
Q
W S (LRQ(9),LRS(99))=1,LRAP=LRDFN_"^"_LRI,LRSAV=1 D EN^LRSPRPT
Q
;
END D V^LRU Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRAPQAM 1019 printed Nov 22, 2024@17:18:03 Page 2
LRAPQAM ;AVAMC/REG/WTY - PRINT PATH MICRO MODIFICATIONS ;9/25/00
+1 ;;5.2;LAB SERVICE;**58,72,248**;Sep 27, 1994
+2 ;
+3 SET LRDICS="SPCYEM"
DO ^LRAP
if '$DATA(Y)
GOTO END
DO B^LRU
if Y<0
GOTO END
+4 SET LRSDT=LRSDT-.01
SET LRLDT=LRLDT+.99
+5 SET ZTRTN="QUE^LRAPQAM"
DO BEG^LRUTL
if POP!($DATA(ZTSK))
GOTO END
QUE USE IO
SET LRA=1
SET LR("DIWF")="W"
+1 DO XR^LRU
DO L^LRU
DO S^LRU
DO L1^LRU
DO EN2^LRUA
DO SET^LRUA
+2 FOR LRX=0:0
SET LRSDT=$ORDER(^LR(LRXR,LRSDT))
if 'LRSDT!(LRSDT>LRLDT)
QUIT
Begin DoDot:1
+3 FOR LRDFN=0:0
SET LRDFN=$ORDER(^LR(LRXR,LRSDT,LRDFN))
if 'LRDFN!(LR("Q"))
QUIT
DO L
End DoDot:1
+4 if '$DATA(LRSAV)
WRITE !,"No modifications to print"
DO END^LRUTL
DO END
QUIT
L FOR LRI=0:0
SET LRI=$ORDER(^LR(LRXR,LRSDT,LRDFN,LRI))
if 'LRI!(LR("Q"))
QUIT
Begin DoDot:1
+1 IF $DATA(^LR(LRDFN,LRSS,LRI,4))!($DATA(^(5)))!($DATA(^(6)))!($DATA(^(7)))
DO W
QUIT
+2 ;Check for supplementary report changes
+3 IF $DATA(^LR(LRDFN,LRSS,LRI,1.2))
Begin DoDot:2
+4 SET LRFLG=0
+5 FOR I=0:0
SET I=$ORDER(^LR(LRDFN,LRSS,LRI,1.2,I))
if 'I!(LR("Q"))!(LRFLG)
QUIT
Begin DoDot:3
+6 IF $DATA(^LR(LRDFN,LRSS,LRI,1.2,I,2))
SET LRFLG=1
End DoDot:3
+7 IF LRFLG
DO W
KILL LRFLG
End DoDot:2
End DoDot:1
+8 QUIT
W SET (LRQ(9),LRS(99))=1
SET LRAP=LRDFN_"^"_LRI
SET LRSAV=1
DO EN^LRSPRPT
+1 QUIT
+2 ;
END DO V^LRU
QUIT
