WVUTL1 ;HCIOFO/FT,JR - UTIL: MOSTLY PATIENT DATA;Oct 19, 2020@14:48
;;1.0;WOMEN'S HEALTH;**7,24,26**;Sep 30, 1998;Build 624
;; 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)
;
MCMGR(DFN) ;EP
;---> YIELD PATIENT'S MATERNITY CARE COORDINATOR
;---> 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,29)
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,WVRETNOT) ;EP
;---> YIELD IF PATIENT IS PREGNANT, AND EDD.
;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
;---> OPTIONAL VARIABLE: WVRETNOT=1 TO RETURN STATUSES OTHER THAN PREGNANT
N WVDATE,WVIEN,WVRETURN,X,WVERROR
Q:'$G(DFN) "NO PATIENT"
Q:'$D(^WV(790,DFN,0)) "UNKNOWN"
S WVIEN=+$$GETLREC^WVUTL11(DFN,4),WVRETURN=""
S:WVIEN>0 WVRETURN=$$EXTERNAL^DILFD(790.05,21,"",$P($G(^WV(790,DFN,4,WVIEN,2)),U),"WVERROR")
I WVRETURN="PREGNANT" D Q WVRETURN
.S X=+$P($G(^WV(790,DFN,4,WVIEN,4)),U,2)
.S WVRETURN=WVRETURN_", EDD: "
.S WVRETURN=WVRETURN_$S(X>0:$$SLDT2^WVUTL5(X),1:"NO DATE ")_" "
I WVRETURN'="PREGNANT" D Q WVRETURN
.I $G(WVRETNOT) S WVRETURN=$S(WVRETURN["NOT":"NO",1:WVRETURN)
.E S WVRETURN=""
Q WVRETURN
;
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)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVUTL1 8324 printed Dec 13, 2024@02:48:07 Page 2
WVUTL1 ;HCIOFO/FT,JR - UTIL: MOSTLY PATIENT DATA;Oct 19, 2020@14:48
+1 ;;1.0;WOMEN'S HEALTH;**7,24,26**;Sep 30, 1998;Build 624
+2 ;; Original routine created by IHS/ANMC/MWR
+3 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
+4 ;; UTILITY: PATIENT DEMOGRAPHICS, NEEDS, AND REGIMENS.
+5 ;; ALSO DISPLAY PRIORITY, PROCEDURE TYPE.
+6 ;
+7 ;
NAME(DFN) ;EP
+1 ;---> PATIENT NAME.
+2 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
+3 if '$GET(DFN)
QUIT "NO PATIENT"
+4 if '$DATA(^DPT(DFN,0))
QUIT "UNKNOWN"
+5 QUIT $PIECE(^DPT(DFN,0),U)
+6 ;
DOB(DFN) ;EP
+1 ;---> RETURN PATIENT'S DATE OF BIRTH IN FILEMAN FORMAT.
+2 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
+3 if '$GET(DFN)
QUIT "NO PATIENT"
+4 if '$PIECE($GET(^DPT(DFN,0)),U,3)
QUIT "UNKNOWN"
+5 QUIT $PIECE(^DPT(DFN,0),U,3)
+6 ;
+7 ;
AGE(DFN) ;EP
+1 ;---> YIELD PATIENT'S AGE IN YEARS.
+2 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
+3 NEW X,X1,X2
+4 if '$GET(DFN)
QUIT "NO PATIENT"
+5 SET X2=$$DOB(DFN)
+6 if '+X2
QUIT "UNKNOWN"
+7 IF $$DECEASED(DFN)
QUIT "DECEASED: "_$$SLDT2^WVUTL5(+^DPT(DFN,.35))
+8 SET X1=DT
+9 DO ^%DTC
+10 QUIT $PIECE(X/365.25,".")_"y/o"
+11 ;
DECEASED(DFN) ;EP
+1 ;---> RETURN 1 IF PATIENT IS DECEASED, 0 IF NOT DECEASED.
+2 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
+3 if '$GET(DFN)
QUIT 0
+4 if '$DATA(^DPT(DFN,.35))
QUIT 0
+5 if '+^DPT(DFN,.35)
QUIT 0
+6 QUIT 1
+7 ;
SEX(DFN) ;EP
+1 ;---> RETURN 1 IF PATIENT IS FEMALE.
+2 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
+3 if '$GET(DFN)
QUIT ""
+4 if '$DATA(^DPT(DFN,0))
QUIT ""
+5 if $PIECE(^DPT(DFN,0),U,2)'="F"
QUIT ""
+6 QUIT 1
+7 ;
INACT(DFN) ;EP
+1 ;---> DATE THIS PATIENT BECAME INACTIVE
+2 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
+3 if '$GET(DFN)
QUIT "NO PATIENT"
+4 if '$DATA(^DPT(DFN,0))
QUIT "UNKNOWN"
+5 QUIT $PIECE(^WV(790,DFN,0),U,24)
+6 ;
AGEAT(DFN,DATE) ;EP
+1 ;---> YIELD PATIENT'S AGE IN YEARS AT GIVEN DATE.
+2 ;---> REQUIRED VARIABLE: DFN =IEN PATIENT FILE
+3 ;---> DATE=DATE AT WHICH AGE IS DESIRED.
+4 NEW X,X1,X2
+5 if '$GET(DFN)
QUIT "NO PATIENT"
+6 if '$GET(DATE)
QUIT "NO DATE"
+7 SET X2=$$DOB(DFN)
+8 if '+X2
QUIT "UNKNOWN"
+9 SET X1=DATE
+10 DO ^%DTC
+11 QUIT $PIECE(X/365.25,".")_"y/o"
+12 ;
NAMAGE(DFN) ;EP
+1 ;---> PATIENT NAME CONCAT WITH AGE.
+2 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
+3 if '$GET(DFN)
QUIT "NO PATIENT"
+4 QUIT $$NAME(DFN)_" ("_$$AGE(DFN)_")"
+5 ;
SSN(DFN) ;EP
+1 ;---> SOCIAL SECURITY NUMBER.
+2 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
+3 NEW X
+4 if '$GET(DFN)
QUIT "NO PATIENT"
+5 if '$DATA(^DPT(DFN,0))
QUIT "UNKNOWN"
+6 SET X=$PIECE(^DPT(DFN,0),U,9)
+7 if X']""
QUIT "UNKNOWN"
+8 SET X=$EXTRACT(X,1,3)_"-"_$EXTRACT(X,4,5)_"-"_$EXTRACT(X,6,9)
+9 QUIT X
+10 ;
HRCN(DFN) ;EP
+1 ;---> RETURN SSN.
+2 ;---> REQUIRED VARIABLE: DFN
+3 QUIT $$SSN(DFN)
+4 ;
HPHONE(DFN) ;EP
+1 ;---> GET HOME PHONE#.
+2 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
+3 NEW WVPHONE
+4 if '$GET(DFN)
QUIT "NO PATIENT"
+5 SET WVPHONE=$$GET1^DIQ(2,DFN,.131,"I")
+6 if WVPHONE=""
QUIT "UNKNOWN"
+7 QUIT WVPHONE
+8 ;
STREET(DFN) ;EP
+1 ;---> GET STREET ADDRESS.
+2 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
+3 if '$GET(DFN)
QUIT "NO PATIENT"
+4 NEW WVADDR
+5 SET WVADDR=$$GET1^DIQ(2,DFN,.111,"I")
+6 if WVADDR=""
QUIT "UNKNOWN"
+7 QUIT WVADDR
+8 ;
CITY(DFN) ;EP
+1 ;---> GET CITY ADDRESS.
+2 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
+3 if '$GET(DFN)
QUIT "NO PATIENT"
+4 NEW WVCITY
+5 SET WVCITY=$$GET1^DIQ(2,DFN,.114,"I")
+6 if WVCITY=""
QUIT "UNKNOWN"
+7 QUIT WVCITY
+8 ;
STATE(DFN) ;EP
+1 ;---> GET STATE ADDRESS.
+2 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
+3 if '$GET(DFN)
QUIT "NO PATIENT"
+4 NEW WVSTATE
+5 SET WVSTATE=$$GET1^DIQ(2,DFN,.115,"I")
+6 if WVSTATE=""
QUIT "UNKNOWN"
+7 SET WVSTATE=$$GET1^DIQ(5,WVSTATE,1,"I")
if WVSTATE=""
SET WVSTATE="UNKNOWN"
+8 QUIT WVSTATE
+9 ;
ZIP(DFN) ;EP
+1 ;---> GET ZIPCODE ADDRESS.
+2 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
+3 if '$GET(DFN)
QUIT "NO PATIENT"
+4 NEW WVZIP
+5 SET WVZIP=$$GET1^DIQ(2,DFN,.116,"I")
+6 if WVZIP'>0
QUIT "UNKNOWN"
+7 QUIT WVZIP
+8 ;
CTYSTZ(DFN) ;EP
+1 ;---> GET ZIPCODE ADDRESS.
+2 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
+3 if '$GET(DFN)
QUIT "NO PATIENT"
+4 QUIT $$CITY(DFN)_", "_$$STATE(DFN)_" "_$$ZIP(DFN)
+5 ;
CMGR(DFN) ;EP
+1 ;---> YIELD PATIENT'S CASE MANAGER.
+2 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
+3 NEW X
+4 if '$GET(DFN)
QUIT "NO PATIENT"
+5 if '$DATA(^WV(790,DFN,0))
QUIT "UNKNOWN"
+6 SET X=$PIECE(^WV(790,DFN,0),U,10)
+7 QUIT $$PERSON(X)
+8 ;
MCMGR(DFN) ;EP
+1 ;---> YIELD PATIENT'S MATERNITY CARE COORDINATOR
+2 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
+3 NEW X
+4 if '$GET(DFN)
QUIT "NO PATIENT"
+5 if '$DATA(^WV(790,DFN,0))
QUIT "UNKNOWN"
+6 SET X=$PIECE(^WV(790,DFN,0),U,29)
+7 QUIT $$PERSON(X)
PERSON(X) ;EP
+1 ;---> RETURN PERSON'S NAME FROM FILE #200.
+2 NEW WVNAME
+3 if 'X
QUIT "UNKNOWN"
+4 SET WVNAME=$$GET1^DIQ(200,X,.01,"E")
+5 QUIT $SELECT(WVNAME'="":WVNAME,1:"UNKNOWN")
+6 ;
EDC(DFN,WVRETNOT) ;EP
+1 ;---> YIELD IF PATIENT IS PREGNANT, AND EDD.
+2 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
+3 ;---> OPTIONAL VARIABLE: WVRETNOT=1 TO RETURN STATUSES OTHER THAN PREGNANT
+4 NEW WVDATE,WVIEN,WVRETURN,X,WVERROR
+5 if '$GET(DFN)
QUIT "NO PATIENT"
+6 if '$DATA(^WV(790,DFN,0))
QUIT "UNKNOWN"
+7 SET WVIEN=+$$GETLREC^WVUTL11(DFN,4)
SET WVRETURN=""
+8 if WVIEN>0
SET WVRETURN=$$EXTERNAL^DILFD(790.05,21,"",$PIECE($GET(^WV(790,DFN,4,WVIEN,2)),U),"WVERROR")
+9 IF WVRETURN="PREGNANT"
Begin DoDot:1
+10 SET X=+$PIECE($GET(^WV(790,DFN,4,WVIEN,4)),U,2)
+11 SET WVRETURN=WVRETURN_", EDD: "
+12 SET WVRETURN=WVRETURN_$SELECT(X>0:$$SLDT2^WVUTL5(X),1:"NO DATE ")_" "
End DoDot:1
QUIT WVRETURN
+13 IF WVRETURN'="PREGNANT"
Begin DoDot:1
+14 IF $GET(WVRETNOT)
SET WVRETURN=$SELECT(WVRETURN["NOT":"NO",1:WVRETURN)
+15 IF '$TEST
SET WVRETURN=""
End DoDot:1
QUIT WVRETURN
+16 QUIT WVRETURN
+17 ;
PAPRG(DFN,TXDT) ;EP
+1 ;---> YIELD PATIENT'S PAP REGIMEN AND DATE IT BEGAN.
+2 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
+3 ;---> OPTIONAL VARIABLE: TXDT=1 IF DATE SHOULD BE TEXT FORMAT.
+4 NEW Y,X
+5 if '$GET(DFN)
QUIT "NO PATIENT"
+6 if '$DATA(^WV(790,DFN,0))
QUIT "UNKNOWN"
+7 SET Y=$PIECE(^WV(790,DFN,0),U,16)
+8 SET X=$PIECE(^WV(790,DFN,0),U,17)
DO Z(.X,$GET(TXDT))
+9 QUIT $$PAPRG1(Y)_" (began "_X_")"
+10 ;
PAPRG1(PREG) ;EP
+1 ;---> YIELD PATIENT'S PAP REGIMEN.
+2 ;---> REQUIRED VARIABLE: PREG=IEN IN WV PAP REGIMEN FILE #790.03.
+3 if '$GET(PREG)
QUIT "UNKNOWN"
+4 if '$DATA(^WV(790.03,PREG,0))
QUIT "PAP REGIMEN MISSING"
+5 QUIT $PIECE(^WV(790.03,PREG,0),U)
+6 ;
CNEED(DFN,TXDT) ;PEP
+1 ;---> YIELD PATIENT'S CX TX NEED AND CX TX NEED DUE DATE.
+2 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
+3 ;---> OPTIONAL VARIABLE: TXDT=1 IF DATE SHOULD BE TEXT FORMAT.
+4 NEW X,Y
+5 if '$GET(DFN)
QUIT "NO PATIENT"
+6 if '$DATA(^WV(790,DFN,0))
QUIT "UNKNOWN"
+7 SET Y=$PIECE(^WV(790,DFN,0),U,11)
+8 if 'Y
QUIT "UNKNOWN"
+9 if '$DATA(^WV(790.5,Y,0))
QUIT "UNKNOWN"
+10 SET X=$PIECE(^WV(790,DFN,0),U,12)
DO Z(.X,$GET(TXDT))
+11 QUIT $EXTRACT($PIECE(^WV(790.5,Y,0),U),1,22)_" (by "_X_")"
+12 ;
BNEED(DFN,TXDT) ;PEP
+1 ;---> YIELD PATIENT'S BR TX NEED AND BR TX NEED DUE DATE.
+2 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
+3 ;---> OPTIONAL VARIABLE: TXDT=1 IF DATE SHOULD BE TEXT FORMAT.
+4 NEW X,Y,Z
+5 if '$GET(DFN)
QUIT "NO PATIENT"
+6 if '$DATA(^WV(790,DFN,0))
QUIT "UNKNOWN"
+7 SET Y=$PIECE(^WV(790,DFN,0),U,18)
+8 if 'Y
QUIT "UNKNOWN"
+9 if '$DATA(^WV(790.51,Y,0))
QUIT "UNKNOWN"
+10 SET X=$PIECE(^WV(790,DFN,0),U,19)
DO Z(.X,$GET(TXDT))
+11 QUIT $EXTRACT($PIECE(^WV(790.51,Y,0),U),1,22)_" (by "_X_")"
+12 ;
DES(DFN) ;EP
+1 ;---> YIELD PATIENT'S STATUS AS A DES DAUGHTER: 1=YES, 0=NO.
+2 ;---> DFN=IEN PATIENT FILE
+3 if '$GET(DFN)
QUIT "NO PATIENT"
+4 if '$DATA(^WV(790,DFN,0))
QUIT "NO RECORD"
+5 IF '$$VFIELD^DILFD(790,.15)
QUIT "^DD MISSING"
+6 SET X=$PIECE(^WV(790,DFN,0),U,15)
+7 if X=""
QUIT ""
+8 QUIT $$EXTERNAL^DILFD(790,.15,"",X)
+9 ;
FAMHX(DFN) ;EP
+1 ;---> RETURN FAMILY HISTORY OF BREAST CANCER.
+2 ;---> DFN=IEN PATIENT FILE
+3 NEW X
+4 if '$GET(DFN)
QUIT "NO PATIENT"
+5 if '$DATA(^WV(790,DFN,0))
QUIT "NO RECORD"
+6 IF '$$VFIELD^DILFD(790,.23)
QUIT "^DD MISSING"
+7 SET X=$PIECE(^WV(790,DFN,0),U,23)
+8 if X=""
QUIT ""
+9 QUIT $$EXTERNAL^DILFD(790,.23,"",X)
+10 ;
REFS(DFN) ;EP
+1 ;---> RETURN REFERRAL SOURCE FOR THIS PATIENT.
+2 ;---> DFN=IEN PATIENT FILE
+3 if '$GET(DFN)
QUIT "NO PATIENT"
+4 if '$DATA(^WV(790,DFN,0))
QUIT "UNKNOWN"
+5 IF '$$VFIELD^DILFD(790,.22)
QUIT "^DD MISSING"
+6 SET X=$PIECE(^WV(790,DFN,0),U,22)
if X>0
SET X=$PIECE($GET(^WV(790.07,X,0)),U)
+7 QUIT X
+8 ;
ENRLDT(DFN,TXDT) ;PEP
+1 ;---> YIELD PATIENT'S ENROLLMENT DATE.
+2 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
+3 ;---> OPTIONAL VARIABLE: TXDT=1 IF DATE SHOULD BE IN TEXT FORMAT.
+4 NEW X
+5 if '$GET(DFN)
QUIT "NO PATIENT"
+6 if '$DATA(^WV(790,DFN,0))
QUIT "UNKNOWN"
+7 SET X=$PIECE(^WV(790,DFN,0),U,21)
+8 if 'X
QUIT ""
DO Z(.X,$GET(TXDT))
+9 QUIT X
+10 ;
Z(X,Z) ;EP
+1 ;---> SET Z = NUMERIC (1/1/95) OR TEXT (JAN 1,1995) FORMAT OF DATE.
+2 ;---> REQUIRED VARIABLE: X=FILEMAN INTERNAL DATE FORMAT.
+3 ;---> OPTIONAL VARIABLE: Z=1 IF TEXT, 0/"" IF NUMERIC.
+4 SET X=$SELECT($GET(Z):$$TXDT^WVUTL5(X),1:$$SLDT2^WVUTL5(X))
+5 QUIT
+6 ;
+7 ;
ACC(IEN) ;EP
+1 ;---> ACCESSION#; CONCATENATE SCREENING PAP IF IT EXISTS.
+2 ;---> IEN=IEN IN WV PROCEDURE FILE #790.1).
+3 if '$GET(IEN)
QUIT "NO PROC"
+4 if '$DATA(^WV(790.1,IEN,0))
QUIT "NO PROC"
+5 NEW X
SET X=$PIECE(^WV(790.1,IEN,0),U,30)
+6 IF X]""
IF $DATA(^WV(790.1,X,0))
SET X=$PIECE(^WV(790.1,X,0),U)
SET X=","_X
+7 QUIT $EXTRACT($PIECE(^WV(790.1,IEN,0),U)_X,1,19)
