source: WorldVistAEHR/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7SSR.m@ 846

Last change on this file since 846 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.2 KB
RevLine 
[613]1LA7SSR ;DALISC/SED - ORDERS STATUS REPORT ;6/5/97 14:00
2 ;;5.2;LAB MESSAGING;**27**;Sep 27, 1994
3EN ;SELECT THE CRITERIA TO REPORT ON
4 K ^TMP($J),DIRUT
5STAT 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)=""
15SITE 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)=""
25MAN 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")
38PRINT ;
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
42EXIT ;EXIT
43 K ^TMP($J),DIR,LRI,DIRUT,LRMSG,NDX,X,Y,DIC
44 Q
45ALL 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
49SEL(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
55CHECK ;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
Note: See TracBrowser for help on using the repository browser.