1 | LA7SSR ;DALISC/SED - ORDERS STATUS REPORT ;6/5/97 14:00
|
---|
2 | ;;5.2;LAB MESSAGING;**27**;Sep 27, 1994
|
---|
3 | EN ;SELECT THE CRITERIA TO REPORT ON
|
---|
4 | K ^TMP($J),DIRUT
|
---|
5 | STAT S LRMSG="Statuses " D ALL G:$D(DIRUT) EXIT
|
---|
6 | K DIRUT,^TMP($J,"S"),DIR
|
---|
7 | I +Y'>0 D
|
---|
8 | .F Q:$D(DIRUT) D
|
---|
9 | ..S DIR(0)="PAO^64.061:EMZ",DIR("A")="Select Status: "
|
---|
10 | ..S DIR("?")="Select the status to be included on the report."
|
---|
11 | ..S DIR("S")="I $P(^(0),U,7)=""U"",('$D(^TMP($J,""S"",+Y)))"
|
---|
12 | ..D ^DIR
|
---|
13 | ..Q:$D(DIRUT)
|
---|
14 | ..S ^TMP($J,"S",+Y)=""
|
---|
15 | SITE S LRMSG="Collection Sites " D ALL G:$D(DIRUT) STAT
|
---|
16 | K DIR,DIRUT,^TMP($J,"C")
|
---|
17 | I +Y'>0 D
|
---|
18 | .F Q:$D(DIRUT) D
|
---|
19 | ..S DIR(0)="PAO^4:EMZ",DIR("A")="Select Collection Site: "
|
---|
20 | ..S DIR("?")="Select the Collection Site to be included on the report."
|
---|
21 | ..S DIR("S")="I '$D(^TMP($J,""C"",+Y))"
|
---|
22 | ..D ^DIR
|
---|
23 | ..Q:$D(DIRUT)
|
---|
24 | ..S ^TMP($J,"C",+Y)=""
|
---|
25 | MAN S LRMSG="Shipping Manifests" D ALL G:$D(DIRUT) SITE
|
---|
26 | K DIR,DIROUT,DUOUT,DIRUT,^TMP($J,"M")
|
---|
27 | I +Y'>0 D
|
---|
28 | .K Y F Q:$D(DIRUT) D
|
---|
29 | ..S NDX=0 K ^TMP($J,"LRI")
|
---|
30 | ..S LRI=0 F S LRI=$O(^LRO(69.6,"AD",LRI)) Q:+LRI'>0!$D(DIRUT) D
|
---|
31 | ...Q:$D(^TMP($J,"M",LRI))
|
---|
32 | ...S NDX=NDX+1
|
---|
33 | ...W !,$J(NDX,3),". ",LRI
|
---|
34 | ...S ^TMP($J,"LRI",NDX)=LRI
|
---|
35 | ...I NDX>1,NDX#20=0 D SEL(NDX)
|
---|
36 | ..I '$D(DIRUT) D SEL(NDX)
|
---|
37 | K ^TMP($J,"LRI")
|
---|
38 | PRINT ;
|
---|
39 | S L=0,DIC="69.6",FLDS="[CAPTIONED]",BY="[LA7S EXEP SORT]"
|
---|
40 | S DHD="Lab Order Status Report",DIS(0)="D CHECK^LA7SSR I +LRI"
|
---|
41 | D EN1^DIP
|
---|
42 | EXIT ;EXIT
|
---|
43 | K ^TMP($J),DIR,LRI,DIRUT,LRMSG,NDX,X,Y,DIC
|
---|
44 | Q
|
---|
45 | ALL S DIR(0)="Y",DIR("B")="YES",DIR("A")="Include All "_LRMSG
|
---|
46 | S DIR("?")="Enter (Y)es or return for all entries on the report."
|
---|
47 | D ^DIR
|
---|
48 | Q
|
---|
49 | SEL(N) ;MAKE A SELECTION
|
---|
50 | K DTOUT,DUOUT,DIROUT
|
---|
51 | W ! S DIR(0)="NOA^1:"_N_":0"
|
---|
52 | S DIR("A")="Select Shipping Manifest 1 - "_N_": " D ^DIR
|
---|
53 | I +Y S ^TMP($J,"M",$G(^TMP($J,"LRI",Y)))=""
|
---|
54 | Q
|
---|
55 | CHECK ;ENTER HERE TO SCREEN THE ENTRIES
|
---|
56 | S LRI=1
|
---|
57 | I $D(^TMP($J,"S")) D
|
---|
58 | .S LRTST=0 F S LRTST=$O(^LRO(69.6,D0,2,LRTST)) Q:+LRTST'>0 D
|
---|
59 | ..S LRST=$P(^LRO(69.6,D0,2,LRTST,0),U,6)
|
---|
60 | ..I +$G(LRST)'>0 S LRI=0 Q
|
---|
61 | ..S:'$D(^TMP($J,"S",LRST)) LRI=0
|
---|
62 | I $D(^TMP($J,"C")),(LRI=1),+$P(^LRO(69.6,D0,0),U,5)'="",'$D(^TMP($J,"C",+$P(^LRO(69.6,D0,0),U,5))) S LRI=0
|
---|
63 | I $D(^TMP($J,"M")),(LRI=1),$P(^LRO(69.6,D0,0),U,14)'="",'$D(^TMP($J,"M",$P(^LRO(69.6,D0,0),U,14))) S LRI=0
|
---|
64 | Q
|
---|