LRWU1 ;DALOI/RWF/WTY - ORDERING/ACCESSION UTILITIES;12/08/04
;;5.2;LAB SERVICE;**1018,1020,1031**;NOV 1, 1997
;
;;VA LR Patch(s): 153,272,291
;
; Reference to ^DIC supported by IA #10007
; Reference to ^%DT supported by IA #10003
; Reference to YN^DICN supported by IA #10009
; Reference to INP^VADPT supported by IA #10061
; Reference to ^VA(200 supported by IA #10060
; Reference to $$ORESKEY^ORWDBA1 supported by IA #4569
; Reference to ^XUSEC("PROVIDER" supported by IA #10076
; Reference to $$ACTIVE^XUSER supported by IA #2343
;
; NOTE: LR*5.2*1031 restores LR*5.2*1018 & LR*5.2*1020 modifications
;
URGG W !,"For ",$P(LRSTIK(LRSSX),U,2) D URG^LRORD2 Q
MICRO W !,"Is there one sample for this patient's order" S %=1 D YN^DICN I %=2!(%=-1) Q
I %=0 W !,"The collection sample and site/specimen will be used for all tests ordered",!,"at this time for this patient." G MICRO
D GSNO^LRORD3 Q:LREND
I +LRSAMP=-1&(LRSPEC=-1) W !,"Incompletely defined." G MICRO
S LRSAME=LRSAMP_U_LRSPEC
S LRECOM=0 D GCOM^LRORD2
Q
TIME ;
N LRMSG
S %DT="ET" R !,"Collection Date@Time: NOW//",X:DTIME
I '$T!(X="^") S LRCDT=-1 G TE
S:X="" X="N"
I X["?" D
.S LRMSG="You may enter ""T@U"" or just ""U"", for Today at Unknown "
.S LRMSG=LRMSG_"time."
.W !!,LRMSG,!!
I X["@U",$P(X,"@U",2)="" D G TIME:Y<1 Q
.S X=$P(X,"@U",1) D ^%DT
.Q:Y<1
.S LRCDT=+Y_"^1"
.D TE
S:X="U" LRCDT=DT_"^1",Y=DT
I X'="U" D ^%DT G TIME:X["?" S LRCDT=+Y_"^" G TIME:Y'["."
TE K %DT
Q
PRAC ;
I $G(LRORDRR)="R" D Q
. S LRPRAC="REF:"_+LRRSITE("RSITE")
N %
D:'$D(LRPARAM) ^LRPARAM K DIC S LREND=0,(VA200,DIC("B"))=""
S DFN=$P(^LR(LRDFN,0),U,3) S LRDPF=$P(^LR(LRDFN,0),U,2)
I LRDPF=2,$L($G(VAIN(2))) S DIC("B")=$P(VAIN(2),U)
I LRDPF=2,'$D(VAIN(2)) D
. ; N I,Y,X,N D INP^VADPT S (DIC("B"),LRPRAC)=$P(VAIN(2),U)
. ;
. ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018
. N I,Y,X,N D @$S($$ISPIMS^BLRUTIL:"INP^VADPT",1:"INP^BLRDPT") S (DIC("B"),LRPRAC)=$P(VAIN(2),U)
. ;----- END IHS MODIFICATIONS
. ;
I $D(LRLABKY),'DIC("B"),$P(LRPARAM,U,16) S DIC("B")=$S($D(^LR(LRDFN,.2)):+^(.2),1:"")
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")=""
S DIC("B")=$P($G(^VA(200,+DIC("B"),0)),U) D P S:Y>0 (^LR(LRDFN,.2),LRPRAC)=+Y
Q
P ;Prompt for PROVIDER
S DIC="^VA(200,",DIC(0)="AMNEQ",LRPRAC=""
S DIC("S")="I $D(^VA(200,""AK.PROVIDER"",$P(^(0),U))),"
;
; S DIC("S")=DIC("S")_"$$ACTIVE^XUSER(Y),"
;
;----- BEGIN IHS/OIT/MKK MODIFICATIONS LR*5.2*1020 - Use IHS Version of $$ACTIVE
S DIC("S")=DIC("S")_"$$ACTIVE^BLRUTIL2(Y),"
;----- END IHS/OIT/MKK MODIFICATIONS LR*5.2*1020
;
S DIC("S")=DIC("S")_"$D(^XUSEC(""PROVIDER"",Y))"
S DIC("A")="PROVIDER: ",D="AK.PROVIDER"
S DIC("W")="Q" D ^DIC K DIC
I Y<0 D QUIT Q
S LRPRAC=+Y
Q
QUIT S LREND=1 Q
LRWU1 ;DALOI/RWF/WTY - ORDERING/ACCESSION UTILITIES;12/08/04
+1 ;;5.2;LAB SERVICE;**1018,1020,1031**;NOV 1, 1997
+2 ;
+3 ;;VA LR Patch(s): 153,272,291
+4 ;
+5 ; Reference to ^DIC supported by IA #10007
+6 ; Reference to ^%DT supported by IA #10003
+7 ; Reference to YN^DICN supported by IA #10009
+8 ; Reference to INP^VADPT supported by IA #10061
+9 ; Reference to ^VA(200 supported by IA #10060
+10 ; Reference to $$ORESKEY^ORWDBA1 supported by IA #4569
+11 ; Reference to ^XUSEC("PROVIDER" supported by IA #10076
+12 ; Reference to $$ACTIVE^XUSER supported by IA #2343
+13 ;
+14 ; NOTE: LR*5.2*1031 restores LR*5.2*1018 & LR*5.2*1020 modifications
+15 ;
URGG WRITE !,"For ",$PIECE(LRSTIK(LRSSX),U,2)
DO URG^LRORD2
QUIT
MICRO WRITE !,"Is there one sample for this patient's order"
SET %=1
DO YN^DICN
IF %=2!(%=-1)
QUIT
+1 IF %=0
WRITE !,"The collection sample and site/specimen will be used for all tests ordered",!,"at this time for this patient."
GOTO MICRO
+2 DO GSNO^LRORD3
IF LREND
QUIT
+3 IF +LRSAMP=-1&(LRSPEC=-1)
WRITE !,"Incompletely defined."
GOTO MICRO
+4 SET LRSAME=LRSAMP_U_LRSPEC
+5 SET LRECOM=0
DO GCOM^LRORD2
+6 QUIT
TIME ;
+1 NEW LRMSG
+2 SET %DT="ET"
READ !,"Collection Date@Time: NOW//",X:DTIME
+3 IF '$TEST!(X="^")
SET LRCDT=-1
GOTO TE
+4 IF X=""
SET X="N"
+5 IF X["?"
Begin DoDot:1
+6 SET LRMSG="You may enter ""T@U"" or just ""U"", for Today at Unknown "
+7 SET LRMSG=LRMSG_"time."
+8 WRITE !!,LRMSG,!!
End DoDot:1
+9 IF X["@U"
IF $PIECE(X,"@U",2)=""
Begin DoDot:1
+10 SET X=$PIECE(X,"@U",1)
DO ^%DT
+11 IF Y<1
QUIT
+12 SET LRCDT=+Y_"^1"
+13 DO TE
End DoDot:1
IF Y<1
GOTO TIME
QUIT
+14 IF X="U"
SET LRCDT=DT_"^1"
SET Y=DT
+15 IF X'="U"
DO ^%DT
IF X["?"
GOTO TIME
SET LRCDT=+Y_"^"
IF Y'["."
GOTO TIME
TE KILL %DT
+1 QUIT
PRAC ;
+1 IF $GET(LRORDRR)="R"
Begin DoDot:1
+2 SET LRPRAC="REF:"_+LRRSITE("RSITE")
End DoDot:1
QUIT
+3 NEW %
+4 IF '$DATA(LRPARAM)
DO ^LRPARAM
KILL DIC
SET LREND=0
SET (VA200,DIC("B"))=""
+5 SET DFN=$PIECE(^LR(LRDFN,0),U,3)
SET LRDPF=$PIECE(^LR(LRDFN,0),U,2)
+6 IF LRDPF=2
IF $LENGTH($GET(VAIN(2)))
SET DIC("B")=$PIECE(VAIN(2),U)
+7 IF LRDPF=2
IF '$DATA(VAIN(2))
Begin DoDot:1
+8 ; N I,Y,X,N D INP^VADPT S (DIC("B"),LRPRAC)=$P(VAIN(2),U)
+9 ;
+10 ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018
+11 NEW I,Y,X,N
DO @$SELECT($$ISPIMS^BLRUTIL:"INP^VADPT",1:"INP^BLRDPT")
SET (DIC("B"),LRPRAC)=$PIECE(VAIN(2),U)
+12 ;----- END IHS MODIFICATIONS
+13 ;
End DoDot:1
+14 IF $DATA(LRLABKY)
IF 'DIC("B")
IF $PIECE(LRPARAM,U,16)
SET DIC("B")=$SELECT($DATA(^LR(LRDFN,.2)):+^(.2),1:"")
P1 IF $DATA(^VA(200,+DIC("B"),0))#2
IF '$DATA(^VA(200,"AK.PROVIDER",$PIECE($GET(^VA(200,+DIC("B"),0)),U)))
SET DIC("B")=""
+1 SET DIC("B")=$PIECE($GET(^VA(200,+DIC("B"),0)),U)
DO P
IF Y>0
SET (^LR(LRDFN,.2),LRPRAC)=+Y
+2 QUIT
P ;Prompt for PROVIDER
+1 SET DIC="^VA(200,"
SET DIC(0)="AMNEQ"
SET LRPRAC=""
+2 SET DIC("S")="I $D(^VA(200,""AK.PROVIDER"",$P(^(0),U))),"
+3 ;
+4 ; S DIC("S")=DIC("S")_"$$ACTIVE^XUSER(Y),"
+5 ;
+6 ;----- BEGIN IHS/OIT/MKK MODIFICATIONS LR*5.2*1020 - Use IHS Version of $$ACTIVE
+7 SET DIC("S")=DIC("S")_"$$ACTIVE^BLRUTIL2(Y),"
+8 ;----- END IHS/OIT/MKK MODIFICATIONS LR*5.2*1020
+9 ;
+10 SET DIC("S")=DIC("S")_"$D(^XUSEC(""PROVIDER"",Y))"
+11 SET DIC("A")="PROVIDER: "
SET D="AK.PROVIDER"
+12 SET DIC("W")="Q"
DO ^DIC
KILL DIC
+13 IF Y<0
DO QUIT
QUIT
+14 SET LRPRAC=+Y
+15 QUIT
QUIT SET LREND=1
QUIT
