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

VENPCC1E.m

Go to the documentation of this file. 
  1. VENPCC1E ; IHS/OIT/GIS - NEW HEALTH MAINTENANCE REMINDER OUTOPUT ;
  1.  ;;2.6;PCC+;;NOV 12, 2007
  1.  ;
  1.  ; INCLUDES NEW CODE FOR PATIENT REFUSALS IN VER 2.5
  1.  ; 
  1. RAW(APCHSPAT,APCHSTYP) ; EP-GET RAW HMR TEXT
  1.  N APCHSCVD,APCHSBRK,APCHSCKP,APCHSNPG,APCHSBWR,APCHSERR,DDH,%T,%Y,AMQQTAXN,E
  1.  S APCHSCVD="S:Y]"""" Y=+Y,Y=$E(Y,4,5)_""/""_$S($E(Y,6,7):$E(Y,6,7)_""/"",1:"""")_$E(Y,2,3)"
  1.  S APCHSBRK="",APCHSCKP="",APCHSNPG=1
  1.  D SURV^APCHS11
  1.  Q
  1.  ; 
  1. LINE ; EP-INC LINE
  1.  N I,X S I=0
  1.  F  R X:30 Q:$$STATUS^%ZISH!(X["** END ")  D
  1.  . I X="" Q
  1.  . I X["LAST",X["NEXT" Q
  1.  . S I=I+1,@TMP@(I)=X
  1.  . Q
  1.  Q
  1.  ; 
  1. ARR(DFN) ; EP-SAVE SURVEILANNCE INFO IN A TMP ARRAY
  1.  N PATH,TMP,IOST,IOSL,IOM,POP,HSIEN,AGE,%,LINE,FILE
  1.  I '$D(^DPT(+$G(DFN,0),0)) Q
  1.  S %=+$P($G(^DPT(DFN,0)),U,3) I '% Q
  1.  S AGE=(DT-%)\10000
  1.  S HSIEN=$O(^APCHSCTL("B",$S(AGE<12:"PEDIATRIC",1:"ADULT REGULAR"),0)) I '$G(HSIEN) Q
  1.  S PATH=$G(^VEN(7.5,+$$CFG^VENPCCU,3)) I '$L(PATH) Q
  1.  S TMP="^TMP(""VEN SURV"",$J)",FILE="S"_DFN_".TXT" K @TMP
  1.  S IOST="P-PRINTER",IOSL=99999,IOM=80
  1.  S POP=$$OPN^VENPCCP(PATH,FILE,"W","N IO S IO=DEV D RAW^VENPCC1E(DFN,HSIEN)") I POP Q
  1.  S POP=$$OPN^VENPCCP(PATH,FILE,"R","D LINE^VENPCC1E") I POP Q
  1.  D DEL^VENPCCP1(PATH,("S"_DFN_".TXT")) ; CLEAN UP THE TMP FILE
  1.  D ITEM(DFN) ; GETS NEW SURVEILLANCE ITEMS (h26-h50) AND CLEARS OUT OLD ITEMS (h1-h8)
  1.  I $G(DEFEF) D REF(DFN,DEFEF) ; PATIENT REFUSALS
  1.  K @TMP
  1.  Q
  1.  ;
  1. CREF(FILE) ; EP-GIVEN A V FILE NUMBER, RETURN THE CLOSED REF
  1.  N X
  1.  S X=$G(^DIC(FILE,0,"GL")) I X="" Q X
  1.  I $E($RE(X),1)="(" S X=$TR(X,"(","")
  1.  E  S X=$RE(X) S $E(X,1)=")" S X=$RE(X)
  1.  Q X
  1.  ; 
  1. EXDT(DATE,A) ; EP-EXTERNAL DATE TO INTERNAL FM FORMAT.  IF A=1, RETURN DAY ONLY
  1.  N X,Y,%DT
  1.  S X=DATE,%DT="P"
  1.  D ^%DT
  1.  I Y=-1 Q ""
  1.  I A S Y=Y\1
  1.  Q Y
  1.  ; 
  1. LAST(DFN,TYPE,DATE) ; EP-RETURN THE LAST VALUE FOR A PATIENT ON A GIVEN DATE
  1.  I $G(DFN),$L($G(DATE)),$L(TYPE)
  1.  E  Q ""
  1.  N SIEN,FILE,VFILE,LUV,LIEN,%,X,OREF,SDATE,IDATE,DIC,Y,UNITS,TIEN,PCE,CREF,DDH,LDT,%DT,VIEN,RES,SPEC
  1.  S %=$O(^APCHSURV("B",TYPE,0)) I '$D(^VEN(7.96,+%,0)),TYPE'="PRIME MD SCORE" Q "" ; PATCHED BY GIS/OIT 2/25/06 ; PCC+ 2.5 PATCH 3
  1.  S SIEN=$O(^APCHSURV("B",TYPE,0)) I 'SIEN Q ""
  1.  S %=$G(^VEN(7.96,SIEN,0)),FILE=$P(%,U,2),VFILE=$P(%,U,3),UNITS=$P(%,U,4),SPEC=$G(^VEN(7.96,SIEN,2))
  1.  I $L(FILE),$L(VFILE)
  1.  E  Q ""
  1.  S LDT=$$EXDT(DATE,1) I 'LDT Q ""
  1.  S IDATE=9999999-LDT
  1.  I $L(SPEC) X ("S X=$$"_SPEC_"(DFN,IDATE)") Q X
  1.  S LUV="",LIEN=0,DIC(0)="MX",DIC=$G(^DIC(FILE,0,"GL")) I '$L(DIC) Q ""
  1.  F  S LIEN=$O(^VEN(7.96,SIEN,1,LIEN)) Q:'LIEN  D
  1.  . S X=$G(^VEN(7.96,SIEN,1,LIEN,0)) I '$L(X) Q
  1.  . D ^DIC I Y=-1 Q
  1.  . I $L(LUV) S LUV=LUV_U
  1.  . S LUV=LUV_(+Y)
  1.  . Q
  1.  I '$L(LUV) Q ""
  1.  S CREF=$$CREF(VFILE) I '$L(CREF) Q ""
  1.  F PCE=1:1:$L(LUV,U) S TIEN=$P(LUV,U,PCE) I TIEN D  I $L($G(VAL)) Q
  1.  . S VIEN=999999999 F  S VIEN=$O(@CREF@("AA",DFN,TIEN,IDATE,VIEN),-1) Q:'VIEN  D  I $L($G(VAL)) Q
  1.  .. K VAL
  1.  .. I VFILE=9000010.09 D  Q
  1.  ... S VAL=$P($G(^AUPNVLAB(VIEN,0)),U,4),RES=$P($G(^AUPNVLAB(VIEN,0)),U,5)
  1.  ... I TYPE="PAP SMEAR",$G(VAL) S VAL="Class "_VAL
  1.  ... I $L(VAL),$L($G(UNITS)) S VAL=VAL_UNITS
  1.  ... I $L(VAL),$L(RES) S VAL=VAL_" "
  1.  ... I $L(RES) S VAL=VAL_"("_RES_")"
  1.  ... I '$L(VAL) K VAL
  1.  ... Q
  1.  .. I VFILE=9000010.12 D  Q
  1.  ... S VAL=$P($G(^AUPNVSK(VIEN,0)),U,4),X=$P($G(^AUPNVSK(VIEN,0)),U,5)
  1.  ... S RES=$S(X="P":"Pos",X="N":"Neg",X="D":"Doubtful",X="0":"No take",1:"")
  1.  ... I $L(VAL),$L(RES) S VAL=VAL_" "
  1.  ... I $L(RES) S VAL=VAL_"("_RES_")"
  1.  ... I '$L(VAL) K VAL
  1.  ... Q
  1.  .. I VFILE=9000010.13 D  Q
  1.  ... S VAL=$P($G(^AUPNVXAM(VIEN,0)),U,4)
  1.  ... I '$L(VAL) K VAL Q
  1.  ... S VAL=$S(VAL="N":"Nl",VAL="A":"Abnl",1:VAL)
  1.  ... Q
  1.  .. Q
  1.  . I '$L($G(VAL)),$D(^AUPNPREF("AA",DFN,FILE,TIEN,IDATE)) S VAL="REFUSED!" Q
  1.  . Q
  1.  Q $G(VAL)
  1.  ;
  1. ITEM(DFN) ; EP-GET EACH ITEM AND STORE RESULTS
  1.  N LINE,STG,X,TYPE,FORC,VAL,Y,DATE,CNT,%,I,TMP,GBL
  1.  S TMP=$NA(^TMP("VEN PRNT",$J,1))
  1.  S GBL=$NA(^TMP("VEN SURV",$J))
  1.  F I=1:1:8 S @TMP@("h"_I)="" ; CLEAR OLD SURVEILLANCE ITEMS ; PATCHED BY GIS 1/15/04
  1.  S LINE=0,CNT=25
  1.  F  S LINE=$O(@GBL@(LINE)) Q:'LINE  D
  1.  . S STG=$G(@GBL@(LINE)) I '$L(STG) Q
  1.  . S X=$E(STG,1,23),TYPE=$$STRIP(X) I '$L(TYPE) Q
  1.  . ; S %=$O(^APCHSURV("B",TYPE,0)) I '$D(^VEN(7.96,+%,0)),TYPE'="PRIME MD SCORE" Q  ; ITEM MUST EXIST IN VEN SURV FILE ; PATCHED BY GIS/OIT 2/25/06 ; PCC+ 2.5 PATCH 3
  1.  . S X=$E(STG,24,36) S DATE=$$STRIP(X)
  1.  . I DATE?1." "2N1"/"2N1"/"2N S DATE=$TR(DATE," ","") ; PATCHED BY GIS/OIT 2/25/06 ; PCC+ 2.5 PATCH 3 
  1.  . S X=$E(STG,37,99),FORC=$$STRIP(X)
  1.  . I FORC?2N1"/"2N1"/"2N S FORC="Due: "_FORC ; PATCHED BY GIS/OIT 2/25/06 ; PCC+ 2.5 PATCH 3 
  1.  . S VAL=$$LAST(DFN,TYPE,DATE),CNT=CNT+1 I CNT>50 Q
  1.  . S STG=TYPE I $L(DATE) S STG=STG_"  Last: "_DATE
  1.  . I $L(VAL) S STG=STG_" "_VAL ; PATCHED BY GIS/OIT 2/25/06 ; PCC+ 2.5 PATCH 3 
  1.  . I $L(FORC) S STG=STG_"  "_FORC ; PATCHED BY GIS/OIT 2/25/06 ; PCC+ 2.5 PATCH 3 
  1.  . S @TMP@("h"_CNT)=STG
  1.  . Q
  1.  Q
  1.  ;
  1. STRIP(X) ; EP-STRIP BLANKS OFF THE END
  1.  N I,Y
  1.  S X=$RE(X)
  1.  F I=1:1 S Y=$E(X,I) Q:Y'=" "
  1.  Q $RE($E(X,I,999))
  1.  ; 
  1. MAMMO(DFN,IDATE) ; EP-GIVEN A DFN, RETURN THE LAST MAMMOGRAM h4
  1.  N %,X,PIEN,VAL,STOP
  1.  S PIEN=$O(^APCHSURV("B","MAMMOGRAM",0)) I 'PIEN Q "Unknown"
  1.  I $L($T(INAC^APCHSMU)),$$INAC^APCHSMU(%),$O(^BWPCD(0))
  1.  E  Q ""
  1.  S IDATE=0,STOP=""
  1.  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 "Unknown"
  1.  S VAL=$P($G(^BWPCD(STOP,0)),U,5)
  1.  I '$L(VAL) Q "Unknown"
  1.  Q VAL
  1.  ; 
  1. REF(DFN,DEFEF) ; EP - PATIENT REFUSALS (h1 - h8)
  1.  I '$O(^AUPNPREF("AA",+$G(DFN),0)) Q  ; NO REFUSALS SO QUIT
  1.  N MAXDT,PTED,FILE,FIEN,IDT,MOS,RIEN,X,STG,CNT,TOT,DAYS,MIDT,DATE,VIEN,WHAT,%,TMP
  1.  S TMP=$NA(^TMP("VEN PRNT",$J,1))
  1.  S STG=$G(^VEN(7.41,DEFEF,15))
  1.  S MOS=$P(STG,U) I MOS=0 Q  ; REFUSALS HAS BEEN TURNED OFF
  1.  I MOS="" S MOS=60
  1.  S DAYS=(MOS*30.5)\1
  1.  S MIDT=9999999-$$FMADD^XLFDT(DT,-DAYS,"","","")
  1.  S PTED=+$P(STG,U,2)
  1.  S FILE=0,CNT=0
  1.  F  S FILE=$O(^AUPNPREF("AA",DFN,FILE)) Q:'FILE  D
  1.  . I 'PTED,FILE=9999999.09 Q  ; PATIENT ED REFUSALS SHOULD BE EXCLUDED
  1.  . S FIEN=0 F  S FIEN=$O(^AUPNPREF("AA",DFN,FILE,FIEN)) Q:'FIEN  D  I CNT=8 Q
  1.  .. S IDT=0 F  Q:IDT>MIDT  S IDT=$O(^AUPNPREF("AA",DFN,FILE,FIEN,IDT)) Q:'IDT  D  I CNT=8 Q
  1.  ... S RIEN=0 F  S RIEN=$O(^AUPNPREF("AA",DFN,FILE,FIEN,IDT,RIEN)) Q:'RIEN  D  I CNT=8 Q
  1.  .... S X=$G(^AUPNPREF(RIEN,0)) I '$L(X) Q
  1.  .... S WHAT=$P(X,U,4)
  1.  .... S %=$P(X,U,3) I '% Q
  1.  .... S DATE=$$FMTE^XLFDT(%,"2D")
  1.  .... S CNT=CNT+1
  1.  .... S @TMP@("h"_CNT)="Refused "_WHAT_" ("_DATE_")"
  1.  .... Q
  1.  ... Q
  1.  .. Q
  1.  . Q
  1.  Q