source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRWU1.m@ 836

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

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1LRWU1 ;DALOI/RWF/WTY - ORDERING/ACCESSION UTILITIES;12/08/04
2 ;;5.2;LAB SERVICE;**153,272,291**;Sep 27, 1994
3 ; Reference to ^DIC supported by IA #10007
4 ; Reference to ^%DT supported by IA #10003
5 ; Reference to YN^DICN supported by IA #10009
6 ; Reference to INP^VADPT supported by IA #10061
7 ; Reference to ^VA(200 supported by IA #10060
8 ; Reference to $$ORESKEY^ORWDBA1 supported by IA #4569
9 ; Reference to ^XUSEC("PROVIDER" supported by IA #10076
10 ; Reference to $$ACTIVE^XUSER supported by IA #2343
11 ;
12URGG W !,"For ",$P(LRSTIK(LRSSX),U,2) D URG^LRORD2 Q
13MICRO W !,"Is there one sample for this patient's order" S %=1 D YN^DICN I %=2!(%=-1) Q
14 I %=0 W !,"The collection sample and site/specimen will be used for all tests ordered",!,"at this time for this patient." G MICRO
15 D GSNO^LRORD3 Q:LREND
16 I +LRSAMP=-1&(LRSPEC=-1) W !,"Incompletely defined." G MICRO
17 S LRSAME=LRSAMP_U_LRSPEC
18 S LRECOM=0 D GCOM^LRORD2
19 Q
20TIME ;
21 N LRMSG
22 S %DT="ET" R !,"Collection Date@Time: NOW//",X:DTIME
23 I '$T!(X="^") S LRCDT=-1 G TE
24 S:X="" X="N"
25 I X["?" D
26 .S LRMSG="You may enter ""T@U"" or just ""U"", for Today at Unknown "
27 .S LRMSG=LRMSG_"time."
28 .W !!,LRMSG,!!
29 I X["@U",$P(X,"@U",2)="" D G TIME:Y<1 Q
30 .S X=$P(X,"@U",1) D ^%DT
31 .Q:Y<1
32 .S LRCDT=+Y_"^1"
33 .D TE
34 S:X="U" LRCDT=DT_"^1",Y=DT
35 I X'="U" D ^%DT G TIME:X["?" S LRCDT=+Y_"^" G TIME:Y'["."
36TE K %DT
37 Q
38PRAC ;
39 I $G(LRORDRR)="R" D Q
40 . S LRPRAC="REF:"_+LRRSITE("RSITE")
41 N %
42 D:'$D(LRPARAM) ^LRPARAM K DIC S LREND=0,(VA200,DIC("B"))=""
43 S DFN=$P(^LR(LRDFN,0),U,3) S LRDPF=$P(^LR(LRDFN,0),U,2)
44 I LRDPF=2,$L($G(VAIN(2))) S DIC("B")=$P(VAIN(2),U)
45 I LRDPF=2,'$D(VAIN(2)) D
46 . N I,Y,X,N D INP^VADPT S (DIC("B"),LRPRAC)=$P(VAIN(2),U)
47 I $D(LRLABKY),'DIC("B"),$P(LRPARAM,U,16) S DIC("B")=$S($D(^LR(LRDFN,.2)):+^(.2),1:"")
48P1 I $D(^VA(200,+DIC("B"),0))#2 S:'$D(^VA(200,"AK.PROVIDER",$P($G(^VA(200,+DIC("B"),0)),U))) DIC("B")=""
49 S DIC("B")=$P($G(^VA(200,+DIC("B"),0)),U) D P S:Y>0 (^LR(LRDFN,.2),LRPRAC)=+Y
50 Q
51P ;Prompt for PROVIDER
52 S DIC="^VA(200,",DIC(0)="AMNEQ",LRPRAC=""
53 S DIC("S")="I $D(^VA(200,""AK.PROVIDER"",$P(^(0),U))),"
54 S DIC("S")=DIC("S")_"$$ACTIVE^XUSER(Y),"
55 S DIC("S")=DIC("S")_"$D(^XUSEC(""PROVIDER"",Y))"
56 S DIC("A")="PROVIDER: ",D="AK.PROVIDER"
57 S DIC("W")="Q" D ^DIC K DIC
58 I Y<0 D QUIT Q
59 S LRPRAC=+Y
60 Q
61QUIT S LREND=1 Q
Note: See TracBrowser for help on using the repository browser.