ORUDPA ; slc/dcm,RWF - Object (patient) lookup ;10/7/91 15:21 ; 3/7/08 5:22am
;;3.0;ORDER ENTRY/RESULTS REPORTING;**16,243**;Dec 17, 1997;Build 242
ENT ;
;Entry: none Exit: DFN,ORACTION,ORAGE,ORDOB,ORL,ORNP,ORPD,ORPNM,ORPV,ORSEX,ORSSN,ORTS,ORVP,ORWARD,VADPT("V"),VAERR
D PATIENT^ORU1(.Y)
Q
EN2 ;
S (ORVP,X)="",DIC(0)="EMQZI",DIC=2
R !,"Select PATIENT NAME: ",X:DTIME
I X=""!(X["^") S Y=-1 G END1
S:'$D(DIC(0)) DIC(0)="EMQZI"
S DIC="^DPT(" D ^DIC I $E(X)="^" S:X="^^" DIROUT=1 G END1
I Y>0 S ORVP=+Y_";DPT(" Q:$D(ORUS) G END1
Q
END1 ;
I Y>0 S ^TMP("OR",$J,"PAT",1)=ORVP,^TMP("OR",$J,"PAT","B",ORVP,1)=""
END ;from ORUHDR
Q:Y<0
I ORVP[";DPT(" D HOMO
K VA,VAROOT,VA200,VAIN,VAINDT,VAERR,VADM,DIC Q
;
GPD ;
N GMRVSTR
K ORPD
S (ORSEQ,ORPD)=0,DFN=+ORVP
I $D(^GMRD(120.51)) S X="GMRVUTL",GMRVSTR="WT" X ^%ZOSF("TEST") I $T D EN6^GMRVUTL S ORPD=+$P(X,U,8)\1
S:ORPD'>0 ORPD="NF"
K ORSEQ
Q
HOMO ;
N XQORFLG,ORCNV
S DFN=+Y,VA200=1 K VAINDT
D OERR^VADPT,GPD
S ORPNM=VADM(1),ORSSN=VA("PID"),ORDOB=$P(VADM(3),"^",2),ORAGE=VADM(4),ORSEX=$P(VADM(5),"^"),ORTS=+VAIN(3),ORTS=$S(ORTS:ORTS,1:""),(ORATTEND,ORNP)=+VAIN(2),ORWARD=VAIN(4),ORL(1)=VAIN(5),(ORPV,ORL,ORL(0),ORL(2))=""
I +$P(ORWARD,"^") S X=+ORWARD I $D(^DIC(42,+X,44)) S X=$P(^(44),"^") I X,$D(^SC(X,0)) S ORL=X_";SC(",ORL(0)=$S($L($P(^(0),"^",2)):$P(^(0),"^",2),1:$E($P(^(0),"^"),1,4)),ORL(2)=ORL
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORUDPA 1409 printed Sep 23, 2025@20:10:44 Page 2
ORUDPA ; slc/dcm,RWF - Object (patient) lookup ;10/7/91 15:21 ; 3/7/08 5:22am
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**16,243**;Dec 17, 1997;Build 242
ENT ;
+1 ;Entry: none Exit: DFN,ORACTION,ORAGE,ORDOB,ORL,ORNP,ORPD,ORPNM,ORPV,ORSEX,ORSSN,ORTS,ORVP,ORWARD,VADPT("V"),VAERR
+2 DO PATIENT^ORU1(.Y)
+3 QUIT
EN2 ;
+1 SET (ORVP,X)=""
SET DIC(0)="EMQZI"
SET DIC=2
+2 READ !,"Select PATIENT NAME: ",X:DTIME
+3 IF X=""!(X["^")
SET Y=-1
GOTO END1
+4 if '$DATA(DIC(0))
SET DIC(0)="EMQZI"
+5 SET DIC="^DPT("
DO ^DIC
IF $EXTRACT(X)="^"
if X="^^"
SET DIROUT=1
GOTO END1
+6 IF Y>0
SET ORVP=+Y_";DPT("
if $DATA(ORUS)
QUIT
GOTO END1
+7 QUIT
END1 ;
+1 IF Y>0
SET ^TMP("OR",$JOB,"PAT",1)=ORVP
SET ^TMP("OR",$JOB,"PAT","B",ORVP,1)=""
END ;from ORUHDR
+1 if Y<0
QUIT
+2 IF ORVP[";DPT("
DO HOMO
+3 KILL VA,VAROOT,VA200,VAIN,VAINDT,VAERR,VADM,DIC
QUIT
+4 ;
GPD ;
+1 NEW GMRVSTR
+2 KILL ORPD
+3 SET (ORSEQ,ORPD)=0
SET DFN=+ORVP
+4 IF $DATA(^GMRD(120.51))
SET X="GMRVUTL"
SET GMRVSTR="WT"
XECUTE ^%ZOSF("TEST")
IF $TEST
DO EN6^GMRVUTL
SET ORPD=+$PIECE(X,U,8)\1
+5 if ORPD'>0
SET ORPD="NF"
+6 KILL ORSEQ
+7 QUIT
HOMO ;
+1 NEW XQORFLG,ORCNV
+2 SET DFN=+Y
SET VA200=1
KILL VAINDT
+3 DO OERR^VADPT
DO GPD
+4 SET ORPNM=VADM(1)
SET ORSSN=VA("PID")
SET ORDOB=$PIECE(VADM(3),"^",2)
SET ORAGE=VADM(4)
SET ORSEX=$PIECE(VADM(5),"^")
SET ORTS=+VAIN(3)
SET ORTS=$SELECT(ORTS:ORTS,1:"")
SET (ORATTEND,ORNP)=+VAIN(2)
SET ORWARD=VAIN(4)
SET ORL(1)=VAIN(5)
SET (ORPV,ORL,ORL(0),ORL(2))=""
+5 IF +$PIECE(ORWARD,"^")
SET X=+ORWARD
IF $DATA(^DIC(42,+X,44))
SET X=$PIECE(^(44),"^")
IF X
IF $DATA(^SC(X,0))
SET ORL=X_";SC("
SET ORL(0)=$SELECT($LENGTH($PIECE(^(0),"^",2)):$PIECE(^(0),"^",2),1:$EXTRACT($PIECE(^(0),"^"),1,4))
SET ORL(2)=ORL
+6 QUIT
