source: FOIAVistA/trunk/r/WOMENS_HEALTH-WV/WVUTL1.m@ 1397

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)