ORQPTQ3 ; SLC/CLA/KER - Demographic Functions ; 01/09/2003
;;3.0;ORDER ENTRY/RESULTS REPORTING;**159**;Dec 17, 1997
;
DEMOG(Y,DFN) ; RETURN PATIENT'S DEMOGRAPHIC INFO
;DEM: SSN^DOB^AGE^SEX^RACE^ETHNICITY^RELIGION^MARITAL STATUS
;INP: PRIMARY DUZ;NAME^ATTENDING DUZ;NAME^LOCATION^WARD^RMBED
N ORPTDEMO,ATTDUZ,PRIMDUZ,ORI,ORR,ORE,ORD,ORO D DEM^VADPT
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
F Q:$E(ORE,1,2)'=", " S ORE=$E(ORE,3,$L(ORE))
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
F Q:$E(ORR,1,2)'=", " S ORR=$E(ORR,3,$L(ORR))
S ORO=$P(VADM(8),U,2) S:'$L(ORE)&('$L(ORR))&('$D(VADM(11)))&('$D(VADM(12))) ORE=ORO
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)
K VAINDT,VADM,VAERR S VA200=1
D INP^VADPT
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)
K VA200,VAIN,VAERR
Q
WRB(Y,DFN) ;return patient's ward, room-bed: ward ien^ward name room-bed
N WNAME,WIEN S WIEN="",Y=""
S WNAME=$G(^DPT(DFN,.1)) I $L(WNAME) S WIEN=$O(^DIC(42,"B",WNAME,WIEN))
I $L($G(WNAME)),$L($G(WIEN)) S Y=WIEN_U_WNAME_" "_$G(^DPT(DFN,.101))
Q
NAME(ORY,DFN) ; return patient's name in mixed case
I '$L($G(^DPT(DFN,0))) S ORY="Not found" Q
S ORY=$$LOWER^VALM1($P(^DPT(DFN,0),U))
Q
ADDR(Y,DFN) ; RETURN PATIENT'S ADDRESS & PHONE NUMBER
D ADD^VADPT
S Y=VAPA(1)_"^"_VAPA(2)_"^"_VAPA(3)_"^"_VAPA(4)_"^"_$P(VAPA(5),"^",2)_"^"_VAPA(6)_"^"_VAPA(8)
K VAPA
Q
ATTPRIM(ORY,DFN) ; return patient's attending physician and primary provider
; format: ATTEND DUZ^ATTEND NAME;PRIMARY DUZ^PRIMARY NAME
K VAINDT S VA200=1
D INP^VADPT
S ORY=$S($L($G(VAIN(11))):VAIN(11),1:"^not found") ;attending physician
S ORY=ORY_";"_$S($L($G(VAIN(2))):VAIN(2),1:"^not found") ;primary provider
K VA200,VAIN
Q
WARD(Y,DFN) ; RETURN PATIENT'S WARD
D INP^VADPT
S Y=VAIN(4)
K VAIN
Q
RMBED(Y,DFN) ; RETURN PATIENT'S ROOM-BED
D INP^VADPT
S Y=VAIN(5)
K VAIN
Q
ATTEND(Y,DFN) ; RETURN PATIENT'S ATTENDING PHYSICIAN
;NOT YET IMPLEMENTED
;D INP^VADPT
Q
SSN(Y,DFN) ; RETURN PATIENT'S SSN
D DEM^VADPT
S Y=VADM(2)
K VADM
Q
DOB(Y,DFN) ; RETURN PATIENT'S DATE OF BIRTH
D DEM^VADPT
S Y=VADM(3)
K VADM
Q
AGE(Y,DFN) ; RETURN PATIENT'S AGE
D DEM^VADPT
S Y=VADM(4)
K VADM
Q
SEX(Y,DFN) ; RETURN PATIENT'S SEX
D DEM^VADPT
S Y=VADM(5)
K VADM
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORQPTQ3 2583 printed Apr 09, 2024@21:40 Page 2
ORQPTQ3 ; SLC/CLA/KER - Demographic Functions ; 01/09/2003
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**159**;Dec 17, 1997
+2 ;
DEMOG(Y,DFN) ; RETURN PATIENT'S DEMOGRAPHIC INFO
+1 ;DEM: SSN^DOB^AGE^SEX^RACE^ETHNICITY^RELIGION^MARITAL STATUS
+2 ;INP: PRIMARY DUZ;NAME^ATTENDING DUZ;NAME^LOCATION^WARD^RMBED
+3 NEW ORPTDEMO,ATTDUZ,PRIMDUZ,ORI,ORR,ORE,ORD,ORO
DO DEM^VADPT
+4 SET ORI=0
FOR
SET ORI=$ORDER(VADM(11,ORI))
if +ORI=0
QUIT
SET ORD=$PIECE(VADM(11,ORI),"^",2)
if $LENGTH(ORD)
SET ORE=$GET(ORE)_", "_ORD
+5 FOR
if $EXTRACT(ORE,1,2)'=", "
QUIT
SET ORE=$EXTRACT(ORE,3,$LENGTH(ORE))
+6 SET ORI=0
FOR
SET ORI=$ORDER(VADM(12,ORI))
if +ORI=0
QUIT
SET ORD=$PIECE($GET(VADM(12,ORI)),"^",2)
if $LENGTH(ORD)
SET ORR=$GET(ORR)_", "_ORD
+7 FOR
if $EXTRACT(ORR,1,2)'=", "
QUIT
SET ORR=$EXTRACT(ORR,3,$LENGTH(ORR))
+8 SET ORO=$PIECE(VADM(8),U,2)
if '$LENGTH(ORE)&('$LENGTH(ORR))&('$DATA(VADM(11)))&('$DATA(VADM(12)))
SET ORE=ORO
+9 SET ORPTDEMO=$PIECE(VADM(2),U)_U_$PIECE(VADM(3),U,2)_U_VADM(4)_U_$PIECE(VADM(5),U,2)_U_ORR_U_ORE_U_$PIECE(VADM(9),U,2)_U_$PIECE(VADM(10),U,2)
+10 KILL VAINDT,VADM,VAERR
SET VA200=1
+11 DO INP^VADPT
+12 SET Y=ORPTDEMO_U_$PIECE(VAIN(2),U)_";"_$PIECE(VAIN(2),U,2)_U_$PIECE(VAIN(11),U)_";"_$PIECE(VAIN(11),U,2)_U_U_$PIECE(VAIN(4),U,2)_U_VAIN(5)
+13 KILL VA200,VAIN,VAERR
+14 QUIT
WRB(Y,DFN) ;return patient's ward, room-bed: ward ien^ward name room-bed
+1 NEW WNAME,WIEN
SET WIEN=""
SET Y=""
+2 SET WNAME=$GET(^DPT(DFN,.1))
IF $LENGTH(WNAME)
SET WIEN=$ORDER(^DIC(42,"B",WNAME,WIEN))
+3 IF $LENGTH($GET(WNAME))
IF $LENGTH($GET(WIEN))
SET Y=WIEN_U_WNAME_" "_$GET(^DPT(DFN,.101))
+4 QUIT
NAME(ORY,DFN) ; return patient's name in mixed case
+1 IF '$LENGTH($GET(^DPT(DFN,0)))
SET ORY="Not found"
QUIT
+2 SET ORY=$$LOWER^VALM1($PIECE(^DPT(DFN,0),U))
+3 QUIT
ADDR(Y,DFN) ; RETURN PATIENT'S ADDRESS & PHONE NUMBER
+1 DO ADD^VADPT
+2 SET Y=VAPA(1)_"^"_VAPA(2)_"^"_VAPA(3)_"^"_VAPA(4)_"^"_$PIECE(VAPA(5),"^",2)_"^"_VAPA(6)_"^"_VAPA(8)
+3 KILL VAPA
+4 QUIT
ATTPRIM(ORY,DFN) ; return patient's attending physician and primary provider
+1 ; format: ATTEND DUZ^ATTEND NAME;PRIMARY DUZ^PRIMARY NAME
+2 KILL VAINDT
SET VA200=1
+3 DO INP^VADPT
+4 ;attending physician
SET ORY=$SELECT($LENGTH($GET(VAIN(11))):VAIN(11),1:"^not found")
+5 ;primary provider
SET ORY=ORY_";"_$SELECT($LENGTH($GET(VAIN(2))):VAIN(2),1:"^not found")
+6 KILL VA200,VAIN
+7 QUIT
WARD(Y,DFN) ; RETURN PATIENT'S WARD
+1 DO INP^VADPT
+2 SET Y=VAIN(4)
+3 KILL VAIN
+4 QUIT
RMBED(Y,DFN) ; RETURN PATIENT'S ROOM-BED
+1 DO INP^VADPT
+2 SET Y=VAIN(5)
+3 KILL VAIN
+4 QUIT
ATTEND(Y,DFN) ; RETURN PATIENT'S ATTENDING PHYSICIAN
+1 ;NOT YET IMPLEMENTED
+2 ;D INP^VADPT
+3 QUIT
SSN(Y,DFN) ; RETURN PATIENT'S SSN
+1 DO DEM^VADPT
+2 SET Y=VADM(2)
+3 KILL VADM
+4 QUIT
DOB(Y,DFN) ; RETURN PATIENT'S DATE OF BIRTH
+1 DO DEM^VADPT
+2 SET Y=VADM(3)
+3 KILL VADM
+4 QUIT
AGE(Y,DFN) ; RETURN PATIENT'S AGE
+1 DO DEM^VADPT
+2 SET Y=VADM(4)
+3 KILL VADM
+4 QUIT
SEX(Y,DFN) ; RETURN PATIENT'S SEX
+1 DO DEM^VADPT
+2 SET Y=VADM(5)
+3 KILL VADM
+4 QUIT
