- 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 Feb 19, 2025@00:00:02 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