275 lines
7.2 KiB
Mathematica
275 lines
7.2 KiB
Mathematica
|
WVUTL1 ;HCIOFO/FT,JR-UTIL: MOSTLY PATIENT DATA ;10/11/99 14:31
|
||
|
|
;;1.0;WOMEN'S HEALTH;**7**;Sep 30, 1998
|
||
|
|
;; Original routine created by IHS/ANMC/MWR
|
||
|
|
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
|
||
|
|
;; UTILITY: PATIENT DEMOGRAPHICS, NEEDS, AND REGIMENS.
|
||
|
|
;; ALSO DISPLAY PRIORITY, PROCEDURE TYPE.
|
||
|
|
;
|
||
|
|
;
|
||
|
|
NAME(DFN) ;EP
|
||
|
|
;---> PATIENT NAME.
|
||
|
|
;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
|
||
|
|
Q:'$G(DFN) "NO PATIENT"
|
||
|
|
Q:'$D(^DPT(DFN,0)) "UNKNOWN"
|
||
|
|
Q $P(^DPT(DFN,0),U)
|
||
|
|
;
|
||
|
|
DOB(DFN) ;EP
|
||
|
|
;---> RETURN PATIENT'S DATE OF BIRTH IN FILEMAN FORMAT.
|
||
|
|
;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
|
||
|
|
Q:'$G(DFN) "NO PATIENT"
|
||
|
|
Q:'$P($G(^DPT(DFN,0)),U,3) "UNKNOWN"
|
||
|
|
Q $P(^DPT(DFN,0),U,3)
|
||
|
|
;
|
||
|
|
;
|
||
|
|
AGE(DFN) ;EP
|
||
|
|
;---> YIELD PATIENT'S AGE IN YEARS.
|
||
|
|
;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
|
||
|
|
N X,X1,X2
|
||
|
|
Q:'$G(DFN) "NO PATIENT"
|
||
|
|
S X2=$$DOB(DFN)
|
||
|
|
Q:'+X2 "UNKNOWN"
|
||
|
|
I $$DECEASED(DFN) Q "DECEASED: "_$$SLDT2^WVUTL5(+^DPT(DFN,.35))
|
||
|
|
S X1=DT
|
||
|
|
D ^%DTC
|
||
|
|
Q $P(X/365.25,".")_"y/o"
|
||
|
|
;
|
||
|
|
DECEASED(DFN) ;EP
|
||
|
|
;---> RETURN 1 IF PATIENT IS DECEASED, 0 IF NOT DECEASED.
|
||
|
|
;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
|
||
|
|
Q:'$G(DFN) 0
|
||
|
|
Q:'$D(^DPT(DFN,.35)) 0
|
||
|
|
Q:'+^DPT(DFN,.35) 0
|
||
|
|
Q 1
|
||
|
|
;
|
||
|
|
SEX(DFN) ;EP
|
||
|
|
;---> RETURN 1 IF PATIENT IS FEMALE.
|
||
|
|
;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
|
||
|
|
Q:'$G(DFN) ""
|
||
|
|
Q:'$D(^DPT(DFN,0)) ""
|
||
|
|
Q:$P(^DPT(DFN,0),U,2)'="F" ""
|
||
|
|
Q 1
|
||
|
|
;
|
||
|
|
INACT(DFN) ;EP
|
||
|
|
;---> DATE THIS PATIENT BECAME INACTIVE
|
||
|
|
;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
|
||
|
|
Q:'$G(DFN) "NO PATIENT"
|
||
|
|
Q:'$D(^DPT(DFN,0)) "UNKNOWN"
|
||
|
|
Q $P(^WV(790,DFN,0),U,24)
|
||
|
|
;
|
||
|
|
AGEAT(DFN,DATE) ;EP
|
||
|
|
;---> YIELD PATIENT'S AGE IN YEARS AT GIVEN DATE.
|
||
|
|
;---> REQUIRED VARIABLE: DFN =IEN PATIENT FILE
|
||
|
|
;---> DATE=DATE AT WHICH AGE IS DESIRED.
|
||
|
|
N X,X1,X2
|
||
|
|
Q:'$G(DFN) "NO PATIENT"
|
||
|
|
Q:'$G(DATE) "NO DATE"
|
||
|
|
S X2=$$DOB(DFN)
|
||
|
|
Q:'+X2 "UNKNOWN"
|
||
|
|
S X1=DATE
|
||
|
|
D ^%DTC
|
||
|
|
Q $P(X/365.25,".")_"y/o"
|
||
|
|
;
|
||
|
|
NAMAGE(DFN) ;EP
|
||
|
|
;---> PATIENT NAME CONCAT WITH AGE.
|
||
|
|
;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
|
||
|
|
Q:'$G(DFN) "NO PATIENT"
|
||
|
|
Q $$NAME(DFN)_" ("_$$AGE(DFN)_")"
|
||
|
|
;
|
||
|
|
SSN(DFN) ;EP
|
||
|
|
;---> SOCIAL SECURITY NUMBER.
|
||
|
|
;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
|
||
|
|
N X
|
||
|
|
Q:'$G(DFN) "NO PATIENT"
|
||
|
|
Q:'$D(^DPT(DFN,0)) "UNKNOWN"
|
||
|
|
S X=$P(^DPT(DFN,0),U,9)
|
||
|
|
Q:X']"" "UNKNOWN"
|
||
|
|
S X=$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,9)
|
||
|
|
Q X
|
||
|
|
;
|
||
|
|
HRCN(DFN) ;EP
|
||
|
|
;---> RETURN SSN.
|
||
|
|
;---> REQUIRED VARIABLE: DFN
|
||
|
|
Q $$SSN(DFN)
|
||
|
|
;
|
||
|
|
HPHONE(DFN) ;EP
|
||
|
|
;---> GET HOME PHONE#.
|
||
|
|
;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
|
||
|
|
N WVPHONE
|
||
|
|
Q:'$G(DFN) "NO PATIENT"
|
||
|
|
S WVPHONE=$$GET1^DIQ(2,DFN,.131,"I")
|
||
|
|
Q:WVPHONE="" "UNKNOWN"
|
||
|
|
Q WVPHONE
|
||
|
|
;
|
||
|
|
STREET(DFN) ;EP
|
||
|
|
;---> GET STREET ADDRESS.
|
||
|
|
;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
|
||
|
|
Q:'$G(DFN) "NO PATIENT"
|
||
|
|
N WVADDR
|
||
|
|
S WVADDR=$$GET1^DIQ(2,DFN,.111,"I")
|
||
|
|
Q:WVADDR="" "UNKNOWN"
|
||
|
|
Q WVADDR
|
||
|
|
;
|
||
|
|
CITY(DFN) ;EP
|
||
|
|
;---> GET CITY ADDRESS.
|
||
|
|
;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
|
||
|
|
Q:'$G(DFN) "NO PATIENT"
|
||
|
|
N WVCITY
|
||
|
|
S WVCITY=$$GET1^DIQ(2,DFN,.114,"I")
|
||
|
|
Q:WVCITY="" "UNKNOWN"
|
||
|
|
Q WVCITY
|
||
|
|
;
|
||
|
|
STATE(DFN) ;EP
|
||
|
|
;---> GET STATE ADDRESS.
|
||
|
|
;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
|
||
|
|
Q:'$G(DFN) "NO PATIENT"
|
||
|
|
N WVSTATE
|
||
|
|
S WVSTATE=$$GET1^DIQ(2,DFN,.115,"I")
|
||
|
|
Q:WVSTATE="" "UNKNOWN"
|
||
|
|
S WVSTATE=$$GET1^DIQ(5,WVSTATE,1,"I") S:WVSTATE="" WVSTATE="UNKNOWN"
|
||
|
|
Q WVSTATE
|
||
|
|
;
|
||
|
|
ZIP(DFN) ;EP
|
||
|
|
;---> GET ZIPCODE ADDRESS.
|
||
|
|
;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
|
||
|
|
Q:'$G(DFN) "NO PATIENT"
|
||
|
|
N WVZIP
|
||
|
|
S WVZIP=$$GET1^DIQ(2,DFN,.116,"I")
|
||
|
|
Q:WVZIP'>0 "UNKNOWN"
|
||
|
|
Q WVZIP
|
||
|
|
;
|
||
|
|
CTYSTZ(DFN) ;EP
|
||
|
|
;---> GET ZIPCODE ADDRESS.
|
||
|
|
;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
|
||
|
|
Q:'$G(DFN) "NO PATIENT"
|
||
|
|
Q $$CITY(DFN)_", "_$$STATE(DFN)_" "_$$ZIP(DFN)
|
||
|
|
;
|
||
|
|
CMGR(DFN) ;EP
|
||
|
|
;---> YIELD PATIENT'S CASE MANAGER.
|
||
|
|
;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
|
||
|
|
N X
|
||
|
|
Q:'$G(DFN) "NO PATIENT"
|
||
|
|
Q:'$D(^WV(790,DFN,0)) "UNKNOWN"
|
||
|
|
S X=$P(^WV(790,DFN,0),U,10)
|
||
|
|
Q $$PERSON(X)
|
||
|
|
;
|
||
|
|
PERSON(X) ;EP
|
||
|
|
;---> RETURN PERSON'S NAME FROM FILE #200.
|
||
|
|
N WVNAME
|
||
|
|
Q:'X "UNKNOWN"
|
||
|
|
S WVNAME=$$GET1^DIQ(200,X,.01,"E")
|
||
|
|
Q $S(WVNAME'="":WVNAME,1:"UNKNOWN")
|
||
|
|
;
|
||
|
|
EDC(DFN) ;EP
|
||
|
|
;---> YIELD IF PATIENT IS PREGNANT, AND EDC.
|
||
|
|
;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
|
||
|
|
N X,Y
|
||
|
|
Q:'$G(DFN) "NO PATIENT"
|
||
|
|
Q:'$D(^WV(790,DFN,0)) "UNKNOWN"
|
||
|
|
S Y=$P(^WV(790,DFN,0),U,13)
|
||
|
|
S X=$P(^WV(790,DFN,0),U,14)
|
||
|
|
Q:'Y ""
|
||
|
|
S Y=" PREGNANT"
|
||
|
|
Q Y_", EDC: "_$S(X:$$SLDT2^WVUTL5(X),1:"NO DATE ")_" "
|
||
|
|
;
|
||
|
|
PAPRG(DFN,TXDT) ;EP
|
||
|
|
;---> YIELD PATIENT'S PAP REGIMEN AND DATE IT BEGAN.
|
||
|
|
;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
|
||
|
|
;---> OPTIONAL VARIABLE: TXDT=1 IF DATE SHOULD BE TEXT FORMAT.
|
||
|
|
N Y,X
|
||
|
|
Q:'$G(DFN) "NO PATIENT"
|
||
|
|
Q:'$D(^WV(790,DFN,0)) "UNKNOWN"
|
||
|
|
S Y=$P(^WV(790,DFN,0),U,16)
|
||
|
|
S X=$P(^WV(790,DFN,0),U,17) D Z(.X,$G(TXDT))
|
||
|
|
Q $$PAPRG1(Y)_" (began "_X_")"
|
||
|
|
;
|
||
|
|
PAPRG1(PREG) ;EP
|
||
|
|
;---> YIELD PATIENT'S PAP REGIMEN.
|
||
|
|
;---> REQUIRED VARIABLE: PREG=IEN IN WV PAP REGIMEN FILE #790.03.
|
||
|
|
Q:'$G(PREG) "UNKNOWN"
|
||
|
|
Q:'$D(^WV(790.03,PREG,0)) "PAP REGIMEN MISSING"
|
||
|
|
Q $P(^WV(790.03,PREG,0),U)
|
||
|
|
;
|
||
|
|
CNEED(DFN,TXDT) ;PEP
|
||
|
|
;---> YIELD PATIENT'S CX TX NEED AND CX TX NEED DUE DATE.
|
||
|
|
;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
|
||
|
|
;---> OPTIONAL VARIABLE: TXDT=1 IF DATE SHOULD BE TEXT FORMAT.
|
||
|
|
N X,Y
|
||
|
|
Q:'$G(DFN) "NO PATIENT"
|
||
|
|
Q:'$D(^WV(790,DFN,0)) "UNKNOWN"
|
||
|
|
S Y=$P(^WV(790,DFN,0),U,11)
|
||
|
|
Q:'Y "UNKNOWN"
|
||
|
|
Q:'$D(^WV(790.5,Y,0)) "UNKNOWN"
|
||
|
|
S X=$P(^WV(790,DFN,0),U,12) D Z(.X,$G(TXDT))
|
||
|
|
Q $E($P(^WV(790.5,Y,0),U),1,22)_" (by "_X_")"
|
||
|
|
;
|
||
|
|
BNEED(DFN,TXDT) ;PEP
|
||
|
|
;---> YIELD PATIENT'S BR TX NEED AND BR TX NEED DUE DATE.
|
||
|
|
;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
|
||
|
|
;---> OPTIONAL VARIABLE: TXDT=1 IF DATE SHOULD BE TEXT FORMAT.
|
||
|
|
N X,Y,Z
|
||
|
|
Q:'$G(DFN) "NO PATIENT"
|
||
|
|
Q:'$D(^WV(790,DFN,0)) "UNKNOWN"
|
||
|
|
S Y=$P(^WV(790,DFN,0),U,18)
|
||
|
|
Q:'Y "UNKNOWN"
|
||
|
|
Q:'$D(^WV(790.51,Y,0)) "UNKNOWN"
|
||
|
|
S X=$P(^WV(790,DFN,0),U,19) D Z(.X,$G(TXDT))
|
||
|
|
Q $E($P(^WV(790.51,Y,0),U),1,22)_" (by "_X_")"
|
||
|
|
;
|
||
|
|
DES(DFN) ;EP
|
||
|
|
;---> YIELD PATIENT'S STATUS AS A DES DAUGHTER: 1=YES, 0=NO.
|
||
|
|
;---> DFN=IEN PATIENT FILE
|
||
|
|
Q:'$G(DFN) "NO PATIENT"
|
||
|
|
Q:'$D(^WV(790,DFN,0)) "NO RECORD"
|
||
|
|
I '$$VFIELD^DILFD(790,.15) Q "^DD MISSING"
|
||
|
|
S X=$P(^WV(790,DFN,0),U,15)
|
||
|
|
Q:X="" ""
|
||
|
|
Q $$EXTERNAL^DILFD(790,.15,"",X)
|
||
|
|
;
|
||
|
|
FAMHX(DFN) ;EP
|
||
|
|
;---> RETURN FAMILY HISTORY OF BREAST CANCER.
|
||
|
|
;---> DFN=IEN PATIENT FILE
|
||
|
|
N X
|
||
|
|
Q:'$G(DFN) "NO PATIENT"
|
||
|
|
Q:'$D(^WV(790,DFN,0)) "NO RECORD"
|
||
|
|
I '$$VFIELD^DILFD(790,.23) Q "^DD MISSING"
|
||
|
|
S X=$P(^WV(790,DFN,0),U,23)
|
||
|
|
Q:X="" ""
|
||
|
|
Q $$EXTERNAL^DILFD(790,.23,"",X)
|
||
|
|
;
|
||
|
|
REFS(DFN) ;EP
|
||
|
|
;---> RETURN REFERRAL SOURCE FOR THIS PATIENT.
|
||
|
|
;---> DFN=IEN PATIENT FILE
|
||
|
|
Q:'$G(DFN) "NO PATIENT"
|
||
|
|
Q:'$D(^WV(790,DFN,0)) "UNKNOWN"
|
||
|
|
I '$$VFIELD^DILFD(790,.22) Q "^DD MISSING"
|
||
|
|
S X=$P(^WV(790,DFN,0),U,22) S:X>0 X=$P($G(^WV(790.07,X,0)),U)
|
||
|
|
Q X
|
||
|
|
;
|
||
|
|
ENRLDT(DFN,TXDT) ;PEP
|
||
|
|
;---> YIELD PATIENT'S ENROLLMENT DATE.
|
||
|
|
;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
|
||
|
|
;---> OPTIONAL VARIABLE: TXDT=1 IF DATE SHOULD BE IN TEXT FORMAT.
|
||
|
|
N X
|
||
|
|
Q:'$G(DFN) "NO PATIENT"
|
||
|
|
Q:'$D(^WV(790,DFN,0)) "UNKNOWN"
|
||
|
|
S X=$P(^WV(790,DFN,0),U,21)
|
||
|
|
Q:'X "" D Z(.X,$G(TXDT))
|
||
|
|
Q X
|
||
|
|
;
|
||
|
|
Z(X,Z) ;EP
|
||
|
|
;---> SET Z = NUMERIC (1/1/95) OR TEXT (JAN 1,1995) FORMAT OF DATE.
|
||
|
|
;---> REQUIRED VARIABLE: X=FILEMAN INTERNAL DATE FORMAT.
|
||
|
|
;---> OPTIONAL VARIABLE: Z=1 IF TEXT, 0/"" IF NUMERIC.
|
||
|
|
S X=$S($G(Z):$$TXDT^WVUTL5(X),1:$$SLDT2^WVUTL5(X))
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
;
|
||
|
|
ACC(IEN) ;EP
|
||
|
|
;---> ACCESSION#; CONCATENATE SCREENING PAP IF IT EXISTS.
|
||
|
|
;---> IEN=IEN IN WV PROCEDURE FILE #790.1).
|
||
|
|
Q:'$G(IEN) "NO PROC"
|
||
|
|
Q:'$D(^WV(790.1,IEN,0)) "NO PROC"
|
||
|
|
N X S X=$P(^WV(790.1,IEN,0),U,30)
|
||
|
|
I X]"" I $D(^WV(790.1,X,0)) S X=$P(^WV(790.1,X,0),U),X=","_X
|
||
|
|
Q $E($P(^WV(790.1,IEN,0),U)_X,1,19)
|