LRAPQAM.m

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 ---LRAPQAM   1019     printed  Apr 09, 2024@21:07:32                                                                                                                                                                                                     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