| 1 | LRWU1 ;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 | ;
|
|---|
| 12 | URGG W !,"For ",$P(LRSTIK(LRSSX),U,2) D URG^LRORD2 Q
|
|---|
| 13 | MICRO 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
|
|---|
| 20 | TIME ;
|
|---|
| 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'["."
|
|---|
| 36 | TE K %DT
|
|---|
| 37 | Q
|
|---|
| 38 | PRAC ;
|
|---|
| 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:"")
|
|---|
| 48 | P1 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
|
|---|
| 51 | P ;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
|
|---|
| 61 | QUIT S LREND=1 Q
|
|---|
