Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORUDPA

ORUDPA.m

Go to the documentation of this file.
  1. 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
  1. ENT ;
  1. ;Entry: none Exit: DFN,ORACTION,ORAGE,ORDOB,ORL,ORNP,ORPD,ORPNM,ORPV,ORSEX,ORSSN,ORTS,ORVP,ORWARD,VADPT("V"),VAERR
  1. D PATIENT^ORU1(.Y)
  1. Q
  1. EN2 ;
  1. S (ORVP,X)="",DIC(0)="EMQZI",DIC=2
  1. R !,"Select PATIENT NAME: ",X:DTIME
  1. I X=""!(X["^") S Y=-1 G END1
  1. S:'$D(DIC(0)) DIC(0)="EMQZI"
  1. S DIC="^DPT(" D ^DIC I $E(X)="^" S:X="^^" DIROUT=1 G END1
  1. I Y>0 S ORVP=+Y_";DPT(" Q:$D(ORUS) G END1
  1. Q
  1. END1 ;
  1. I Y>0 S ^TMP("OR",$J,"PAT",1)=ORVP,^TMP("OR",$J,"PAT","B",ORVP,1)=""
  1. END ;from ORUHDR
  1. Q:Y<0
  1. I ORVP[";DPT(" D HOMO
  1. K VA,VAROOT,VA200,VAIN,VAINDT,VAERR,VADM,DIC Q
  1. ;
  1. GPD ;
  1. N GMRVSTR
  1. K ORPD
  1. S (ORSEQ,ORPD)=0,DFN=+ORVP
  1. 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
  1. S:ORPD'>0 ORPD="NF"
  1. K ORSEQ
  1. Q
  1. HOMO ;
  1. N XQORFLG,ORCNV
  1. S DFN=+Y,VA200=1 K VAINDT
  1. D OERR^VADPT,GPD
  1. 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))=""
  1. 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
  1. Q