- 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 Jan 18, 2025@03:34:37 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