ORQPTQ4 ; slc/CLA - Extrinsic functions for patient information ;12/15/97
;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
Q
DOB(DFN) ; extrinsic function to return patient date of birth:
N VADM
D DEM^VADPT
Q VADM(3)
AGE(DFN) ; extrinsic function to return patient age:
N VADM
D DEM^VADPT
Q VADM(4)
SEX(DFN) ; extrinsic function to return patient sex:
N VADM
D DEM^VADPT
Q VADM(5)
WT(DFN) ; extrinsic function to return patient weight:
K ^UTILITY($J,"GMRVD")
S GMRVSTR(0)="^^^",GMRVSTR="WT"
D EN1^GMRVUT0
N ORT,ORD,ORY
S ORT="",ORD=0,ORY=""
S ORT=$O(^UTILITY($J,"GMRVD","WT",ORT)) I $L($G(ORT)) D
.S ORD=$O(^(ORT,ORD)) I $L($G(ORD)) D
..S ORY=ORD_"^"_$P(^(ORD),"^",8)_"^"_$P(^(ORD),"^")
K GMRVSTR,^UTILITY($J,"GMRVD")
Q ORY
HT(DFN) ; extrinsic function to return patient height:
K ^UTILITY($J,"GMRVD")
S GMRVSTR(0)="^^^",GMRVSTR="HT"
D EN1^GMRVUT0
N ORT,ORD,ORY
S ORT="",ORD=0,ORY=""
S ORT=$O(^UTILITY($J,"GMRVD","HT",ORT)) I $L($G(ORT)) D
.S ORD=$O(^(ORT,ORD)) I $L($G(ORD)) D
..S ORY=ORD_"^"_$P(^(ORD),"^",8)_"^"_$P(^(ORD),"^")
K GMRVSTR,^UTILITY($J,"GMRVD")
Q ORY
PRIM(DFN) ; extrinsic function to return patient primary provider
; based on current patient location
N ORQPRIM
K VAINDT S VA200=1
D INP^VADPT ;get inpatient's primary provider
S ORQPRIM=VAIN(2)
K VAIN,VA200,VAERR
Q:$L($G(ORQPRIM)) ORQPRIM
S ORQPRIM=$$OUTPTPR^SDUTL3(DFN,"","") ;get outpatient's primary provider
S:'$L($G(ORQPRIM)) ORQPRIM=U_"Not found"
Q ORQPRIM
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORQPTQ4 1521 printed Sep 23, 2025@20:09:48 Page 2
ORQPTQ4 ; slc/CLA - Extrinsic functions for patient information ;12/15/97
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
+2 QUIT
DOB(DFN) ; extrinsic function to return patient date of birth:
+1 NEW VADM
+2 DO DEM^VADPT
+3 QUIT VADM(3)
AGE(DFN) ; extrinsic function to return patient age:
+1 NEW VADM
+2 DO DEM^VADPT
+3 QUIT VADM(4)
SEX(DFN) ; extrinsic function to return patient sex:
+1 NEW VADM
+2 DO DEM^VADPT
+3 QUIT VADM(5)
WT(DFN) ; extrinsic function to return patient weight:
+1 KILL ^UTILITY($JOB,"GMRVD")
+2 SET GMRVSTR(0)="^^^"
SET GMRVSTR="WT"
+3 DO EN1^GMRVUT0
+4 NEW ORT,ORD,ORY
+5 SET ORT=""
SET ORD=0
SET ORY=""
+6 SET ORT=$ORDER(^UTILITY($JOB,"GMRVD","WT",ORT))
IF $LENGTH($GET(ORT))
Begin DoDot:1
+7 SET ORD=$ORDER(^(ORT,ORD))
IF $LENGTH($GET(ORD))
Begin DoDot:2
+8 SET ORY=ORD_"^"_$PIECE(^(ORD),"^",8)_"^"_$PIECE(^(ORD),"^")
End DoDot:2
End DoDot:1
+9 KILL GMRVSTR,^UTILITY($JOB,"GMRVD")
+10 QUIT ORY
HT(DFN) ; extrinsic function to return patient height:
+1 KILL ^UTILITY($JOB,"GMRVD")
+2 SET GMRVSTR(0)="^^^"
SET GMRVSTR="HT"
+3 DO EN1^GMRVUT0
+4 NEW ORT,ORD,ORY
+5 SET ORT=""
SET ORD=0
SET ORY=""
+6 SET ORT=$ORDER(^UTILITY($JOB,"GMRVD","HT",ORT))
IF $LENGTH($GET(ORT))
Begin DoDot:1
+7 SET ORD=$ORDER(^(ORT,ORD))
IF $LENGTH($GET(ORD))
Begin DoDot:2
+8 SET ORY=ORD_"^"_$PIECE(^(ORD),"^",8)_"^"_$PIECE(^(ORD),"^")
End DoDot:2
End DoDot:1
+9 KILL GMRVSTR,^UTILITY($JOB,"GMRVD")
+10 QUIT ORY
PRIM(DFN) ; extrinsic function to return patient primary provider
+1 ; based on current patient location
+2 NEW ORQPRIM
+3 KILL VAINDT
SET VA200=1
+4 ;get inpatient's primary provider
DO INP^VADPT
+5 SET ORQPRIM=VAIN(2)
+6 KILL VAIN,VA200,VAERR
+7 if $LENGTH($GET(ORQPRIM))
QUIT ORQPRIM
+8 ;get outpatient's primary provider
SET ORQPRIM=$$OUTPTPR^SDUTL3(DFN,"","")
+9 if '$LENGTH($GET(ORQPRIM))
SET ORQPRIM=U_"Not found"
+10 QUIT ORQPRIM
