ORQPTQ4 ; slc/CLA - Extrinsic functions for patient information ;13-Jul-2011 15:25;MGH
;;3.0;ORDER ENTRY/RESULTS REPORTING;**1002,1008,1010**;Dec 17, 1997;Build 47
; Modified - IHS/MSC/MGH - 07/13/11 - Line LASTVITL
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:
; IHS/CIA/DKM - Added next line
Q $$LASTVITL(DFN,"WT") ; IHS/CIA/DKM - redirect to PCC
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:
; IHS/CIA/DKM - Added next line
Q $$LASTVITL(DFN,"HT") ; IHS/CIA/DKM - redirect to PCC
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
; IHS/CIA/DKM - Added LASTVITL function
; Return most recent vital value of specified type
LASTVITL(DFN,TYP) ;
N IDT,IEN,EIE,MSR
S MSR=""
S:TYP'=+TYP TYP=$O(^AUTTMSR("B",TYP,0))
Q:'TYP ""
S IDT=""
F S IDT=$O(^AUPNVMSR("AA",DFN,TYP,IDT)) Q:'IDT!(+MSR) D
.S IEN="" F S IEN=$O(^AUPNVMSR("AA",DFN,TYP,IDT,IEN)) Q:'IEN!(+MSR) D
..;Return needs to be in second piece IHS/MSC/MGH
..S EIE=$$GET1^DIQ(9000010.01,IEN,2,"I")
..Q:+EIE
..S MSR=IEN_U_$P($G(^AUPNVMSR(IEN,0)),U,4)
Q MSR
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
ORQPTQ4 ; slc/CLA - Extrinsic functions for patient information ;13-Jul-2011 15:25;MGH
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**1002,1008,1010**;Dec 17, 1997;Build 47
+2 ; Modified - IHS/MSC/MGH - 07/13/11 - Line LASTVITL
+3 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 ; IHS/CIA/DKM - Added next line
+2 ; IHS/CIA/DKM - redirect to PCC
QUIT $$LASTVITL(DFN,"WT")
+3 KILL ^UTILITY($JOB,"GMRVD")
+4 SET GMRVSTR(0)="^^^"
SET GMRVSTR="WT"
+5 DO EN1^GMRVUT0
+6 NEW ORT,ORD,ORY
+7 SET ORT=""
SET ORD=0
SET ORY=""
+8 SET ORT=$ORDER(^UTILITY($JOB,"GMRVD","WT",ORT))
IF $LENGTH($GET(ORT))
Begin DoDot:1
+9 SET ORD=$ORDER(^(ORT,ORD))
IF $LENGTH($GET(ORD))
Begin DoDot:2
+10 SET ORY=ORD_"^"_$PIECE(^(ORD),"^",8)_"^"_$PIECE(^(ORD),"^")
End DoDot:2
End DoDot:1
+11 KILL GMRVSTR,^UTILITY($JOB,"GMRVD")
+12 QUIT ORY
HT(DFN) ; extrinsic function to return patient height:
+1 ; IHS/CIA/DKM - Added next line
+2 ; IHS/CIA/DKM - redirect to PCC
QUIT $$LASTVITL(DFN,"HT")
+3 KILL ^UTILITY($JOB,"GMRVD")
+4 SET GMRVSTR(0)="^^^"
SET GMRVSTR="HT"
+5 DO EN1^GMRVUT0
+6 NEW ORT,ORD,ORY
+7 SET ORT=""
SET ORD=0
SET ORY=""
+8 SET ORT=$ORDER(^UTILITY($JOB,"GMRVD","HT",ORT))
IF $LENGTH($GET(ORT))
Begin DoDot:1
+9 SET ORD=$ORDER(^(ORT,ORD))
IF $LENGTH($GET(ORD))
Begin DoDot:2
+10 SET ORY=ORD_"^"_$PIECE(^(ORD),"^",8)_"^"_$PIECE(^(ORD),"^")
End DoDot:2
End DoDot:1
+11 KILL GMRVSTR,^UTILITY($JOB,"GMRVD")
+12 QUIT ORY
+13 ; IHS/CIA/DKM - Added LASTVITL function
+14 ; Return most recent vital value of specified type
LASTVITL(DFN,TYP) ;
+1 NEW IDT,IEN,EIE,MSR
+2 SET MSR=""
+3 IF TYP'=+TYP
SET TYP=$ORDER(^AUTTMSR("B",TYP,0))
+4 IF 'TYP
QUIT ""
+5 SET IDT=""
+6 FOR
SET IDT=$ORDER(^AUPNVMSR("AA",DFN,TYP,IDT))
IF 'IDT!(+MSR)
QUIT
Begin DoDot:1
+7 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVMSR("AA",DFN,TYP,IDT,IEN))
IF 'IEN!(+MSR)
QUIT
Begin DoDot:2
+8 ;Return needs to be in second piece IHS/MSC/MGH
+9 SET EIE=$$GET1^DIQ(9000010.01,IEN,2,"I")
+10 IF +EIE
QUIT
+11 SET MSR=IEN_U_$PIECE($GET(^AUPNVMSR(IEN,0)),U,4)
End DoDot:2
End DoDot:1
+12 QUIT MSR
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
