- 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
