source: WorldVistAEHR/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7SMPXL.m@ 862

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

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1LA7SMPXL ;DALOI/JMC - PRINT SHIPPING MANIFEST FROM PENDING ORDERS FILE ; 12/3/1997
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**27,42,46,64**;Sep 27, 1994
3EN ;
4 ;
5 N D,DIC,LA7SM,X,Y,%ZIS
6 ;
7 S DIC=69.6,DIC(0)="AQEZNM",DIC("A")="Select Shipping Manifest: ",D="D"
8 S DIC("S")="I $L($P(^(0),U,14))"
9 D MIX^DIC1 K DIC("S")
10 I Y<1 D END Q
11 ;
12 S LA7SMAN=$P(Y(0),U,14)
13 ;
14 S %ZIS="MQ"
15 D ^%ZIS
16 I POP D Q
17 . D HOME^%ZIS
18 . D END
19 ;
20 I $D(IO("Q")) D Q
21 . S ZTRTN="DQ^LA7SMPXL",ZTDESC="Shipping Manifest Reprint",ZTSAVE("LA7*")=""
22 . D ^%ZTLOAD,HOME^%ZIS
23 . D EN^DDIOL("Request "_$S($G(ZTSK):"queued - Task #"_ZTSK,1:"NOT queued"),"","!")
24 . D END
25 ;
26DQ ; Tasked entry point
27 ;
28 U IO
29 ;
30 S DT=$$DT^XLFDT
31 S LRDPF=69.6,LA7NOW=$$HTE^XLFDT($H,"1M")
32 S (LA7DC,LA7EXIT,LA7PAGE,LA7SCOND,LA7SCONT)=0
33 S LA7SCFG=0,LA7SCFG(0)=""
34 S LA7LINE="",$P(LA7LINE,"-",IOM)="",LA7SVIA="Electronic manifest"
35 ;
36 ; Check manifest for missing info.
37 S LA7CHK=0
38 ; Flag to print receipt.
39 S LA7SMR="0^0"
40 ; Set barcode flag
41 S LA7SBC=0
42 I IOST["P-" S LA7SBC=2
43 ; Shipping status flag
44 S LA7SMST="0^Electronic Manifest"
45 ;
46 S (LA7696,LA7QUIT)=0,LA7UID=""
47 S LA7SM="^"_LA7SMAN
48 S LA7ROOT="^LRO(69.6,""AD"",LA7SMAN)"
49 F LA7ITEM=1:1 S LA7ROOT=$Q(@LA7ROOT) D Q:LA7EXIT
50 . I $QS(LA7ROOT,3)'=LA7SMAN S LA7EXIT=1
51 . I LA7EXIT Q
52 . I LA7UID'="",LA7UID'=$QS(LA7ROOT,4) W !,LA7LINE
53 . S LA7696=$QS(LA7ROOT,5)
54 . D SETUP
55 . I ($Y+12)>IOSL!('LA7PAGE) D Q:LA7EXIT
56 . . I LA7PAGE W ! D WARN^LA7SMP0
57 . . D HED^LA7SMP0
58 . D SH^LA7SMP0
59 . I $D(LA7CMT) D CMT^LA7SMP0
60 . W !,?18,$E(LA7LINE,1,31)
61 . S LA76964=0
62 . F S LA76964=$O(^LRO(69.6,LA7696,2,LA76964)) Q:LA76964<1 D
63 . . S LA76964(0)=$G(^LRO(69.6,LA7696,2,LA76964,0))
64 . . W !?18,$P(LA76964(0),"^",3),?50,$P(LA7SPEC(0),"^")
65 . . W !,?20,"VA NLT code [Name]: "
66 . . S LA7NLT=$P(LA76964(0),"^",2)
67 . . W $S($L(LA7NLT):LA7NLT,1:"*** None specified ***")
68 . . S LA7NLTN=$P(LA76964(0),"^")
69 . . I LA7NLTN'="" W:($X+$L($P(LA76964(0),"^",2))+3)>IOM !,?39 W " [",LA7NLTN,"]"
70 . . I $P(LA76964(0),"^",9)'="" W !,?20,"Host site UID: ",$P(LA76964(0),"^",9)
71 ;
72 D END
73 Q
74 ;
75 ;
76SETUP ; Setup variables for this order
77 ;
78 N I,X
79 ;
80 F I=0,1 S LA7696(I)=$G(^LRO(69.6,LA7696,I))
81 ;
82 S PNM=$P(LA7696(0),U),SEX=$P(LA7696(0),U,2),DOB=$P(LA7696(0),U,3)
83 S (SSN,SSN(2))=$P(LA7696(0),U,9)
84 ;
85 S LA7ACC=$P(LA7696(0),"^",12)
86 S LA7UID=$P(LA7696(0),"^",6)
87 S LA7SPEC=+$P(LA7696(0),"^",7),LA7SPEC(0)=$G(^LAB(61,LA7SPEC,0))
88 S LA7CDT=$P(LA7696(1),U,2)
89 S LA7SDT=$P(LA7696(1),U,5)
90 ;
91 ; Get collecting site and host site info
92 D GETSITE^LA7SMP($P(LA7696(0),U,5),DUZ(2),.LA7FSITE,.LA7TSITE)
93 ;
94 ; Ordering provider
95 S I=0,LA7PROV=""
96 F S I=$O(^LRO(69.6,LA7696,2,I)) Q:'I D Q:LA7PROV'=""
97 . S X=$P($G(^LRO(69.6,LA7696,2,I,1)),"^")
98 . I X'="" S $P(LA7PROV,"^",2)=$P(X,"[")
99 I LA7PROV="" S LA7PROV="^REF:"_LA7FSITE(99)
100 ;
101 ; Get shipping date
102 S LA7SDT=$$FMTE^XLFDT($P(LA7696(1),"^",3),"")
103 ;
104 ; Check for comments
105 K LA7CMT
106 I $D(^LRO(69.6,LA7696,99,0)) D
107 . N DIWF,DIWL,DIWR,LA7ERR,X
108 . S LA7CMT=$$GET1^DIQ(69.6,LA7696_",",99,"","LA7CMT","LA7ERR(2)")
109 . K ^UTILITY($J,"W")
110 . S DIWL=1,DIWR=IOM-13,DIWF=""
111 . I $$GET1^DID(+$$GET1^DID(69.6,99,"","SPECIFIER","LA7ERR(1)"),.01,"","SPECIFIER","LA7ERR(3)")["L" S DIWF="N"
112 . S LA7I=$O(LA7CMT(0)),LA7CMT(LA7I)="COMMENTS: "_LA7CMT(LA7I),LA7I=0
113 . F S LA7I=$O(LA7CMT(LA7I)) Q:'LA7I S X=LA7CMT(LA7I) D ^DIWP
114 . K LA7CMT
115 . M LA7CMT=^UTILITY($J,"W",DIWL)
116 . K ^UTILITY($J,"W")
117 ;
118 ; Add local (host) status info
119 S LA7CMT=$G(LA7CMT)+1
120 I LA7CMT>1 S LA7CMT(LA7CMT,0)=" ",LA7CMT=LA7CMT+1
121 S LA7CMT(LA7CMT,0)="Host test status: "_$$GET1^DIQ(69.6,LA7696_",",6,"",,"LA7ERR(4)")
122 Q
123 ;
124 ;
125END ;
126 S LA7EXIT=1
127 D END^LA7SMP0
128 K LA7696,LA76964,LA7CMT,LA7SMAN
129 ;
130 Q
Note: See TracBrowser for help on using the repository browser.