- LRAPP ;AVAMC/REG/KLL - AP PRINT ;10/18/01
- ;;5.2;LAB SERVICE;**1030**;NOV 01, 1997
- ;;5.2;LAB SERVICE;**72,259**;Sep 27, 1994
- 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
- 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
- W !
- K DIR
- S DIR(0)="Y",DIR("A")="Is this a final office copy"
- S DIR("B")="YES"
- S DIR("?",1)="SNOMED codes no longer appear on the report. The final"
- S DIR("?",1)=DIR("?",1)_" office copy prints"
- S DIR("?")="these codes on a separate page. Enter 'Yes' to include "
- S DIR("?")=DIR("?")_"this page."
- D ^DIR
- I Y S LRFOC=1
- Q
- END D V^LRU
- Q
- LRAPP ;AVAMC/REG/KLL - AP PRINT ;10/18/01
- +1 ;;5.2;LAB SERVICE;**1030**;NOV 01, 1997
- +2 ;;5.2;LAB SERVICE;**72,259**;Sep 27, 1994
- +3 NEW LRSF515
- +4 SET LRSF515=1
- +5 DO @LRAPX(0)
- DO END
- +6 QUIT
- +7 ;
- 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
- D ;Delete Print Queue
- +1 DO A
- IF '$DATA(Y)
- GOTO END
- +2 SET LRAPX=2
- +3 GOTO LRAPP
- 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 GOTO LRAPP
- N ;Add Pt To Print Queue
- +1 DO A
- IF '$DATA(Y)
- GOTO END
- +2 SET LRAPX=1
- +3 GOTO LRAPP
- T ;AP Accessions By Date
- +1 DO ^LRAP
- IF '$DATA(Y)
- GOTO END
- +2 DO ^LRUPAD
- DO END
- +3 QUIT
- B ;AP Accessions By Number
- +1 DO ^LRAP
- IF '$DATA(Y)
- GOTO END
- +2 DO ^LRUPA
- DO END
- +3 QUIT
- A ;
- +1 WRITE !
- DO ^LRAP
- +2 IF '$DATA(Y)
- GOTO END
- +3 IF LRSS="AU"
- DO PS
- QUIT
- 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
- 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
- FOC ;Final Office Copy
- +1 WRITE !
- +2 KILL DIR
- +3 SET DIR(0)="Y"
- SET DIR("A")="Is this a final office copy"
- +4 SET DIR("B")="YES"
- +5 SET DIR("?",1)="SNOMED codes no longer appear on the report. The final"
- +6 SET DIR("?",1)=DIR("?",1)_" office copy prints"
- +7 SET DIR("?")="these codes on a separate page. Enter 'Yes' to include "
- +8 SET DIR("?")=DIR("?")_"this page."
- +9 DO ^DIR
- +10 IF Y
- SET LRFOC=1
- +11 QUIT
- END DO V^LRU
- +1 QUIT
