| 1 | ORUDPA ; slc/dcm,RWF - Object (patient) lookup ;10/7/91  15:21 ;
 | 
|---|
| 2 |  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**16**;Dec 17, 1997
 | 
|---|
| 3 | ENT ;
 | 
|---|
| 4 |  ;Entry: none  Exit: DFN,ORACTION,ORAGE,ORDOB,ORL,ORNP,ORPD,ORPNM,ORPV,ORSEX,ORSSN,ORTS,ORVP,ORWARD,VADPT("V"),VAERR
 | 
|---|
| 5 |  D PATIENT^ORU1(.Y)
 | 
|---|
| 6 |  Q
 | 
|---|
| 7 | EN2 ;
 | 
|---|
| 8 |  S (ORVP,X)="",DIC(0)="EMQZI",DIC=2
 | 
|---|
| 9 |  R !,"Select PATIENT NAME: ",X:DTIME
 | 
|---|
| 10 |  I X=""!(X["^") S Y=-1 G END1
 | 
|---|
| 11 |  S:'$D(DIC(0)) DIC(0)="EMQZI"
 | 
|---|
| 12 |  S DIC="^DPT(" D ^DIC I $E(X)="^" S:X="^^" DIROUT=1 G END1
 | 
|---|
| 13 |  I Y>0 S ORVP=+Y_";DPT(" Q:$D(ORUS)  G END1
 | 
|---|
| 14 |  Q
 | 
|---|
| 15 | END1 ;
 | 
|---|
| 16 |  I Y>0 S ^TMP("OR",$J,"PAT",1)=ORVP,^TMP("OR",$J,"PAT","B",ORVP,1)=""
 | 
|---|
| 17 | END ;from ORUHDR
 | 
|---|
| 18 |  Q:Y<0
 | 
|---|
| 19 |  I ORVP[";DPT(" D HOMO
 | 
|---|
| 20 |  K VA,VAROOT,VA200,VAIN,VAINDT,VAERR,VADM,DIC Q
 | 
|---|
| 21 |  ;
 | 
|---|
| 22 | GPD ;
 | 
|---|
| 23 |  K ORPD
 | 
|---|
| 24 |  S (ORSEQ,ORPD)=0,DFN=+ORVP
 | 
|---|
| 25 |  I $D(^GMRD(120.51)) S X="GMRVUTL" X ^%ZOSF("TEST") I $T D EN4^GMRVUTL S ORPD=+X\1
 | 
|---|
| 26 |  S:ORPD'>0 ORPD="NF"
 | 
|---|
| 27 |  K ORSEQ
 | 
|---|
| 28 |  Q
 | 
|---|
| 29 | HOMO ;
 | 
|---|
| 30 |  N XQORFLG,ORCNV
 | 
|---|
| 31 |  S DFN=+Y,VA200=1 K VAINDT
 | 
|---|
| 32 |  D OERR^VADPT,GPD
 | 
|---|
| 33 |  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))=""
 | 
|---|
| 34 |  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
 | 
|---|
| 35 |  S ORCNV=$$OTF^OR3CONV(+ORVP) Q:'ORCNV
 | 
|---|
| 36 |  I ORCNV>0 W !,"DONE" H 1 Q
 | 
|---|
| 37 |  I ORCNV<0 W $C(7),!!,$P(ORCNV,U,2) H 2 S VALMBCK="R" Q
 | 
|---|
| 38 |  Q
 | 
|---|