| [613] | 1 | LRAPP ;AVAMC/REG/KLL - AP PRINT ;10/18/01
|
|---|
| 2 | ;;5.2;LAB SERVICE;**72,259**;Sep 27, 1994
|
|---|
| 3 | N LRSF515
|
|---|
| 4 | S LRSF515=1
|
|---|
| 5 | D @LRAPX(0),END
|
|---|
| 6 | Q
|
|---|
| 7 | ;
|
|---|
| 8 | P ;Print All On Queue
|
|---|
| 9 | N LRFOC S LRFOC=0
|
|---|
| 10 | D A G:'$D(Y) END
|
|---|
| 11 | S LRAPX=4
|
|---|
| 12 | I LRSS'="AU",X=2 D FOC
|
|---|
| 13 | I LRSS="AU",X=1 D FOC
|
|---|
| 14 | G LRAPP
|
|---|
| 15 | D ;Delete Print Queue
|
|---|
| 16 | D A G:'$D(Y) END
|
|---|
| 17 | S LRAPX=2
|
|---|
| 18 | G LRAPP
|
|---|
| 19 | S ;Print Single Report
|
|---|
| 20 | N LRFOC S LRFOC=0
|
|---|
| 21 | D A G:'$D(Y) END
|
|---|
| 22 | S LRAPX=3
|
|---|
| 23 | I LRSS'="AU",X=2 D FOC
|
|---|
| 24 | I LRSS="AU",X=1 D FOC
|
|---|
| 25 | G LRAPP
|
|---|
| 26 | N ;Add Pt To Print Queue
|
|---|
| 27 | D A G:'$D(Y) END
|
|---|
| 28 | S LRAPX=1
|
|---|
| 29 | G LRAPP
|
|---|
| 30 | T ;AP Accessions By Date
|
|---|
| 31 | D ^LRAP G:'$D(Y) END
|
|---|
| 32 | D ^LRUPAD,END
|
|---|
| 33 | Q
|
|---|
| 34 | B ;AP Accessions By Number
|
|---|
| 35 | D ^LRAP G:'$D(Y) END
|
|---|
| 36 | D ^LRUPA,END
|
|---|
| 37 | Q
|
|---|
| 38 | A ;
|
|---|
| 39 | W ! D ^LRAP
|
|---|
| 40 | G:'$D(Y) END
|
|---|
| 41 | I LRSS="AU" D PS Q
|
|---|
| 42 | C ;Path Reports (SP,CY,EM)
|
|---|
| 43 | W !!?16,"1. Preliminary reports",!?16,"2. Final",?31,"reports"
|
|---|
| 44 | R !,"Select 1 or 2 : ",X:DTIME
|
|---|
| 45 | G:X=""!(X[U) END
|
|---|
| 46 | I X<1!(X>2) D G C
|
|---|
| 47 | .W $C(7),!!,"Enter '1' for preliminary reports or '2' for final "
|
|---|
| 48 | .W "reports"
|
|---|
| 49 | S LRAPX(0)=$S(X=1:"^LRSPT",1:"^LRSPRPT")
|
|---|
| 50 | Q
|
|---|
| 51 | PS ;Autopsy Reports
|
|---|
| 52 | W !!?15,"1. Autopsy protocols"
|
|---|
| 53 | W !?15,"2. Autopsy supplementary reports",!,"Select 1 or 2: "
|
|---|
| 54 | R X:DTIME G:X=""!(X[U) END
|
|---|
| 55 | I X<1!(X>2) D G PS
|
|---|
| 56 | .W $C(7),!!,"Enter '1' for autopsy protocols or '2' for autopsy "
|
|---|
| 57 | .W "supplementary reports"
|
|---|
| 58 | S LRAPX(0)=$S(X=1:"^LRAURPT",1:"^LRAPAUSR")
|
|---|
| 59 | Q
|
|---|
| 60 | FOC ;Final Office Copy
|
|---|
| 61 | W !
|
|---|
| 62 | K DIR
|
|---|
| 63 | S DIR(0)="Y",DIR("A")="Is this a final office copy"
|
|---|
| 64 | S DIR("B")="YES"
|
|---|
| 65 | S DIR("?",1)="SNOMED codes no longer appear on the report. The final"
|
|---|
| 66 | S DIR("?",1)=DIR("?",1)_" office copy prints"
|
|---|
| 67 | S DIR("?")="these codes on a separate page. Enter 'Yes' to include "
|
|---|
| 68 | S DIR("?")=DIR("?")_"this page."
|
|---|
| 69 | D ^DIR
|
|---|
| 70 | I Y S LRFOC=1
|
|---|
| 71 | Q
|
|---|
| 72 | END D V^LRU
|
|---|
| 73 | Q
|
|---|
