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

ORQPTQ3.m

Go to the documentation of this file.
  1. ORQPTQ3 ; SLC/CLA/KER - Demographic Functions ; 01/09/2003
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**159**;Dec 17, 1997
  1. ;
  1. DEMOG(Y,DFN) ; RETURN PATIENT'S DEMOGRAPHIC INFO
  1. ;DEM: SSN^DOB^AGE^SEX^RACE^ETHNICITY^RELIGION^MARITAL STATUS
  1. ;INP: PRIMARY DUZ;NAME^ATTENDING DUZ;NAME^LOCATION^WARD^RMBED
  1. N ORPTDEMO,ATTDUZ,PRIMDUZ,ORI,ORR,ORE,ORD,ORO D DEM^VADPT
  1. S ORI=0 F S ORI=$O(VADM(11,ORI)) Q:+ORI=0 S ORD=$P(VADM(11,ORI),"^",2) S:$L(ORD) ORE=$G(ORE)_", "_ORD
  1. F Q:$E(ORE,1,2)'=", " S ORE=$E(ORE,3,$L(ORE))
  1. S ORI=0 F S ORI=$O(VADM(12,ORI)) Q:+ORI=0 S ORD=$P($G(VADM(12,ORI)),"^",2) S:$L(ORD) ORR=$G(ORR)_", "_ORD
  1. F Q:$E(ORR,1,2)'=", " S ORR=$E(ORR,3,$L(ORR))
  1. S ORO=$P(VADM(8),U,2) S:'$L(ORE)&('$L(ORR))&('$D(VADM(11)))&('$D(VADM(12))) ORE=ORO
  1. S ORPTDEMO=$P(VADM(2),U)_U_$P(VADM(3),U,2)_U_VADM(4)_U_$P(VADM(5),U,2)_U_ORR_U_ORE_U_$P(VADM(9),U,2)_U_$P(VADM(10),U,2)
  1. K VAINDT,VADM,VAERR S VA200=1
  1. D INP^VADPT
  1. S Y=ORPTDEMO_U_$P(VAIN(2),U)_";"_$P(VAIN(2),U,2)_U_$P(VAIN(11),U)_";"_$P(VAIN(11),U,2)_U_U_$P(VAIN(4),U,2)_U_VAIN(5)
  1. K VA200,VAIN,VAERR
  1. Q
  1. WRB(Y,DFN) ;return patient's ward, room-bed: ward ien^ward name room-bed
  1. N WNAME,WIEN S WIEN="",Y=""
  1. S WNAME=$G(^DPT(DFN,.1)) I $L(WNAME) S WIEN=$O(^DIC(42,"B",WNAME,WIEN))
  1. I $L($G(WNAME)),$L($G(WIEN)) S Y=WIEN_U_WNAME_" "_$G(^DPT(DFN,.101))
  1. Q
  1. NAME(ORY,DFN) ; return patient's name in mixed case
  1. I '$L($G(^DPT(DFN,0))) S ORY="Not found" Q
  1. S ORY=$$LOWER^VALM1($P(^DPT(DFN,0),U))
  1. Q
  1. ADDR(Y,DFN) ; RETURN PATIENT'S ADDRESS & PHONE NUMBER
  1. D ADD^VADPT
  1. S Y=VAPA(1)_"^"_VAPA(2)_"^"_VAPA(3)_"^"_VAPA(4)_"^"_$P(VAPA(5),"^",2)_"^"_VAPA(6)_"^"_VAPA(8)
  1. K VAPA
  1. Q
  1. ATTPRIM(ORY,DFN) ; return patient's attending physician and primary provider
  1. ; format: ATTEND DUZ^ATTEND NAME;PRIMARY DUZ^PRIMARY NAME
  1. K VAINDT S VA200=1
  1. D INP^VADPT
  1. S ORY=$S($L($G(VAIN(11))):VAIN(11),1:"^not found") ;attending physician
  1. S ORY=ORY_";"_$S($L($G(VAIN(2))):VAIN(2),1:"^not found") ;primary provider
  1. K VA200,VAIN
  1. Q
  1. WARD(Y,DFN) ; RETURN PATIENT'S WARD
  1. D INP^VADPT
  1. S Y=VAIN(4)
  1. K VAIN
  1. Q
  1. RMBED(Y,DFN) ; RETURN PATIENT'S ROOM-BED
  1. D INP^VADPT
  1. S Y=VAIN(5)
  1. K VAIN
  1. Q
  1. ATTEND(Y,DFN) ; RETURN PATIENT'S ATTENDING PHYSICIAN
  1. ;NOT YET IMPLEMENTED
  1. ;D INP^VADPT
  1. Q
  1. SSN(Y,DFN) ; RETURN PATIENT'S SSN
  1. D DEM^VADPT
  1. S Y=VADM(2)
  1. K VADM
  1. Q
  1. DOB(Y,DFN) ; RETURN PATIENT'S DATE OF BIRTH
  1. D DEM^VADPT
  1. S Y=VADM(3)
  1. K VADM
  1. Q
  1. AGE(Y,DFN) ; RETURN PATIENT'S AGE
  1. D DEM^VADPT
  1. S Y=VADM(4)
  1. K VADM
  1. Q
  1. SEX(Y,DFN) ; RETURN PATIENT'S SEX
  1. D DEM^VADPT
  1. S Y=VADM(5)
  1. K VADM
  1. Q