LRAPMOD.m

LRAPMOD ;AVAMC/REG/WTY/KLL - PRINT PATH MICRO MODIFICATIONS ; 13-Aug-2013 09:16 ; MKK

 ;;5.2;LAB SERVICE;**72,1002,248,1018,259,1030,413,1033**;NOV 01, 1997

 ;

 ;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

LRAPMOD   ;AVAMC/REG/WTY/KLL - PRINT PATH MICRO MODIFICATIONS ; 13-Aug-2013 09:16 ; MKK

 +1       ;;5.2;LAB SERVICE;**72,1002,248,1018,259,1030,413,1033**;NOV 01, 1997

 +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