VENPCC1D ; IHS/OIT/GIS - HEALTH MAINTENANCE REMINDERS FOR ENCOUNTER FORMS ;
;;2.6;PCC+;;NOV 12, 2007
; MOST OF THIS CODE IS NO LONGER USED DUE TO UPDATED HEATH MAINTENANCE REMINDERS IN VER 2.2
;
;
OUT(TITLE,FN,TYPE,DFN) ; EP-OUTPUT FORMATTER FOR HEALTH MAINTENANCE REMINDERS
I $L(FN),$L(TYPE),$D(^DPT(+$G(DFN),0))
E Q ""
N X
S X=$$HMR(FN,TYPE,DFN)
I X="" S:$G(TITLE)'="" FN=TITLE Q "Last "_FN_": Unknown"
S X=$$FORM($G(TITLE),FN,X)
Q X
;
IEN(FN,TYPE,DFN) ; EP-CONVERTS DFN TO IEN FOR ANY FILE NAME FOR V FILES
I $L($G(FN)),$L($G(TYPE)),+$G(DFN)
E Q ""
N DIC,X,Y,%,FIEN,FOR,TIEN,I
S DIC=1,X=FN,DIC(0)="" D ^DIC I Y=-1 Q ""
S FIEN=+Y
S %=$P($G(^DD(FIEN,.01,0)),U,2)
S FOR=$G(^DIC(FIEN,0,"GL")) I '$L(FOR) Q ""
F I=1:1 Q:'$L(%) S X=$E(%) S:X'?1N %=$E(%,2,999) I X S %=+% Q
I '% Q ""
S DIC=%,DIC(0)="",X=TYPE S:FN["V IMM" DIC(0)="M" D ^DIC I Y=-1 Q ""
S TIEN=+Y
I FN="V MED" G MED
S X=FOR_"""AA"","_DFN_","_TIEN_",0)"
S Y=$O(@X) I 'Y Q ""
S X=FOR_"""AA"","_DFN_","_TIEN_","_Y_",0)"
S Y=$O(@X)
Q Y_U_FIEN
;
MED ; EP-FIELD IEN
N STOP S STOP=""
S Y=0 F Q:STOP S Y=$O(^AUPNVMED("AA",DFN,Y)) Q:'Y S IEN=0 F S IEN=$O(^AUPNVMED("AA",DFN,Y,IEN)) Q:'IEN I $P($G(^AUPNVMED(IEN,0)),U)=TIEN S STOP=IEN Q
I 'STOP Q ""
Q STOP_U_FIEN
;
DATE(X) ; EP-RETURN THE DATE GIVEN THE ZERO NODE OF A V FILE
N VIEN,Y
S VIEN=$P(X,U,3) I 'VIEN Q ""
S Y=$P($G(^AUPNVSIT(VIEN,0)),U) I 'Y Q ""
S Y=Y\1 S Y=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)
Q Y
;
HMR(FN,TYPE,DFN) ; EP-RETURN HEALTH MAINTRNANCE REMINDERS
; FILE NAME,EVENT NAME,DFN (INPUT)
; DATE^RESULT^ABNORMAL FLAG (OUTPUT)^MODIFIER
I $L($G(FN)),$L($G(TYPE)),+$G(DFN)
E Q ""
N REC,IEN,DATE,%,X,Y,FIEN
S REC=$$IEN(FN,TYPE,DFN) I '$L(REC) Q ""
S IEN=+REC,FIEN=$P(REC,U,2)
I FN="V MED" S X=$G(^AUPNVMED(IEN,0)) I $L(X) D Q Y ; MEDICATION
. S DATE=$$DATE(X) I '$L(DATE) S Y="" Q
. S Y=DATE
. Q
I FN="V EXAM" S X=$G(^AUPNVXAM(IEN,0)) I $L(X) D Q Y ; EXAM
. S DATE=$$DATE(X) I '$L(DATE) S Y="" Q
. S %=$P(X,U,4) S %=$S(%="A":"Abnl",%="N":"Nl",1:"")
. S Y=DATE_"^^"_%
. Q
I FN="V LAB" S X=$G(^AUPNVLAB(IEN,0)) I $L(X) D Q Y ; LAB TEST RESULT
. S DATE=$$DATE(X) I '$L(DATE) S Y="" Q
. S Y=DATE_U_$P(X,U,4,5)
. Q
I FN="V RADIOLOGY" S X=$G(^AUPNVRAD(IEN,0)) I $L(X) D Q Y ; RADIOLOGY
. S DATE=$$DATE(X) I '$L(DATE) S Y="" Q
. S %=$P(X,U,5) S %=$S(%=0:"Nl",%=1:"Abnl",1:"")
. S Y=DATE_"^^"_%
. Q
I FN="V IMMUNIZATION" S X=$G(^AUPNVIMM(IEN,0)) I $L(X) D Q Y ; IMMUNIZATION
. S DATE=$$DATE(X) I '$L(DATE) S Y="" Q
. S %=$P(X,U,7) S %=$S(%=1:"Do not use!",1:"")
. S Y=DATE_"^^"_%_U_$P(X,U,4)
. Q
I FN="V SKIN TEST" S X=$G(^AUPNVSK(IEN,0)) I $L(X) D Q Y ; SKIN TEST
. S DATE=$$DATE(X) I '$L(DATE) S Y="" Q
. S %=$P(X,U,4) S %=$S(%="P":"Pos",%="N":"Neg",1:"?")
. S Y=DATE_U_$P(X,U,5)_"mm"_U_%
. Q
Q ""
;
FORM(TITLE,FN,X) ; PRELIMINARY OUTPUT FORMATTING
I '$L(X) Q ""
I '$L(TITLE),'$L(FN) Q ""
I $L(TITLE) S FN=TITLE
S FN=FN I $L($P(X,U,4)) S FN=FN_"("_$P(X,U,4)_")"
S %="Last "_FN_": "_$P(X,U)
I $P(X,U,2)'="" S %=%_" ("_$P(X,U,2)
I $P(X,U,3)'="" S %=%_" - "_$P(X,U,3)
I $P(X,U,2)'="" S %=%_")"
Q %
;
PAP(DFN) ; EP-GIVEN DFN, RETURN LAST PAP h1
Q $$OUT("PAP","V LAB","PAP SMEAR",+$G(DFN))
;
GLUC(DFN) ; EP-GIVEN DFN, RETURN LAST GLUCOSE h2
Q $$OUT("GLUCOSE","V LAB","GLUCOSE",+$G(DFN))
;
PPD(DFN) ; EP-GIVEN DFN, RETURN THE LAST PPD SKIN TEST h3
Q $$OUT("PPD","V SKIN TEST","PPD",+$G(DFN))
;
MAMMO(DFN) ; EP-GIVEN A DFN, RETURN THE LAST MAMMOGRAM h4
N % S %=$O(^APCHSURV("B","MAMMOGRAM",0))
I %,$L($T(INAC^APCHSMU)),$$INAC^APCHSMU(%),$O(^BWPCD(0))
E Q $$OUT("MAMMO","V RADIOLOGY","MAMMOGRAM BILAT",+$G(DFN))
N IDATE,STOP,PIEN,%,DATE,RES,Y,Z
S IDATE=0,STOP=""
F S IDATE=$O(^BWPCD("AA",DFN,IDATE)) Q:'IDATE Q:STOP S PIEN=0 F S PIEN=$O(^BWPCD("AA",DFN,IDATE,PIEN)) Q:'PIEN D I STOP Q
. S %=$P($G(^BWPCD(PIEN,0)),U,4)
. I %'=25,%'=26,%'=28 Q
. S STOP=PIEN
. Q
I 'STOP Q "Last MAMMO: Unknown"
S DATE=$P($G(^BWPCD(STOP,0)),U,3),RES=$P(^(0),U,5)
I 'DATE Q "Last MAMMO: Unknown"
S Y=DATE,Y=Y\1 S DATE=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)
I RES S RES=$P($G(^BWDIAG(RES,0)),U) S RES=$S('$L(RES):"",RES["Negative"!(RES["Normal"):"Nl",1:"Abnl")
S Z="Last MAMMO: "_DATE I $L($G(RES)) S Z=Z_" - "_RES
Q Z
;
PELVIC(DFN) ; EP-GIVEN DFN, RETURN THE LAST PELVIC EXAM h5
Q $$OUT("PELVIC","V EXAM","PELVIC EXAM",+$G(DFN))
;
BREAST(DFN) ; EP-GIVEN DFN, RETURN THE LAST BREAST EXAM h6
Q $$OUT("BREAST EXAM","V EXAM","BREAST EXAM",+$G(DFN))
;
RECTAL(DFN) ; EP-GIVEN DFN, RETURNT THE LAST RECTAL EXAM h7
Q $$OUT("RECTAL EXAM","V EXAM","RECTAL EXAM",+$G(DFN))
;
PROST(DFN) ; EP-GIVEN DFN, RETURN THE LAST PROSTATE EXAM h8
Q $$OUT("PROSTATE EXAM","V EXAM","RECTAL EXAM",+$G(DFN))
;
PN(DFN) ; EP-GIVEN DFN, RETURN THE LAST PNEUMOVAX h9
Q $$OUT("PNEUMOVAX","V IMMUNIZATION","19",+$G(DFN))
;
FLU(DFN) ; EP-GIVEN DFN, RETURN THE LAST FLU SHOT h10
Q $$OUT("FLU","V IMMUNIZATION","12",+$G(DFN))
;
TD(DFN) ; EP-GIVEN DFN, RETURN THE LAST TETANUS SHOT h11
Q $$OUT("TD","V IMMUNIZATION","28",+$G(DFN))
;
DPRV(DFN) ; EP-GIVEN DFN, RETURN THE DESIGNATED PROVIDER x29
N PRV
S PRV=$P($G(^AUPNPAT(DFN,0)),U,14)
I PRV,$G(^DD(9000001,.14,0))["VA(200" S PRV=$P($G(^VA(200,+PRV,0)),U) I $L(PRV) S PRV=$P(PRV,",",2)_" "_$P(PRV,",")
E S %=U_"DIC("_16_")",PRV=$P($G(@%@(+PRV,0)),U) I $L(PRV) S PRV=$P(PRV,",",2)_" "_$P(PRV,",")
I PRV="" S PRV="Unknown"
Q "PCP: "_PRV
;
DPT(DFN) ; EP-GIVEN DFN, RETURN THE LAST DPT h12
Q $$OUT("DPT","V IMMUNIZATION","1",+$G(DFN))
;
OPV(DFN) ; EP-GIVEN DFN, RETURN THE LAST OPV h13
Q $$OUT("OPV","V IMMUNIZATION","2",+$G(DFN))
;
POLIO(DFN) ; EP-GIVEN DFN, RETURN THE LAST POLIO VACCINE h14
Q $$OUT("POLIO","V IMMUNIZATION","10",+$G(DFN))
;
HEPB(DFN) ; EP-GIVEN THE DFN, RETURN THE LAST HEPATITIS B VACCINE h15
Q $$OUT("HEP-B","V IMMUNIZATION","45",+$G(DFN))
;
MEASL(DFN) ; EP-GIVEN THE DFN, RETURN THE LAST MEASLES VACCINE h16
Q $$OUT("MEASLES","V IMMUNIZATION","5",+$G(DFN))
;
RUB(DFN) ; EP-GIVEN DFN, RETURN THE LAST RUBELLA VACCINE h17
Q $$OUT("RUBELLA","V IMMUNIZATION","6",+$G(DFN))
;
MUM(DFN) ; EP-GIVEN DFN, RETURN THE LAST MUMPS VACCINE h18
Q $$OUT("MUMPS","V IMMUNIZATION","7",+$G(DFN))
;
MMR(DFN) ; EP-GIVEN DFN, RETURN THE LAST MMR VACCINE h19
Q $$OUT("MMR","V IMMUNIZATION","3",+$G(DFN))
;
MR(DFN) ; EP-GIVEN DFN, RETURN THE LAST MR VACCINE h20
Q $$OUT("MR","V IMMUNIZATION","4",+$G(DFN))
;
HFLU47(DFN) ; EP-GIVEN DFN, RETURN THE LAST HFLU47 VAVVINE h21
Q $$OUT("H-FLU","V IMMUNIZATION","47",+$G(DFN))
;
HFLU48(DFN) ; EP-GIVEN DFN, RETURN THE LAST HFLU48 VACCINE h22
Q $$OUT("H-FLU","V IMMUNIZATION","48",+$G(DFN))
;
HFLU49(DFN) ; EP-GIVEN DFN, RETURN THE LAST HFLU49 VACCINE h23
Q $$OUT("H-FLU","V IMMUNIZATION","49",+$G(DFN))
;
HEPA(DFN) ; EP-GIVEN DFN, RETURN THE LAST HEPATITIS A VACCINE h24
Q $$OUT("HEP-A","V IMMUNIZATION","85",+$G(DFN))
;
CPOX(DFN) ; EP-GIVEN DFN, RETURN THE LAST VARICELLA VACCINE h25
Q $$OUT("CPOC","V IMMUNIZATION","21",+$G(DFN))
;
DTAP(DFN) ; EP-GIVEN DFN, RETURN THE LAST DTAP VACCINE h26
Q $$OUT("DTaP","V IMMUNIZATION","20",+$G(DFN))
;
FEMU50(DFN) ; EP-EN UNDER 50
N AGE,DOB,SEX,X
S X=$G(^DPT(+$G(DFN),0)) I X="" Q 0
S SEX=$P(X,U,2),DOB=$P(X,U,3)
I $L(SEX),DOB
E Q 0
S AGE=(DT-DOB)\10000
I AGE<50,SEX="F" Q 1
Q 0
;
FEM40(DFN) ; EP-WOMEN OVER 40
N AGE,DOB,SEX,X
S X=$G(^DPT(+$G(DFN),0)) I X="" Q 0
S SEX=$P(X,U,2),DOB=$P(X,U,3)
I $L(SEX),DOB
E Q 0
S AGE=(DT-DOB)\10000
I AGE>39,SEX="F" Q 1
Q 0
;
VENPCC1D ; IHS/OIT/GIS - HEALTH MAINTENANCE REMINDERS FOR ENCOUNTER FORMS ;
+1 ;;2.6;PCC+;;NOV 12, 2007
+2 ; MOST OF THIS CODE IS NO LONGER USED DUE TO UPDATED HEATH MAINTENANCE REMINDERS IN VER 2.2
+3 ;
+4 ;
OUT(TITLE,FN,TYPE,DFN) ; EP-OUTPUT FORMATTER FOR HEALTH MAINTENANCE REMINDERS
+1 IF $LENGTH(FN)
IF $LENGTH(TYPE)
IF $DATA(^DPT(+$GET(DFN),0))
+2 IF '$TEST
QUIT ""
+3 NEW X
+4 SET X=$$HMR(FN,TYPE,DFN)
+5 IF X=""
IF $GET(TITLE)'=""
SET FN=TITLE
QUIT "Last "_FN_": Unknown"
+6 SET X=$$FORM($GET(TITLE),FN,X)
+7 QUIT X
+8 ;
IEN(FN,TYPE,DFN) ; EP-CONVERTS DFN TO IEN FOR ANY FILE NAME FOR V FILES
+1 IF $LENGTH($GET(FN))
IF $LENGTH($GET(TYPE))
IF +$GET(DFN)
+2 IF '$TEST
QUIT ""
+3 NEW DIC,X,Y,%,FIEN,FOR,TIEN,I
+4 SET DIC=1
SET X=FN
SET DIC(0)=""
DO ^DIC
IF Y=-1
QUIT ""
+5 SET FIEN=+Y
+6 SET %=$PIECE($GET(^DD(FIEN,.01,0)),U,2)
+7 SET FOR=$GET(^DIC(FIEN,0,"GL"))
IF '$LENGTH(FOR)
QUIT ""
+8 FOR I=1:1
IF '$LENGTH(%)
QUIT
SET X=$EXTRACT(%)
IF X'?1N
SET %=$EXTRACT(%,2,999)
IF X
SET %=+%
QUIT
+9 IF '%
QUIT ""
+10 SET DIC=%
SET DIC(0)=""
SET X=TYPE
IF FN["V IMM"
SET DIC(0)="M"
DO ^DIC
IF Y=-1
QUIT ""
+11 SET TIEN=+Y
+12 IF FN="V MED"
GOTO MED
+13 SET X=FOR_"""AA"","_DFN_","_TIEN_",0)"
+14 SET Y=$ORDER(@X)
IF 'Y
QUIT ""
+15 SET X=FOR_"""AA"","_DFN_","_TIEN_","_Y_",0)"
+16 SET Y=$ORDER(@X)
+17 QUIT Y_U_FIEN
+18 ;
MED ; EP-FIELD IEN
+1 NEW STOP
SET STOP=""
+2 SET Y=0
FOR
IF STOP
QUIT
SET Y=$ORDER(^AUPNVMED("AA",DFN,Y))
IF 'Y
QUIT
SET IEN=0
FOR
SET IEN=$ORDER(^AUPNVMED("AA",DFN,Y,IEN))
IF 'IEN
QUIT
IF $PIECE($GET(^AUPNVMED(IEN,0)),U)=TIEN
SET STOP=IEN
QUIT
+3 IF 'STOP
QUIT ""
+4 QUIT STOP_U_FIEN
+5 ;
DATE(X) ; EP-RETURN THE DATE GIVEN THE ZERO NODE OF A V FILE
+1 NEW VIEN,Y
+2 SET VIEN=$PIECE(X,U,3)
IF 'VIEN
QUIT ""
+3 SET Y=$PIECE($GET(^AUPNVSIT(VIEN,0)),U)
IF 'Y
QUIT ""
+4 SET Y=Y\1
SET Y=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)
+5 QUIT Y
+6 ;
HMR(FN,TYPE,DFN) ; EP-RETURN HEALTH MAINTRNANCE REMINDERS
+1 ; FILE NAME,EVENT NAME,DFN (INPUT)
+2 ; DATE^RESULT^ABNORMAL FLAG (OUTPUT)^MODIFIER
+3 IF $LENGTH($GET(FN))
IF $LENGTH($GET(TYPE))
IF +$GET(DFN)
+4 IF '$TEST
QUIT ""
+5 NEW REC,IEN,DATE,%,X,Y,FIEN
+6 SET REC=$$IEN(FN,TYPE,DFN)
IF '$LENGTH(REC)
QUIT ""
+7 SET IEN=+REC
SET FIEN=$PIECE(REC,U,2)
+8 ; MEDICATION
IF FN="V MED"
SET X=$GET(^AUPNVMED(IEN,0))
IF $LENGTH(X)
Begin DoDot:1
+9 SET DATE=$$DATE(X)
IF '$LENGTH(DATE)
SET Y=""
QUIT
+10 SET Y=DATE
+11 QUIT
End DoDot:1
QUIT Y
+12 ; EXAM
IF FN="V EXAM"
SET X=$GET(^AUPNVXAM(IEN,0))
IF $LENGTH(X)
Begin DoDot:1
+13 SET DATE=$$DATE(X)
IF '$LENGTH(DATE)
SET Y=""
QUIT
+14 SET %=$PIECE(X,U,4)
SET %=$SELECT(%="A":"Abnl",%="N":"Nl",1:"")
+15 SET Y=DATE_"^^"_%
+16 QUIT
End DoDot:1
QUIT Y
+17 ; LAB TEST RESULT
IF FN="V LAB"
SET X=$GET(^AUPNVLAB(IEN,0))
IF $LENGTH(X)
Begin DoDot:1
+18 SET DATE=$$DATE(X)
IF '$LENGTH(DATE)
SET Y=""
QUIT
+19 SET Y=DATE_U_$PIECE(X,U,4,5)
+20 QUIT
End DoDot:1
QUIT Y
+21 ; RADIOLOGY
IF FN="V RADIOLOGY"
SET X=$GET(^AUPNVRAD(IEN,0))
IF $LENGTH(X)
Begin DoDot:1
+22 SET DATE=$$DATE(X)
IF '$LENGTH(DATE)
SET Y=""
QUIT
+23 SET %=$PIECE(X,U,5)
SET %=$SELECT(%=0:"Nl",%=1:"Abnl",1:"")
+24 SET Y=DATE_"^^"_%
+25 QUIT
End DoDot:1
QUIT Y
+26 ; IMMUNIZATION
IF FN="V IMMUNIZATION"
SET X=$GET(^AUPNVIMM(IEN,0))
IF $LENGTH(X)
Begin DoDot:1
+27 SET DATE=$$DATE(X)
IF '$LENGTH(DATE)
SET Y=""
QUIT
+28 SET %=$PIECE(X,U,7)
SET %=$SELECT(%=1:"Do not use!",1:"")
+29 SET Y=DATE_"^^"_%_U_$PIECE(X,U,4)
+30 QUIT
End DoDot:1
QUIT Y
+31 ; SKIN TEST
IF FN="V SKIN TEST"
SET X=$GET(^AUPNVSK(IEN,0))
IF $LENGTH(X)
Begin DoDot:1
+32 SET DATE=$$DATE(X)
IF '$LENGTH(DATE)
SET Y=""
QUIT
+33 SET %=$PIECE(X,U,4)
SET %=$SELECT(%="P":"Pos",%="N":"Neg",1:"?")
+34 SET Y=DATE_U_$PIECE(X,U,5)_"mm"_U_%
+35 QUIT
End DoDot:1
QUIT Y
+36 QUIT ""
+37 ;
FORM(TITLE,FN,X) ; PRELIMINARY OUTPUT FORMATTING
+1 IF '$LENGTH(X)
QUIT ""
+2 IF '$LENGTH(TITLE)
IF '$LENGTH(FN)
QUIT ""
+3 IF $LENGTH(TITLE)
SET FN=TITLE
+4 SET FN=FN
IF $LENGTH($PIECE(X,U,4))
SET FN=FN_"("_$PIECE(X,U,4)_")"
+5 SET %="Last "_FN_": "_$PIECE(X,U)
+6 IF $PIECE(X,U,2)'=""
SET %=%_" ("_$PIECE(X,U,2)
+7 IF $PIECE(X,U,3)'=""
SET %=%_" - "_$PIECE(X,U,3)
+8 IF $PIECE(X,U,2)'=""
SET %=%_")"
+9 QUIT %
+10 ;
PAP(DFN) ; EP-GIVEN DFN, RETURN LAST PAP h1
+1 QUIT $$OUT("PAP","V LAB","PAP SMEAR",+$GET(DFN))
+2 ;
GLUC(DFN) ; EP-GIVEN DFN, RETURN LAST GLUCOSE h2
+1 QUIT $$OUT("GLUCOSE","V LAB","GLUCOSE",+$GET(DFN))
+2 ;
PPD(DFN) ; EP-GIVEN DFN, RETURN THE LAST PPD SKIN TEST h3
+1 QUIT $$OUT("PPD","V SKIN TEST","PPD",+$GET(DFN))
+2 ;
MAMMO(DFN) ; EP-GIVEN A DFN, RETURN THE LAST MAMMOGRAM h4
+1 NEW %
SET %=$ORDER(^APCHSURV("B","MAMMOGRAM",0))
+2 IF %
IF $LENGTH($TEXT(INAC^APCHSMU))
IF $$INAC^APCHSMU(%)
IF $ORDER(^BWPCD(0))
+3 IF '$TEST
QUIT $$OUT("MAMMO","V RADIOLOGY","MAMMOGRAM BILAT",+$GET(DFN))
+4 NEW IDATE,STOP,PIEN,%,DATE,RES,Y,Z
+5 SET IDATE=0
SET STOP=""
+6 FOR
SET IDATE=$ORDER(^BWPCD("AA",DFN,IDATE))
IF 'IDATE
QUIT
IF STOP
QUIT
SET PIEN=0
FOR
SET PIEN=$ORDER(^BWPCD("AA",DFN,IDATE,PIEN))
IF 'PIEN
QUIT
Begin DoDot:1
+7 SET %=$PIECE($GET(^BWPCD(PIEN,0)),U,4)
+8 IF %'=25
IF %'=26
IF %'=28
QUIT
+9 SET STOP=PIEN
+10 QUIT
End DoDot:1
IF STOP
QUIT
+11 IF 'STOP
QUIT "Last MAMMO: Unknown"
+12 SET DATE=$PIECE($GET(^BWPCD(STOP,0)),U,3)
SET RES=$PIECE(^(0),U,5)
+13 IF 'DATE
QUIT "Last MAMMO: Unknown"
+14 SET Y=DATE
SET Y=Y\1
SET DATE=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)
+15 IF RES
SET RES=$PIECE($GET(^BWDIAG(RES,0)),U)
SET RES=$SELECT('$LENGTH(RES):"",RES["Negative"!(RES["Normal"):"Nl",1:"Abnl")
+16 SET Z="Last MAMMO: "_DATE
IF $LENGTH($GET(RES))
SET Z=Z_" - "_RES
+17 QUIT Z
+18 ;
PELVIC(DFN) ; EP-GIVEN DFN, RETURN THE LAST PELVIC EXAM h5
+1 QUIT $$OUT("PELVIC","V EXAM","PELVIC EXAM",+$GET(DFN))
+2 ;
BREAST(DFN) ; EP-GIVEN DFN, RETURN THE LAST BREAST EXAM h6
+1 QUIT $$OUT("BREAST EXAM","V EXAM","BREAST EXAM",+$GET(DFN))
+2 ;
RECTAL(DFN) ; EP-GIVEN DFN, RETURNT THE LAST RECTAL EXAM h7
+1 QUIT $$OUT("RECTAL EXAM","V EXAM","RECTAL EXAM",+$GET(DFN))
+2 ;
PROST(DFN) ; EP-GIVEN DFN, RETURN THE LAST PROSTATE EXAM h8
+1 QUIT $$OUT("PROSTATE EXAM","V EXAM","RECTAL EXAM",+$GET(DFN))
+2 ;
PN(DFN) ; EP-GIVEN DFN, RETURN THE LAST PNEUMOVAX h9
+1 QUIT $$OUT("PNEUMOVAX","V IMMUNIZATION","19",+$GET(DFN))
+2 ;
FLU(DFN) ; EP-GIVEN DFN, RETURN THE LAST FLU SHOT h10
+1 QUIT $$OUT("FLU","V IMMUNIZATION","12",+$GET(DFN))
+2 ;
TD(DFN) ; EP-GIVEN DFN, RETURN THE LAST TETANUS SHOT h11
+1 QUIT $$OUT("TD","V IMMUNIZATION","28",+$GET(DFN))
+2 ;
DPRV(DFN) ; EP-GIVEN DFN, RETURN THE DESIGNATED PROVIDER x29
+1 NEW PRV
+2 SET PRV=$PIECE($GET(^AUPNPAT(DFN,0)),U,14)
+3 IF PRV
IF $GET(^DD(9000001,.14,0))["VA(200"
SET PRV=$PIECE($GET(^VA(200,+PRV,0)),U)
IF $LENGTH(PRV)
SET PRV=$PIECE(PRV,",",2)_" "_$PIECE(PRV,",")
+4 IF '$TEST
SET %=U_"DIC("_16_")"
SET PRV=$PIECE($GET(@%@(+PRV,0)),U)
IF $LENGTH(PRV)
SET PRV=$PIECE(PRV,",",2)_" "_$PIECE(PRV,",")
+5 IF PRV=""
SET PRV="Unknown"
+6 QUIT "PCP: "_PRV
+7 ;
DPT(DFN) ; EP-GIVEN DFN, RETURN THE LAST DPT h12
+1 QUIT $$OUT("DPT","V IMMUNIZATION","1",+$GET(DFN))
+2 ;
OPV(DFN) ; EP-GIVEN DFN, RETURN THE LAST OPV h13
+1 QUIT $$OUT("OPV","V IMMUNIZATION","2",+$GET(DFN))
+2 ;
POLIO(DFN) ; EP-GIVEN DFN, RETURN THE LAST POLIO VACCINE h14
+1 QUIT $$OUT("POLIO","V IMMUNIZATION","10",+$GET(DFN))
+2 ;
HEPB(DFN) ; EP-GIVEN THE DFN, RETURN THE LAST HEPATITIS B VACCINE h15
+1 QUIT $$OUT("HEP-B","V IMMUNIZATION","45",+$GET(DFN))
+2 ;
MEASL(DFN) ; EP-GIVEN THE DFN, RETURN THE LAST MEASLES VACCINE h16
+1 QUIT $$OUT("MEASLES","V IMMUNIZATION","5",+$GET(DFN))
+2 ;
RUB(DFN) ; EP-GIVEN DFN, RETURN THE LAST RUBELLA VACCINE h17
+1 QUIT $$OUT("RUBELLA","V IMMUNIZATION","6",+$GET(DFN))
+2 ;
MUM(DFN) ; EP-GIVEN DFN, RETURN THE LAST MUMPS VACCINE h18
+1 QUIT $$OUT("MUMPS","V IMMUNIZATION","7",+$GET(DFN))
+2 ;
MMR(DFN) ; EP-GIVEN DFN, RETURN THE LAST MMR VACCINE h19
+1 QUIT $$OUT("MMR","V IMMUNIZATION","3",+$GET(DFN))
+2 ;
MR(DFN) ; EP-GIVEN DFN, RETURN THE LAST MR VACCINE h20
+1 QUIT $$OUT("MR","V IMMUNIZATION","4",+$GET(DFN))
+2 ;
HFLU47(DFN) ; EP-GIVEN DFN, RETURN THE LAST HFLU47 VAVVINE h21
+1 QUIT $$OUT("H-FLU","V IMMUNIZATION","47",+$GET(DFN))
+2 ;
HFLU48(DFN) ; EP-GIVEN DFN, RETURN THE LAST HFLU48 VACCINE h22
+1 QUIT $$OUT("H-FLU","V IMMUNIZATION","48",+$GET(DFN))
+2 ;
HFLU49(DFN) ; EP-GIVEN DFN, RETURN THE LAST HFLU49 VACCINE h23
+1 QUIT $$OUT("H-FLU","V IMMUNIZATION","49",+$GET(DFN))
+2 ;
HEPA(DFN) ; EP-GIVEN DFN, RETURN THE LAST HEPATITIS A VACCINE h24
+1 QUIT $$OUT("HEP-A","V IMMUNIZATION","85",+$GET(DFN))
+2 ;
CPOX(DFN) ; EP-GIVEN DFN, RETURN THE LAST VARICELLA VACCINE h25
+1 QUIT $$OUT("CPOC","V IMMUNIZATION","21",+$GET(DFN))
+2 ;
DTAP(DFN) ; EP-GIVEN DFN, RETURN THE LAST DTAP VACCINE h26
+1 QUIT $$OUT("DTaP","V IMMUNIZATION","20",+$GET(DFN))
+2 ;
FEMU50(DFN) ; EP-EN UNDER 50
+1 NEW AGE,DOB,SEX,X
+2 SET X=$GET(^DPT(+$GET(DFN),0))
IF X=""
QUIT 0
+3 SET SEX=$PIECE(X,U,2)
SET DOB=$PIECE(X,U,3)
+4 IF $LENGTH(SEX)
IF DOB
+5 IF '$TEST
QUIT 0
+6 SET AGE=(DT-DOB)\10000
+7 IF AGE<50
IF SEX="F"
QUIT 1
+8 QUIT 0
+9 ;
FEM40(DFN) ; EP-WOMEN OVER 40
+1 NEW AGE,DOB,SEX,X
+2 SET X=$GET(^DPT(+$GET(DFN),0))
IF X=""
QUIT 0
+3 SET SEX=$PIECE(X,U,2)
SET DOB=$PIECE(X,U,3)
+4 IF $LENGTH(SEX)
IF DOB
+5 IF '$TEST
QUIT 0
+6 SET AGE=(DT-DOB)\10000
+7 IF AGE>39
IF SEX="F"
QUIT 1
+8 QUIT 0
+9 ;
