Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VENPCC1D

VENPCC1D.m

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