- LRAPQAM ;AVAMC/REG/WTY - PRINT PATH MICRO MODIFICATIONS ;9/25/00
- ;;5.2T9;LR;**58,72,248,1018**;Nov 17, 2004
- ;
- 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
- LRAPQAM ;AVAMC/REG/WTY - PRINT PATH MICRO MODIFICATIONS ;9/25/00
- +1 ;;5.2T9;LR;**58,72,248,1018**;Nov 17, 2004
- +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
