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

ORQPTQ4.m

Go to the documentation of this file.
  1. ORQPTQ4 ; slc/CLA - Extrinsic functions for patient information ;12/15/97
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
  1. Q
  1. DOB(DFN) ; extrinsic function to return patient date of birth:
  1. N VADM
  1. D DEM^VADPT
  1. Q VADM(3)
  1. AGE(DFN) ; extrinsic function to return patient age:
  1. N VADM
  1. D DEM^VADPT
  1. Q VADM(4)
  1. SEX(DFN) ; extrinsic function to return patient sex:
  1. N VADM
  1. D DEM^VADPT
  1. Q VADM(5)
  1. WT(DFN) ; extrinsic function to return patient weight:
  1. K ^UTILITY($J,"GMRVD")
  1. S GMRVSTR(0)="^^^",GMRVSTR="WT"
  1. D EN1^GMRVUT0
  1. N ORT,ORD,ORY
  1. S ORT="",ORD=0,ORY=""
  1. S ORT=$O(^UTILITY($J,"GMRVD","WT",ORT)) I $L($G(ORT)) D
  1. .S ORD=$O(^(ORT,ORD)) I $L($G(ORD)) D
  1. ..S ORY=ORD_"^"_$P(^(ORD),"^",8)_"^"_$P(^(ORD),"^")
  1. K GMRVSTR,^UTILITY($J,"GMRVD")
  1. Q ORY
  1. HT(DFN) ; extrinsic function to return patient height:
  1. K ^UTILITY($J,"GMRVD")
  1. S GMRVSTR(0)="^^^",GMRVSTR="HT"
  1. D EN1^GMRVUT0
  1. N ORT,ORD,ORY
  1. S ORT="",ORD=0,ORY=""
  1. S ORT=$O(^UTILITY($J,"GMRVD","HT",ORT)) I $L($G(ORT)) D
  1. .S ORD=$O(^(ORT,ORD)) I $L($G(ORD)) D
  1. ..S ORY=ORD_"^"_$P(^(ORD),"^",8)_"^"_$P(^(ORD),"^")
  1. K GMRVSTR,^UTILITY($J,"GMRVD")
  1. Q ORY
  1. PRIM(DFN) ; extrinsic function to return patient primary provider
  1. ; based on current patient location
  1. N ORQPRIM
  1. K VAINDT S VA200=1
  1. D INP^VADPT ;get inpatient's primary provider
  1. S ORQPRIM=VAIN(2)
  1. K VAIN,VA200,VAERR
  1. Q:$L($G(ORQPRIM)) ORQPRIM
  1. S ORQPRIM=$$OUTPTPR^SDUTL3(DFN,"","") ;get outpatient's primary provider
  1. S:'$L($G(ORQPRIM)) ORQPRIM=U_"Not found"
  1. Q ORQPRIM