LRAPP ;DALOI/STAFF - AP PRINT ;05/29/09 12:47
;;5.2;LAB SERVICE;**72,259,350**;Sep 27, 1994;Build 230
;
N LRSF515
S LRSF515=1
D @LRAPX(0),END
Q
;
;
P ; Print All On Queue
N LRFOC S LRFOC=0
D A G:'$D(Y) END
S LRAPX=4
I LRSS'="AU",X=2 D FOC
I LRSS="AU",X=1 D FOC
G LRAPP
;
;
D ; Delete Print Queue
D A G:'$D(Y) END
S LRAPX=2
G LRAPP
;
;
S ; Print Single Report
N LRFOC S LRFOC=0
D A G:'$D(Y) END
S LRAPX=3
I LRSS'="AU",X=2 D FOC
I LRSS="AU",X=1 D FOC
S:'$D(LRABV) LRABV=0
G LRAPP
;
;
N ; Add Pt To Print Queue
D A G:'$D(Y) END
S LRAPX=1
G LRAPP
;
;
T ; AP Accessions By Date
D ^LRAP G:'$D(Y) END
D ^LRUPAD,END
Q
;
;
B ; AP Accessions By Number
D ^LRAP G:'$D(Y) END
D ^LRUPA,END
Q
;
;
A ;
W ! D ^LRAP
G:'$D(Y) END
I LRSS="AU" D PS Q
;
C ; Path Reports (SP,CY,EM)
W !!?16,"1. Preliminary reports",!?16,"2. Final",?31,"reports"
R !,"Select 1 or 2 : ",X:DTIME
G:X=""!(X[U) END
I X<1!(X>2) D G C
. W $C(7),!!,"Enter '1' for preliminary reports or '2' for final "
. W "reports"
S LRAPX(0)=$S(X=1:"^LRSPT",1:"^LRSPRPT")
Q
;
;
PS ; Autopsy Reports
W !!?15,"1. Autopsy protocols"
W !?15,"2. Autopsy supplementary reports",!,"Select 1 or 2: "
R X:DTIME G:X=""!(X[U) END
I X<1!(X>2) D G PS
. W $C(7),!!,"Enter '1' for autopsy protocols or '2' for autopsy "
. W "supplementary reports"
S LRAPX(0)=$S(X=1:"^LRAURPT",1:"^LRAPAUSR")
Q
;
;
FOC ; Final Office Copy
;
N DIR,DIRUT,DTOUT,DUOUT,X,Y
;
W !
S DIR(0)="Y",DIR("A")="Is this a final office copy",DIR("B")="YES"
S DIR("?",1)="SNOMED codes no longer appear on the report. The final office copy prints"
S DIR("?")="these codes on a separate page. Enter 'Yes' to include this page."
D ^DIR
I Y S LRFOC=1
Q
;
;
END ;
D V^LRU
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRAPP 1843 printed Oct 16, 2024@18:08:32 Page 2
LRAPP ;DALOI/STAFF - AP PRINT ;05/29/09 12:47
+1 ;;5.2;LAB SERVICE;**72,259,350**;Sep 27, 1994;Build 230
+2 ;
+3 NEW LRSF515
+4 SET LRSF515=1
+5 DO @LRAPX(0)
DO END
+6 QUIT
+7 ;
+8 ;
P ; Print All On Queue
+1 NEW LRFOC
SET LRFOC=0
+2 DO A
if '$DATA(Y)
GOTO END
+3 SET LRAPX=4
+4 IF LRSS'="AU"
IF X=2
DO FOC
+5 IF LRSS="AU"
IF X=1
DO FOC
+6 GOTO LRAPP
+7 ;
+8 ;
D ; Delete Print Queue
+1 DO A
if '$DATA(Y)
GOTO END
+2 SET LRAPX=2
+3 GOTO LRAPP
+4 ;
+5 ;
S ; Print Single Report
+1 NEW LRFOC
SET LRFOC=0
+2 DO A
if '$DATA(Y)
GOTO END
+3 SET LRAPX=3
+4 IF LRSS'="AU"
IF X=2
DO FOC
+5 IF LRSS="AU"
IF X=1
DO FOC
+6 if '$DATA(LRABV)
SET LRABV=0
+7 GOTO LRAPP
+8 ;
+9 ;
N ; Add Pt To Print Queue
+1 DO A
if '$DATA(Y)
GOTO END
+2 SET LRAPX=1
+3 GOTO LRAPP
+4 ;
+5 ;
T ; AP Accessions By Date
+1 DO ^LRAP
if '$DATA(Y)
GOTO END
+2 DO ^LRUPAD
DO END
+3 QUIT
+4 ;
+5 ;
B ; AP Accessions By Number
+1 DO ^LRAP
if '$DATA(Y)
GOTO END
+2 DO ^LRUPA
DO END
+3 QUIT
+4 ;
+5 ;
A ;
+1 WRITE !
DO ^LRAP
+2 if '$DATA(Y)
GOTO END
+3 IF LRSS="AU"
DO PS
QUIT
+4 ;
C ; Path Reports (SP,CY,EM)
+1 WRITE !!?16,"1. Preliminary reports",!?16,"2. Final",?31,"reports"
+2 READ !,"Select 1 or 2 : ",X:DTIME
+3 if X=""!(X[U)
GOTO END
+4 IF X<1!(X>2)
Begin DoDot:1
+5 WRITE $CHAR(7),!!,"Enter '1' for preliminary reports or '2' for final "
+6 WRITE "reports"
End DoDot:1
GOTO C
+7 SET LRAPX(0)=$SELECT(X=1:"^LRSPT",1:"^LRSPRPT")
+8 QUIT
+9 ;
+10 ;
PS ; Autopsy Reports
+1 WRITE !!?15,"1. Autopsy protocols"
+2 WRITE !?15,"2. Autopsy supplementary reports",!,"Select 1 or 2: "
+3 READ X:DTIME
if X=""!(X[U)
GOTO END
+4 IF X<1!(X>2)
Begin DoDot:1
+5 WRITE $CHAR(7),!!,"Enter '1' for autopsy protocols or '2' for autopsy "
+6 WRITE "supplementary reports"
End DoDot:1
GOTO PS
+7 SET LRAPX(0)=$SELECT(X=1:"^LRAURPT",1:"^LRAPAUSR")
+8 QUIT
+9 ;
+10 ;
FOC ; Final Office Copy
+1 ;
+2 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+3 ;
+4 WRITE !
+5 SET DIR(0)="Y"
SET DIR("A")="Is this a final office copy"
SET DIR("B")="YES"
+6 SET DIR("?",1)="SNOMED codes no longer appear on the report. The final office copy prints"
+7 SET DIR("?")="these codes on a separate page. Enter 'Yes' to include this page."
+8 DO ^DIR
+9 IF Y
SET LRFOC=1
+10 QUIT
+11 ;
+12 ;
END ;
+1 DO V^LRU
+2 QUIT
