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

APCLSILU.m

Go to the documentation of this file. 
  1. APCLSILU ; IHS/CMI/LAB - utilities for ili/h1n1 ; 13 Aug 2014  3:00 PM
  1.  ;;3.0;IHS PCC REPORTS;**24,26,27,29,30**;FEB 05, 1997;Build 27
  1.  ;----------
  1. ICD(VAL,TAXIEN,TYP) ;EP -- check to see if value is in taxonomy in ^TMP("BDMTMP",$J,Taxonomy Name
  1.  ;add 3rd param with pass type
  1.  ;WILL ALWAYS BE ATXAX, NOT LAB
  1.  NEW TAXNM
  1.  S TAXNM=$P($G(^ATXAX(TAXIEN,0)),U,1)
  1.  I TAXNM="" Q $$ICD^ATXCHK(VAL,TAXIEN,TYP)
  1.  I '$D(^XTMP("APCLILITAX",$J,TAXNM)) Q $$ICD^ATXCHK(VAL,$O(^ATXAX("B",TAXNM,0)),TYP)
  1.  I $D(^XTMP("APCLILITAX",$J,TAXNM,VAL)) Q 1
  1.  Q 0
  1.  ;
  1. ICDDX(C,D,I) ;PEP - CHECK FOR ICD10
  1.  I $T(ICDDX^ICDEX)]"" Q $$ICDDX^ICDEX(C,$G(D),,$G(I))
  1.  Q $$ICDDX^ICDCODE(C,$G(D))
  1.  ;
  1. ICDOP(C,D,I) ;PEP - CHECK FOR ICD10
  1.  I $G(I)="" S I="I"
  1.  I $T(ICDOP^ICDEX)]"" Q $$ICDOP^ICDEX(C,$G(D),,I)
  1.  Q $$ICDOP^ICDCODE(C,$G(D))
  1.  ;
  1. VSTD(C,D) ;EP - CHECK FOR ICD10
  1.  I $T(VSTD^ICDEX)]"" Q $$VSTD^ICDEX(C,$G(D))
  1.  Q $$VSTD^ICDCODE(C,$G(D))
  1.  ;
  1. VSTP(C,D) ;EP - CHECK FOR ICD10
  1.  I $T(VSTP^ICDEX)]"" Q $$VSTP^ICDEX(C,$G(D))
  1.  Q $$VSTP^ICDCODE(C,$G(D))
  1.  ;
  1. ICDD(C,A,D) ;EP - CHECK FOR ICD10
  1.  I $T(ICDD^ICDEX)]"" Q $$ICDD^ICDEX(C,A,$G(D))
  1.  Q $$ICDD^ICDCODE(C,A,$G(D))
  1. DOB(DFN) ;EP
  1.  ;---> Return Patient's Date of APCLrth in Fileman format.
  1.  ;---> Parameters:
  1.  ;     1 - DFN   (req) Patient's IEN (DFN).
  1.  ;
  1.  Q:'$G(DFN) "NO PATIENT"
  1.  Q:'$P($G(^DPT(DFN,0)),U,3) "NOT ENTERED"
  1.  Q $P(^DPT(DFN,0),U,3)
  1.  ;
  1.  ;
  1.  ;
  1.  ;----------
  1. AGE(DFN,APCLZ,APCLDT) ;EP
  1.  ;---> Return Patient's Age.
  1.  ;---> Parameters:
  1.  ;     1 - DFN  (req) IEN in PATIENT File.
  1.  ;     2 - APCLZ  (opt) APCLZ=1,2,3  1=years, 2=months, 3=days.
  1.  ;                               2 will be assumed if not passed.
  1.  ;     3 - APCLDT (opt) Date on which Age should be calculated.
  1.  ;
  1.  N APCLDOB,X,X1,X2,D,E  S:$G(APCLZ)="" APCLZ=2
  1.  Q:'$G(DFN) ""
  1.  S APCLDOB=$$DOB(DFN)
  1.  Q:'APCLDOB ""
  1.  S:'$G(DT) DT=$$DT^XLFDT
  1.  S:'$G(APCLDT) APCLDT=DT
  1.  Q:APCLDT<APCLDOB ""
  1.  ;
  1.  ;---> Age in Years.
  1.  N APCLAGEY,APCLAGEM,APCLD1,APCLD2,APCLM1,APCLM2,APCLY1,APCLY2
  1.  S APCLM1=$E(APCLDOB,4,7),APCLM2=$E(APCLDT,4,7)
  1.  S APCLY1=$E(APCLDOB,1,3),APCLY2=$E(APCLDT,1,3)
  1.  S APCLAGEY=APCLY2-APCLY1 S:APCLM2<APCLM1 APCLAGEY=APCLAGEY-1
  1.  S:APCLAGEY<1 APCLAGEY="<1"
  1.  Q:APCLZ=1 APCLAGEY
  1.  ;
  1.  ;---> Age in Months.
  1.  S APCLD1=$E(APCLM1,3,4),APCLM1=$E(APCLM1,1,2)
  1.  S APCLD2=$E(APCLM2,3,4),APCLM2=$E(APCLM2,1,2)
  1.  S APCLAGEM=12*APCLAGEY
  1.  I APCLM2=APCLM1&(APCLD2<APCLD1) S APCLAGEM=APCLAGEM+12
  1.  I APCLM2>APCLM1 S APCLAGEM=APCLAGEM+APCLM2-APCLM1
  1.  I APCLM2<APCLM1 S APCLAGEM=APCLAGEM+APCLM2+(12-APCLM1)
  1.  S:APCLD2<APCLD1 APCLAGEM=APCLAGEM-1
  1.  Q:APCLZ=2 APCLAGEM
  1.  ;
  1.  ;---> Age in Days.
  1.  S X1=APCLDT,X2=APCLDOB
  1.  D ^%DTC
  1.  Q X
  1.  ;
  1.  ;
  1.  ;----------
  1. AGEF(DFN,APCLDT) ;EP
  1.  ;---> Age formatted "35 Months" or "23 Years"
  1.  ;---> Parameters:
  1.  ;     1 - DFN  (req) Patient's IEN (DFN).
  1.  ;     2 - APCLDT (opt) Date on which Age should be calculated.
  1.  ;
  1.  N Y
  1.  S Y=$$AGE(DFN,2,$G(APCLDT))
  1.  Q:Y["DECEASED" Y
  1.  Q:Y["NOT BORN" Y
  1.  ;
  1.  ;---> If over 60 months, return years.
  1.  I Y>60 S Y=$$AGE(DFN,1,$G(APCLDT)) Q Y_$S(Y=1:"year",1:" yrs")
  1.  ;
  1.  ;---> If under 1 month return days.
  1.  I Y<1 S Y=$$AGE(DFN,3,$G(APCLDT)) Q Y_$S(Y=1:" day",1:" days")
  1.  ;
  1.  ;---> Return months
  1.  Q Y_$S(Y=1:" mth",1:" mths")
  1.  ;
  1.  ;
  1.  ;----------
  1. DECEASED(DFN,APCLDT) ;EP
  1.  ;---> Return 1 if patient is deceased, 0 if not deceased.
  1.  ;---> Parameters:
  1.  ;     1 - DFN  (req) Patient's IEN (DFN).
  1.  ;     2 - APCLDT (opt) If APCLDT=1 return Date of Death (Fileman format).
  1.  ;
  1.  Q:'$G(DFN) 0
  1.  N X S X=+$G(^DPT(DFN,.35))
  1.  Q:'X 0
  1.  Q:'$G(APCLDT) 1
  1.  Q X
  1.  ;
  1.  ;
  1. UNFOLDTX ;EP -- unfold all taxes for ili export into ^TMP("APCLILITAX",$J,Taxonomy Name
  1.  ;lets go through all the taxonomies needed here and put them in above location
  1.  K ^XTMP("APCLILITAX",$J)
  1.  I '$D(^ICDS(0)) Q  ;icd10 isn't there so don't bother
  1.  NEW APCLDA,APCLTAX,APCLFL,APCLTAXI,APCLVAL,APCLTYP,APCLTGT
  1.  S APCLDA=0 F  S APCLDA=$O(^APCLILIT(APCLDA)) Q:'APCLDA  D
  1.  . S APCLTAX=$P($G(^APCLILIT(APCLDA,0)),U)
  1.  . S APCLFL=$P($G(^APCLILIT(APCLDA,0)),U,2)
  1.  . S APCLTYP=$S(APCLFL=60:"L",1:"")
  1.  . S APCLTAXI=$O(^ATXAX("B",APCLTAX,0))
  1.  . I APCLTYP="L" D
  1.  .. S APCLTAXI=$O(^ATXLAB("B",APCLTAX,0))
  1.  . S APCLTGT="^XTMP("_"""APCLILITAX"""_","_$J_","_""""_APCLTAX_""""_")"
  1.  . D BLDTAX^ATXAPI(APCLTAX,APCLTGT,APCLTAXI,APCLTYP)
  1.  Q
  1. COMM ;EP
  1.  K ^APCLDATA($J)
  1.  NEW APCLX,APCLC,APCLCNT,APCLASUF,XBGL,XBFN,XBF,XBE,XBFLT,XBMED,XBCON,XBS1,XBQ,APCLDBID,C,APCLI
  1.  ;export community taxonomy
  1.  S APCLDBID=$P(^AUTTSITE(1,0),U,1)
  1.  S APCLDBID=$$VAL^XBDIQ1(9999999.06,APCLDBID,.32)
  1.  S APCLX=0,APCLCNT=0 F  S APCLX=$O(^BGPSITE(APCLX)) Q:APCLX'=+APCLX  D
  1.  .S APCLC=$P($G(^BGPSITE(APCLX,0)),U,5)
  1.  .Q:APCLC=""
  1.  .S APCLASUF=$P($G(^AUTTLOC(APCLX,0)),U,10)
  1.  .Q:APCLASUF=""
  1.  .;K ^TMP($J,"COMM")
  1.  .S APCLI=0 F  S APCLI=$O(^ATXAX(APCLC,21,APCLI)) Q:APCLI'=+APCLI  D
  1.  ..S C=$P($G(^ATXAX(APCLC,21,APCLI,0)),U,1)
  1.  ..S C=$O(^AUTTCOM("B",C,0))
  1.  ..I 'C Q
  1.  ..S APCLCNT=APCLCNT+1
  1.  ..S ^APCLDATA($J,APCLCNT)=APCLDBID_U_APCLASUF_U_$P(^AUTTCOM(C,0),U,8)_U_$P(^AUTTCOM(C,0),U,1)
  1.  .NEW TST
  1.  .S TST=0
  1.  .;I '$$PROD^XUPROD() S TST=1
  1.  .I $P($G(^APCLILIC(1,0)),U,5)="T" S TST=1
  1.  .S XBFN="COMM"_$S(TST:"Z",1:"F")_"_"_APCLASUF_"_"_$$DATE^APCLSILI(APCLZHSD)_".txt"
  1.  .S XBGL="APCLDATA",XBMED="F",XBQ="N",XBFLT=1,XBF=$J,XBE=$J
  1.  .S XBCON=1
  1.  .S XBS1="SURVEILLANCE ILI SEND"
  1.  .S XBQ="N"
  1.  .D ^XBGSAVE
  1.  .K ^APCLDATA($J)
  1.  Q
  1. INSTALLD(APCLSTAL) ;EP - Determine if patch APCLSTAL was installed, where
  1.  ; APCLSTAL is the name of the INSTALL.  E.g "AG*6.0*11".
  1.  ;
  1.  NEW APCLY,DIC,X,Y
  1.  S X=$P(APCLSTAL,"*",1)
  1.  S DIC="^DIC(9.4,",DIC(0)="FM",D="C"
  1.  D IX^DIC
  1.  I Y<1 Q 0
  1.  S DIC=DIC_+Y_",22,",X=$P(APCLSTAL,"*",2)
  1.  D ^DIC
  1.  I Y<1 Q 0
  1.  S DIC=DIC_+Y_",""PAH"",",X=$P(APCLSTAL,"*",3)
  1.  D ^DIC
  1.  S APCLY=Y
  1.  Q $S(APCLY<1:0,1:1)
  1. LASTPRCT(P,BD,ED,T,F) ;EP
  1.  I '$G(P) Q ""
  1.  I $G(BD)="" S BD=$$DOB^AUPNPAT(P)
  1.  I $G(ED)="" S ED=DT
  1.  I $G(F)="" S F="D"
  1.  S T=$G(T)
  1.  NEW A,B,C,D,E,TIEN,R,I
  1.  S TIEN="" I T]"" S TIEN=$O(^ATXAX("B",T,0))  ;get taxonomy ien
  1.  I TIEN="" Q ""
  1.  S R=""  ;return value
  1.  S B=9999999-BD,E=9999999-ED  ;get inverse date and begin at edate-1 and end when greater than begin date
  1.  S D=E-1 F  S D=$O(^AUPNVPRC("AA",P,D)) Q:D=""!(D>B)!(R]"")  D
  1.  .S I=0 F  S I=$O(^AUPNVPRC("AA",P,D,I)) Q:I'=+I!(R]"")  D
  1.  ..S C=$P($G(^AUPNVPRC(I,0)),U)
  1.  ..Q:C=""  ;bad xref
  1.  ..Q:'$D(^ICD0(C))
  1.  ..I TIEN Q:'$$ICD^ATXAPI(C,TIEN,0)
  1.  ..S R=(9999999-D)_"^PROC: "_$P($$ICDOP(C,(9999999-D),"I"),U,2)_"^"_$$VAL^XBDIQ1(9000010.08,I,.04)_"^"_$P(^AUPNVPRC(I,0),U,3)_"^9000010.08^"_I
  1.  ..Q
  1.  .Q
  1.  I R="" Q ""
  1.  I F="D" Q $P(R,U)
  1.  Q R