APCLSIL4 ; IHS/CMI/LAB - ILI surveillance export ;
;;3.0;IHS PCC REPORTS;**28,29,30,31**;FEB 05, 1997;Build 32
;
HASPVAC(V) ;EP - get flu iz
NEW C,X,Y,Z,T
S T=$O(^ATXAX("B","SURVEILLANCE PCV CVX CODES",0))
S C=0,X=0 F S X=$O(^AUPNVIMM("AD",V,X)) Q:X'=+X S Y=$P($G(^AUPNVIMM(X,0)),U) D
.Q:'Y
.Q:'$D(^AUTTIMM(Y,0))
.S Z=$P(^AUTTIMM(Y,0),U,3)
.Q:'$D(^ATXAX(T,21,"B",Z))
.;get lot and manufacturer added in patch 27
.S C=1_U_Z_U_$$VAL^XBDIQ1(9000010.11,X,.05) I $P(^AUPNVIMM(X,0),U,5),$D(^AUTTIML($P(^AUPNVIMM(X,0),U,5),0)) S C=C_U_$$VAL^XBDIQ1(9999999.41,$P(^AUPNVIMM(X,0),U,5),.02)
.S Z=$$VALI^XBDIQ1(9000010.11,X,1201)
.S $P(C,U,5)=$S(Z:$P(Z,".",1),1:$$VD^APCLV(V))
.Q
Q C
;
PCVFEB(APCLV,D) ;EP
NEW X,P,Y,Z,T,G,C,APCL,E,S,V
S G=""
S P=$P(^AUPNVSIT(APCLV,0),U,5)
;S D=$$VD^APCLV(APCLV)
S E=$$FMADD^XLFDT(D,7)
;get all visits from D to D+7
D ALLV^APCLAPIU(P,D,E,"APCL")
I '$D(APCL) Q ""
;now get rid of non 30/80, non-H visits, and those whose primary dx is not FEBRILE SEIZURE
S X=0 F S X=$O(APCL(X)) Q:X'=+X!(G]"") D
.S V=$P(APCL(X),U,5)
.Q:'$D(^AUPNVSIT(V,0))
.S Z=0
.I "AORSHI"'[$P(^AUPNVSIT(V,0),U,7) Q ;no chart reviews or Telephone calls
.I $P(^AUPNVSIT(V,0),U,7)="H" S Z=1 ;h
.I $P(^AUPNVSIT(V,0),U,7)="I" S Z=1
.I $$CLINIC^APCLV(V,"C")=30 S Z=1
.I $$CLINIC^APCLV(V,"C")=80 S Z=1
.Q:'Z ;not an H or 30/80
.;does it have a febrile seizure dx?
.S T=$O(^ATXAX("B","SURVEILLANCE FEBRILE SEIZURE",0))
.Q:'T
.S Z="",Y=0 F S Y=$O(^AUPNVPOV("AD",V,Y)) Q:Y'=+Y!(Z]"") D
..S Q=$P($G(^AUPNVPOV(Y,0)),U)
..Q:Q=""
..Q:'$$ICD^APCLSILU(Q,T,9) ;not in taxonomy
..S Z=$$VAL^XBDIQ1(9000010.07,Y,.01) ;code
..Q
.I Z="" Q ;NO SEIZURE
.;IF HAD SEIZURE IS THERE A EPILEPSY ON THE SAME DAY, IF SO QUIT
.S S=$$LASTDXT^APCLAPIU(P,$$VD^APCLV(V),$$VD^APCLV(V),"SURVEILLANCE EPILEPSY","A")
.I S Q ;had epilepsy on this day also
.S G=Z_","_$$VD^APCLV(V) ;code and date of febrile seizure
Q G
PCVECPEH(APCLV,D) ;EP
NEW X,P,Y,Z,T,G,C,APCL,E,S,V,CLNTAX,APCLCLIN,APCLX
S G=""
S P=$P(^AUPNVSIT(APCLV,0),U,5)
;S D=$$VD^APCLV(APCLV),D=$$FMADD^XLFDT(D,1)
S E=$$FMADD^XLFDT(D,28)
;get all visits from D to D+28
D ALLV^APCLAPIU(P,D,E,"APCL")
I '$D(APCL) Q ""
;S CLNTAX=$O(^ATXAX("B","SURVEILLANCE ILI CLINICS",0))
;now get rid of non ILI CLINIC VISITS OR PHN
S APCLX=0 F S APCLX=$O(APCL(APCLX)) Q:APCLX'=+APCLX!(G]"") D
.S V=$P(APCL(APCLX),U,5)
.Q:'$D(^AUPNVSIT(V,0))
.I "AORSHI"'[$P(^AUPNVSIT(V,0),U,7) Q
.;S APCLCLIN=$$CLINIC^APCLV(V,"I") ;get clinic code
.;is there a PHN
.;S X=0,S=0 F S X=$O(^AUPNVPRV("AD",APCLV,X)) Q:X'=+X!(P) D
.;.Q:'$D(^AUPNVPRV(X,0))
.;.S Y=$P(^AUPNVPRV(X,0),U)
.;.S Z=$$VALI^XBDIQ1(200,Y,53.5)
.;.Q:'Z
.;.I $P($G(^DIC(7,Z,9999999)),U,1)=13 S S=1
.;I S G PCVE
.;I $P(^AUPNVSIT(V,0),U,7)'="H" I APCLCLIN="" Q ""
.;I $P(^AUPNVSIT(V,0),U,7)'="H" I '$D(^ATXAX(CLNTAX,21,"B",APCLCLIN)) Q "" ;not in clinic taxonomy
PCVE .;
.;does it have a ENCEPHALOPATHY dx?
.S T=$O(^ATXAX("B","SURVEILLANCE ENCEPHALOPATHY",0))
.Q:'T
.S Z="",Y=0 F S Y=$O(^AUPNVPOV("AD",V,Y)) Q:Y'=+Y!(Z]"") D
..S Q=$P($G(^AUPNVPOV(Y,0)),U)
..Q:Q=""
..Q:'$$ICD^APCLSILU(Q,T,9) ;not in taxonomy
..S Z=$$VAL^XBDIQ1(9000010.07,Y,.01) ;code
..Q
.I Z="" Q ;NO enceph
.S G=Z_","_$$VD^APCLV(V) ;code and date of febrile seizure
Q G
PCVANGIO(APCLV,D) ;EP
NEW X,P,Y,Z,T,G,C,APCL,E,S,V,CLNTAX,APCLCLIN,APCLX
S G=""
S P=$P(^AUPNVSIT(APCLV,0),U,5)
;S D=$$VD^APCLV(APCLV)
S E=$$FMADD^XLFDT(D,7)
;get all visits from D to D+7
D ALLV^APCLAPIU(P,D,E,"APCL")
I '$D(APCL) Q ""
;S CLNTAX=$O(^ATXAX("B","SURVEILLANCE ILI CLINICS",0))
;now get rid of non ILI CLINIC VISITS OR PHN
S APCLX=0 F S APCLX=$O(APCL(APCLX)) Q:APCLX'=+APCLX!(G]"") D
.S V=$P(APCL(APCLX),U,5)
.Q:'$D(^AUPNVSIT(V,0))
.I "AORSH"'[$P(^AUPNVSIT(V,0),U,7) Q
.;S APCLCLIN=$$CLINIC^APCLV(V,"I") ;get clinic code
.;is there a PHN
.;S X=0,S=0 F S X=$O(^AUPNVPRV("AD",APCLV,X)) Q:X'=+X!(P) D
.;.Q:'$D(^AUPNVPRV(X,0))
.;.S Y=$P(^AUPNVPRV(X,0),U)
.;.S Z=$$VALI^XBDIQ1(200,Y,53.5)
.;.Q:'Z
.;.I $P($G(^DIC(7,Z,9999999)),U,1)=13 S S=1
.;I S G PCVE
.;I $P(^AUPNVSIT(V,0),U,7)'="H" I APCLCLIN="" Q ""
.;I $P(^AUPNVSIT(V,0),U,7)'="H" I '$D(^ATXAX(CLNTAX,21,"B",APCLCLIN)) Q "" ;not in clinic taxonomy
ANGIO1 .;
.;does it have a ANGIO dx?
.S T=$O(^ATXAX("B","SURVEILLANCE ANGIOEDEMA",0))
.Q:'T
.S Z="",Y=0 F S Y=$O(^AUPNVPOV("AD",V,Y)) Q:Y'=+Y!(Z]"") D
..S Q=$P($G(^AUPNVPOV(Y,0)),U)
..Q:Q=""
..Q:'$$ICD^APCLSILU(Q,T,9) ;not in taxonomy
..S Z=$$VAL^XBDIQ1(9000010.07,Y,.01) ;code
..Q
.I Z="" Q ;NO ANGIO
.S G=Z_","_$$VD^APCLV(V) ;code and date of ANGIOEDEMA
Q G
PCVASTH(APCLV,D) ;EP
NEW X,P,Y,Z,T,G,C,APCL,E,S,V
S G=""
S P=$P(^AUPNVSIT(APCLV,0),U,5)
;S D=$$VD^APCLV(APCLV)
S E=$$FMADD^XLFDT(D,7)
;get all visits from D to D+7
D ALLV^APCLAPIU(P,D,E,"APCL")
I '$D(APCL) Q ""
;now get rid of non 30/80, non-H visits, and those whose primary dx is not ASTHMA
S X=0 F S X=$O(APCL(X)) Q:X'=+X!(G]"") D
.S V=$P(APCL(X),U,5)
.Q:'$D(^AUPNVSIT(V,0))
.S Z=0
.I "AORSHI"'[$P(^AUPNVSIT(V,0),U,7) Q ;no chart reviews or Telephone calls or events
.I $P(^AUPNVSIT(V,0),U,7)="H" S Z=1 ;h
.I $$CLINIC^APCLV(V,"C")=30 S Z=1
.I $$CLINIC^APCLV(V,"C")=80 S Z=1
.Q:'Z ;not an H or 30/80
.;does it have an asthma dx?
.S T=$O(^ATXAX("B","SURVEILLANCE ADV EVENTS ASTHMA",0))
.Q:'T
.S Z="",Y=0 F S Y=$O(^AUPNVPOV("AD",V,Y)) Q:Y'=+Y!(Z]"") D
..S Q=$P($G(^AUPNVPOV(Y,0)),U)
..Q:Q=""
..Q:'$$ICD^APCLSILU(Q,T,9) ;not in taxonomy
..S Z=$$VAL^XBDIQ1(9000010.07,Y,.01) ;code
..Q
.I Z="" Q ;NO ASTHMA
.S G=Z_","_$$VD^APCLV(V) ;code and date of ASTHMA
Q G
PCVIMMUN(APCLV,D) ;EP
NEW X,P,Y,Z,T,G,C,APCL,E,S,V
S G=""
S P=$P(^AUPNVSIT(APCLV,0),U,5)
;S D=$$VD^APCLV(APCLV)
S E=$$FMADD^XLFDT(D,7)
;get all visits from D to D+7
D ALLV^APCLAPIU(P,D,E,"APCL")
I '$D(APCL) Q ""
S X=0 F S X=$O(APCL(X)) Q:X'=+X!(G]"") D
.S V=$P(APCL(X),U,5)
.Q:'$D(^AUPNVSIT(V,0))
.I "AORSH"'[$P(^AUPNVSIT(V,0),U,7) Q ;no chart reviews or Telephone calls
.;does it have a IMMUNIOLOGICAL dx?
.S T=$O(^ATXAX("B","SURVEILLANCE IMMUNOLOGICAL",0))
.Q:'T
.S Z="",Y=0 F S Y=$O(^AUPNVPOV("AD",V,Y)) Q:Y'=+Y!(Z]"") D
..S Q=$P($G(^AUPNVPOV(Y,0)),U)
..Q:Q=""
..Q:'$$ICD^APCLSILU(Q,T,9) ;not in taxonomy
..S Z=$$VAL^XBDIQ1(9000010.07,Y,.01) ;code
..Q
.I Z="" Q ;NO IMMUNO
.S G=Z_","_$$VD^APCLV(V) ;code and date of IMMUNIOLOGICAL
Q G
SET ;EP
;create entry with start date of DT
S APCLET=$H
N APCLFDA,APCLIENS,APCLERR
S APCLIENS="+2,"_1_","
S APCLFDA(9001003.312,APCLIENS,.01)=DT
;is this a test system?
NEW TST,F
S TST=0
;I '$$PROD^XUPROD() S TST=1
I $P($G(^APCLILIC(1,0)),U,5)="T" S TST=1
S F=$S(TST:"FLZ",$G(APCLFLF):"FLF",$G(APCLFLFN):"FLF",1:"FLU")_"_"_APCLASU_"_"_$$DATE^APCLSIHL(DT)_"_P31.txt" ;IHS/CMI/LAB - PATCH 31 FILENAME AND PATCH #
;S F=$S(TST:"FLZ",$G(APCLFLF):"FLF",1:"FLU")_"_"_APCLASU_"_"_$$DATE^APCLSILI(DT)_".txt"
S APCLFDA(9001003.312,APCLIENS,.02)=F
S APCLFDA(9001003.312,APCLIENS,.05)=$S(XBFLG:0,1:1)
S APCLFDA(9001003.312,APCLIENS,.04)=APCLVTOT
S APCLFDA(9001003.312,APCLIENS,.06)=$$HTFM^XLFDT(APCLBT)
S APCLFDA(9001003.312,APCLIENS,.07)=$$HTFM^XLFDT(APCLET)
S APCLFDA(9001003.312,APCLIENS,.08)=$$RUNTIME(APCLBT,APCLET)
D UPDATE^DIE("","APCLFDA","APCLIENS","APCLERR(1)")
Q
RUNTIME(B,E) ;
NEW S,H,M,SEC,RT
S RT=""
S S=(86400*($P(E,",")-$P(B,",")))+($P(E,",",2)-$P(B,",",2)),H=$P(S/3600,".") S:H="" H=0 D
.S S=S-(H*3600),M=$P(S/60,".") S:M="" M=0 S S=S-(M*60),SEC=S S RT="RUN TIME (H.M.S): "_H_"."_M_"."_SEC
Q RT
HASADVN6(APCLV,D1,D2) ;EP - PATCH 27 - if return 1 then count visit and put pieces 2 through n in columns 66 through 75
NEW X,P,Y,Z,T,G,C,APCL,E,S,V,PAT,P1,P2,APCLVDAT,APCLHAS
S G=""
;S D=$$VD^APCLV(APCLV) ;VISIT DATE
;S E=$$FMADD^XLFDT(D,60) ;END DATE TO LOOK
S PAT=$P(^AUPNVSIT(APCLV,0),U,5)
S (C,P1,P2)=0
S (D,E)=""
K APCLHAS
I D1="" G D2
D ALLV^APCLAPIU(PAT,D1,$$FMADD^XLFDT(D1,60),"APCL")
S APCLVDAT=D1
D D
I D1=D2 Q 1_U_D_U_E
D2 ;
K APCL
D ALLV^APCLAPIU(PAT,D2,$$FMADD^XLFDT(D2,60),"APCL")
S APCLVDAT=D2
D D
I 'C Q ""
Q 1_U_D_U_E
D ;
I '$D(APCL) Q
;NOW GET RID OF ALL NON PHN/ILI CLINIC VISITS
S APCLX=0 F S APCLX=$O(APCL(APCLX)) Q:APCLX'=+APCLX!(C>4) D
.S V=$P(APCL(APCLX),U,5)
.Q:'$D(^AUPNVSIT(V,0))
.S Z=0
.;
.I "AORSH"'[$P(^AUPNVSIT(V,0),U,7) Q ;no chart reviews or Telephone calls
.S CLNTAX=$O(^ATXAX("B","SURVEILLANCE ILI CLINICS",0))
.S APCLCLIN=$$CLINIC^APCLV(V,"I") ;get clinic code
.;is there a PHN
.S X=0,P=0 F S X=$O(^AUPNVPRV("AD",V,X)) Q:X'=+X!(P) D
..Q:'$D(^AUPNVPRV(X,0))
..S Y=$P(^AUPNVPRV(X,0),U)
..S Z=$$VALI^XBDIQ1(200,Y,53.5)
..Q:'Z
..I $P($G(^DIC(7,Z,9999999)),U,1)=13 S P=1
.I P G HASADN61
.I $P(^AUPNVSIT(V,0),U,7)'="H" I APCLCLIN="" Q
.I $P(^AUPNVSIT(V,0),U,7)'="H" I '$D(^ATXAX(CLNTAX,21,"B",APCLCLIN)) Q ;not in clinic taxonomy
.S P=1
.;does it have aN ADVERSE EVENT
HASADN61 .;
.S X=0 F S X=$O(^AUPNVPOV("AD",V,X)) Q:X'=+X!(C>4) D
..S T=$P(^AUPNVPOV(X,0),U)
..I $$ICD^APCLSILU(T,$O(^ATXAX("B","SURVEILLANCE ADV EVENTS DXS",0)),9) D
...Q:$$VD^APCLV(V)=APCLVDAT ;$$VD^APCLV(APCLV) ;NOT SAME DATE AS VACCINE
...;Q:$$VD^APCLV(V)>$$FMADD^XLFDT($$VD^APCLV(APCLV),14)
...D SET6 Q
..I $$ICD^APCLSILU(T,$O(^ATXAX("B","SURVEILLANCE ADV EVENTS LIVE",0)),9) D Q
...S A=$$AGE^APCLSILU(PAT,2,$$VD^APCLV(V))
...Q:A<24
...Q:A>59
...Q:$$VD^APCLV(V)=APCLVDAT ;$$VD^APCLV(APCLV) ;NOT SAME DATE AS VACCINE
...Q:$$VD^APCLV(V)>$$FMADD^XLFDT(APCLVDAT,14)
...D SET6
...Q
..I $$ICD^APCLSILU(T,$O(^ATXAX("B","SURVEILLANCE ADV EVENT FEBRILE",0)),9) D Q
...S A=$$AGE^APCLSILU(PAT,2,$$VD^APCLV(V))
...Q:A>59
...Q:$$VD^APCLV(V)>$$FMADD^XLFDT(APCLVDAT,15)
...D SET6
I 'C Q ;"" ;no diagnosis
Q ;
SET6 ;
Q:$D(APCLHAS(X)) ;ALREADY HAVE THIS ONE
S APCLHAS(X)=""
S C=C+1,P1=P1+1,P2=P2+1
S $P(D,",",P1)=$$VAL^XBDIQ1(9000010.07,X,.01)
S $P(E,",",P1)=$$VD^APCLV(V)
Q
HASAVM(V) ;EP
NEW C,X,Y,Z,T,L,M,N
S T=$O(^ATXAX("B","FLU ANTIVIRAL MEDS",0))
S C="",X=0 F S X=$O(^AUPNVMED("AD",V,X)) Q:X'=+X!(C) S Y=$P($G(^AUPNVMED(X,0)),U) D
.Q:'Y
.Q:'$D(^PSDRUG(Y,0))
.S Z=0
.S N=$P(^PSDRUG(Y,0),U)
.I $D(^ATXAX(T,21,"B",Y)) S Z=1
.I N["OSELTAMIVIR" S Z=1
.I N["ZANAMIVIR" S Z=1
.I N["RIMANTADINE" S Z=1
.I N["AMANTADINE" S Z=1
.I Z=1 S C=1_U_N_U_$P(^AUPNVMED(X,0),U,7)
.Q
Q C
HASNVAC(V) ;EP - get h1n1 vaccine
NEW C,X,Y,Z,T,L,M
S T=$O(^ATXAX("B","SURVEILLANCE PANDEMIC CVX",0))
S C=0,X=0 F S X=$O(^AUPNVIMM("AD",V,X)) Q:X'=+X!(C) S Y=$P($G(^AUPNVIMM(X,0)),U) D
.Q:'Y
.Q:'$D(^AUTTIMM(Y,0))
.S Z=$P(^AUTTIMM(Y,0),U,3)
.Q:'$D(^ATXAX(T,21,"B",Z))
.S C=1_U_Z_U_$$VAL^XBDIQ1(9000010.11,X,.05) I $P(^AUPNVIMM(X,0),U,5),$D(^AUTTIML($P(^AUPNVIMM(X,0),U,5),0)) S C=C_U_$$VAL^XBDIQ1(9999999.41,$P(^AUPNVIMM(X,0),U,5),.02)
.S Z=$$VALI^XBDIQ1(9000010.11,X,1201)
.S $P(C,U,5)=$S(Z:$P(Z,".",1),1:$$VD^APCLV(V))
.Q
I C Q C
S T=$O(^ATXAX("B","SURVEILLANCE PANDEMIC CPT",0))
I 'T Q C
S C=0,X=0 F S X=$O(^AUPNVCPT("AD",V,X)) Q:X'=+X S Y=$P($G(^AUPNVCPT(X,0)),U) D
.Q:'Y
.Q:'$$ICD^APCLSILU(Y,T,1)
.S C=1_U_$$VAL^XBDIQ1(9000010.18,X,.01)
Q C
APCLSIL4 ; IHS/CMI/LAB - ILI surveillance export ;
+1 ;;3.0;IHS PCC REPORTS;**28,29,30,31**;FEB 05, 1997;Build 32
+2 ;
HASPVAC(V) ;EP - get flu iz
+1 NEW C,X,Y,Z,T
+2 SET T=$ORDER(^ATXAX("B","SURVEILLANCE PCV CVX CODES",0))
+3 SET C=0
SET X=0
FOR
SET X=$ORDER(^AUPNVIMM("AD",V,X))
IF X'=+X
QUIT
SET Y=$PIECE($GET(^AUPNVIMM(X,0)),U)
Begin DoDot:1
+4 IF 'Y
QUIT
+5 IF '$DATA(^AUTTIMM(Y,0))
QUIT
+6 SET Z=$PIECE(^AUTTIMM(Y,0),U,3)
+7 IF '$DATA(^ATXAX(T,21,"B",Z))
QUIT
+8 ;get lot and manufacturer added in patch 27
+9 SET C=1_U_Z_U_$$VAL^XBDIQ1(9000010.11,X,.05)
IF $PIECE(^AUPNVIMM(X,0),U,5)
IF $DATA(^AUTTIML($PIECE(^AUPNVIMM(X,0),U,5),0))
SET C=C_U_$$VAL^XBDIQ1(9999999.41,$PIECE(^AUPNVIMM(X,0),U,5),.02)
+10 SET Z=$$VALI^XBDIQ1(9000010.11,X,1201)
+11 SET $PIECE(C,U,5)=$SELECT(Z:$PIECE(Z,".",1),1:$$VD^APCLV(V))
+12 QUIT
End DoDot:1
+13 QUIT C
+14 ;
PCVFEB(APCLV,D) ;EP
+1 NEW X,P,Y,Z,T,G,C,APCL,E,S,V
+2 SET G=""
+3 SET P=$PIECE(^AUPNVSIT(APCLV,0),U,5)
+4 ;S D=$$VD^APCLV(APCLV)
+5 SET E=$$FMADD^XLFDT(D,7)
+6 ;get all visits from D to D+7
+7 DO ALLV^APCLAPIU(P,D,E,"APCL")
+8 IF '$DATA(APCL)
QUIT ""
+9 ;now get rid of non 30/80, non-H visits, and those whose primary dx is not FEBRILE SEIZURE
+10 SET X=0
FOR
SET X=$ORDER(APCL(X))
IF X'=+X!(G]"")
QUIT
Begin DoDot:1
+11 SET V=$PIECE(APCL(X),U,5)
+12 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+13 SET Z=0
+14 ;no chart reviews or Telephone calls
IF "AORSHI"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+15 ;h
IF $PIECE(^AUPNVSIT(V,0),U,7)="H"
SET Z=1
+16 IF $PIECE(^AUPNVSIT(V,0),U,7)="I"
SET Z=1
+17 IF $$CLINIC^APCLV(V,"C")=30
SET Z=1
+18 IF $$CLINIC^APCLV(V,"C")=80
SET Z=1
+19 ;not an H or 30/80
IF 'Z
QUIT
+20 ;does it have a febrile seizure dx?
+21 SET T=$ORDER(^ATXAX("B","SURVEILLANCE FEBRILE SEIZURE",0))
+22 IF 'T
QUIT
+23 SET Z=""
SET Y=0
FOR
SET Y=$ORDER(^AUPNVPOV("AD",V,Y))
IF Y'=+Y!(Z]"")
QUIT
Begin DoDot:2
+24 SET Q=$PIECE($GET(^AUPNVPOV(Y,0)),U)
+25 IF Q=""
QUIT
+26 ;not in taxonomy
IF '$$ICD^APCLSILU(Q,T,9)
QUIT
+27 ;code
SET Z=$$VAL^XBDIQ1(9000010.07,Y,.01)
+28 QUIT
End DoDot:2
+29 ;NO SEIZURE
IF Z=""
QUIT
+30 ;IF HAD SEIZURE IS THERE A EPILEPSY ON THE SAME DAY, IF SO QUIT
+31 SET S=$$LASTDXT^APCLAPIU(P,$$VD^APCLV(V),$$VD^APCLV(V),"SURVEILLANCE EPILEPSY","A")
+32 ;had epilepsy on this day also
IF S
QUIT
+33 ;code and date of febrile seizure
SET G=Z_","_$$VD^APCLV(V)
End DoDot:1
+34 QUIT G
PCVECPEH(APCLV,D) ;EP
+1 NEW X,P,Y,Z,T,G,C,APCL,E,S,V,CLNTAX,APCLCLIN,APCLX
+2 SET G=""
+3 SET P=$PIECE(^AUPNVSIT(APCLV,0),U,5)
+4 ;S D=$$VD^APCLV(APCLV),D=$$FMADD^XLFDT(D,1)
+5 SET E=$$FMADD^XLFDT(D,28)
+6 ;get all visits from D to D+28
+7 DO ALLV^APCLAPIU(P,D,E,"APCL")
+8 IF '$DATA(APCL)
QUIT ""
+9 ;S CLNTAX=$O(^ATXAX("B","SURVEILLANCE ILI CLINICS",0))
+10 ;now get rid of non ILI CLINIC VISITS OR PHN
+11 SET APCLX=0
FOR
SET APCLX=$ORDER(APCL(APCLX))
IF APCLX'=+APCLX!(G]"")
QUIT
Begin DoDot:1
+12 SET V=$PIECE(APCL(APCLX),U,5)
+13 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+14 IF "AORSHI"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+15 ;S APCLCLIN=$$CLINIC^APCLV(V,"I") ;get clinic code
+16 ;is there a PHN
+17 ;S X=0,S=0 F S X=$O(^AUPNVPRV("AD",APCLV,X)) Q:X'=+X!(P) D
+18 ;.Q:'$D(^AUPNVPRV(X,0))
+19 ;.S Y=$P(^AUPNVPRV(X,0),U)
+20 ;.S Z=$$VALI^XBDIQ1(200,Y,53.5)
+21 ;.Q:'Z
+22 ;.I $P($G(^DIC(7,Z,9999999)),U,1)=13 S S=1
+23 ;I S G PCVE
+24 ;I $P(^AUPNVSIT(V,0),U,7)'="H" I APCLCLIN="" Q ""
+25 ;I $P(^AUPNVSIT(V,0),U,7)'="H" I '$D(^ATXAX(CLNTAX,21,"B",APCLCLIN)) Q "" ;not in clinic taxonomy
PCVE ;
+1 ;does it have a ENCEPHALOPATHY dx?
+2 SET T=$ORDER(^ATXAX("B","SURVEILLANCE ENCEPHALOPATHY",0))
+3 IF 'T
QUIT
+4 SET Z=""
SET Y=0
FOR
SET Y=$ORDER(^AUPNVPOV("AD",V,Y))
IF Y'=+Y!(Z]"")
QUIT
Begin DoDot:2
+5 SET Q=$PIECE($GET(^AUPNVPOV(Y,0)),U)
+6 IF Q=""
QUIT
+7 ;not in taxonomy
IF '$$ICD^APCLSILU(Q,T,9)
QUIT
+8 ;code
SET Z=$$VAL^XBDIQ1(9000010.07,Y,.01)
+9 QUIT
End DoDot:2
+10 ;NO enceph
IF Z=""
QUIT
+11 ;code and date of febrile seizure
SET G=Z_","_$$VD^APCLV(V)
End DoDot:1
+12 QUIT G
PCVANGIO(APCLV,D) ;EP
+1 NEW X,P,Y,Z,T,G,C,APCL,E,S,V,CLNTAX,APCLCLIN,APCLX
+2 SET G=""
+3 SET P=$PIECE(^AUPNVSIT(APCLV,0),U,5)
+4 ;S D=$$VD^APCLV(APCLV)
+5 SET E=$$FMADD^XLFDT(D,7)
+6 ;get all visits from D to D+7
+7 DO ALLV^APCLAPIU(P,D,E,"APCL")
+8 IF '$DATA(APCL)
QUIT ""
+9 ;S CLNTAX=$O(^ATXAX("B","SURVEILLANCE ILI CLINICS",0))
+10 ;now get rid of non ILI CLINIC VISITS OR PHN
+11 SET APCLX=0
FOR
SET APCLX=$ORDER(APCL(APCLX))
IF APCLX'=+APCLX!(G]"")
QUIT
Begin DoDot:1
+12 SET V=$PIECE(APCL(APCLX),U,5)
+13 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+14 IF "AORSH"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+15 ;S APCLCLIN=$$CLINIC^APCLV(V,"I") ;get clinic code
+16 ;is there a PHN
+17 ;S X=0,S=0 F S X=$O(^AUPNVPRV("AD",APCLV,X)) Q:X'=+X!(P) D
+18 ;.Q:'$D(^AUPNVPRV(X,0))
+19 ;.S Y=$P(^AUPNVPRV(X,0),U)
+20 ;.S Z=$$VALI^XBDIQ1(200,Y,53.5)
+21 ;.Q:'Z
+22 ;.I $P($G(^DIC(7,Z,9999999)),U,1)=13 S S=1
+23 ;I S G PCVE
+24 ;I $P(^AUPNVSIT(V,0),U,7)'="H" I APCLCLIN="" Q ""
+25 ;I $P(^AUPNVSIT(V,0),U,7)'="H" I '$D(^ATXAX(CLNTAX,21,"B",APCLCLIN)) Q "" ;not in clinic taxonomy
ANGIO1 ;
+1 ;does it have a ANGIO dx?
+2 SET T=$ORDER(^ATXAX("B","SURVEILLANCE ANGIOEDEMA",0))
+3 IF 'T
QUIT
+4 SET Z=""
SET Y=0
FOR
SET Y=$ORDER(^AUPNVPOV("AD",V,Y))
IF Y'=+Y!(Z]"")
QUIT
Begin DoDot:2
+5 SET Q=$PIECE($GET(^AUPNVPOV(Y,0)),U)
+6 IF Q=""
QUIT
+7 ;not in taxonomy
IF '$$ICD^APCLSILU(Q,T,9)
QUIT
+8 ;code
SET Z=$$VAL^XBDIQ1(9000010.07,Y,.01)
+9 QUIT
End DoDot:2
+10 ;NO ANGIO
IF Z=""
QUIT
+11 ;code and date of ANGIOEDEMA
SET G=Z_","_$$VD^APCLV(V)
End DoDot:1
+12 QUIT G
PCVASTH(APCLV,D) ;EP
+1 NEW X,P,Y,Z,T,G,C,APCL,E,S,V
+2 SET G=""
+3 SET P=$PIECE(^AUPNVSIT(APCLV,0),U,5)
+4 ;S D=$$VD^APCLV(APCLV)
+5 SET E=$$FMADD^XLFDT(D,7)
+6 ;get all visits from D to D+7
+7 DO ALLV^APCLAPIU(P,D,E,"APCL")
+8 IF '$DATA(APCL)
QUIT ""
+9 ;now get rid of non 30/80, non-H visits, and those whose primary dx is not ASTHMA
+10 SET X=0
FOR
SET X=$ORDER(APCL(X))
IF X'=+X!(G]"")
QUIT
Begin DoDot:1
+11 SET V=$PIECE(APCL(X),U,5)
+12 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+13 SET Z=0
+14 ;no chart reviews or Telephone calls or events
IF "AORSHI"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+15 ;h
IF $PIECE(^AUPNVSIT(V,0),U,7)="H"
SET Z=1
+16 IF $$CLINIC^APCLV(V,"C")=30
SET Z=1
+17 IF $$CLINIC^APCLV(V,"C")=80
SET Z=1
+18 ;not an H or 30/80
IF 'Z
QUIT
+19 ;does it have an asthma dx?
+20 SET T=$ORDER(^ATXAX("B","SURVEILLANCE ADV EVENTS ASTHMA",0))
+21 IF 'T
QUIT
+22 SET Z=""
SET Y=0
FOR
SET Y=$ORDER(^AUPNVPOV("AD",V,Y))
IF Y'=+Y!(Z]"")
QUIT
Begin DoDot:2
+23 SET Q=$PIECE($GET(^AUPNVPOV(Y,0)),U)
+24 IF Q=""
QUIT
+25 ;not in taxonomy
IF '$$ICD^APCLSILU(Q,T,9)
QUIT
+26 ;code
SET Z=$$VAL^XBDIQ1(9000010.07,Y,.01)
+27 QUIT
End DoDot:2
+28 ;NO ASTHMA
IF Z=""
QUIT
+29 ;code and date of ASTHMA
SET G=Z_","_$$VD^APCLV(V)
End DoDot:1
+30 QUIT G
PCVIMMUN(APCLV,D) ;EP
+1 NEW X,P,Y,Z,T,G,C,APCL,E,S,V
+2 SET G=""
+3 SET P=$PIECE(^AUPNVSIT(APCLV,0),U,5)
+4 ;S D=$$VD^APCLV(APCLV)
+5 SET E=$$FMADD^XLFDT(D,7)
+6 ;get all visits from D to D+7
+7 DO ALLV^APCLAPIU(P,D,E,"APCL")
+8 IF '$DATA(APCL)
QUIT ""
+9 SET X=0
FOR
SET X=$ORDER(APCL(X))
IF X'=+X!(G]"")
QUIT
Begin DoDot:1
+10 SET V=$PIECE(APCL(X),U,5)
+11 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+12 ;no chart reviews or Telephone calls
IF "AORSH"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+13 ;does it have a IMMUNIOLOGICAL dx?
+14 SET T=$ORDER(^ATXAX("B","SURVEILLANCE IMMUNOLOGICAL",0))
+15 IF 'T
QUIT
+16 SET Z=""
SET Y=0
FOR
SET Y=$ORDER(^AUPNVPOV("AD",V,Y))
IF Y'=+Y!(Z]"")
QUIT
Begin DoDot:2
+17 SET Q=$PIECE($GET(^AUPNVPOV(Y,0)),U)
+18 IF Q=""
QUIT
+19 ;not in taxonomy
IF '$$ICD^APCLSILU(Q,T,9)
QUIT
+20 ;code
SET Z=$$VAL^XBDIQ1(9000010.07,Y,.01)
+21 QUIT
End DoDot:2
+22 ;NO IMMUNO
IF Z=""
QUIT
+23 ;code and date of IMMUNIOLOGICAL
SET G=Z_","_$$VD^APCLV(V)
End DoDot:1
+24 QUIT G
SET ;EP
+1 ;create entry with start date of DT
+2 SET APCLET=$HOROLOG
+3 NEW APCLFDA,APCLIENS,APCLERR
+4 SET APCLIENS="+2,"_1_","
+5 SET APCLFDA(9001003.312,APCLIENS,.01)=DT
+6 ;is this a test system?
+7 NEW TST,F
+8 SET TST=0
+9 ;I '$$PROD^XUPROD() S TST=1
+10 IF $PIECE($GET(^APCLILIC(1,0)),U,5)="T"
SET TST=1
+11 ;IHS/CMI/LAB - PATCH 31 FILENAME AND PATCH #
SET F=$SELECT(TST:"FLZ",$GET(APCLFLF):"FLF",$GET(APCLFLFN):"FLF",1:"FLU")_"_"_APCLASU_"_"_$$DATE^APCLSIHL(DT)_"_P31.txt"
+12 ;S F=$S(TST:"FLZ",$G(APCLFLF):"FLF",1:"FLU")_"_"_APCLASU_"_"_$$DATE^APCLSILI(DT)_".txt"
+13 SET APCLFDA(9001003.312,APCLIENS,.02)=F
+14 SET APCLFDA(9001003.312,APCLIENS,.05)=$SELECT(XBFLG:0,1:1)
+15 SET APCLFDA(9001003.312,APCLIENS,.04)=APCLVTOT
+16 SET APCLFDA(9001003.312,APCLIENS,.06)=$$HTFM^XLFDT(APCLBT)
+17 SET APCLFDA(9001003.312,APCLIENS,.07)=$$HTFM^XLFDT(APCLET)
+18 SET APCLFDA(9001003.312,APCLIENS,.08)=$$RUNTIME(APCLBT,APCLET)
+19 DO UPDATE^DIE("","APCLFDA","APCLIENS","APCLERR(1)")
+20 QUIT
RUNTIME(B,E) ;
+1 NEW S,H,M,SEC,RT
+2 SET RT=""
+3 SET S=(86400*($PIECE(E,",")-$PIECE(B,",")))+($PIECE(E,",",2)-$PIECE(B,",",2))
SET H=$PIECE(S/3600,".")
IF H=""
SET H=0
Begin DoDot:1
+4 SET S=S-(H*3600)
SET M=$PIECE(S/60,".")
IF M=""
SET M=0
SET S=S-(M*60)
SET SEC=S
SET RT="RUN TIME (H.M.S): "_H_"."_M_"."_SEC
End DoDot:1
+5 QUIT RT
HASADVN6(APCLV,D1,D2) ;EP - PATCH 27 - if return 1 then count visit and put pieces 2 through n in columns 66 through 75
+1 NEW X,P,Y,Z,T,G,C,APCL,E,S,V,PAT,P1,P2,APCLVDAT,APCLHAS
+2 SET G=""
+3 ;S D=$$VD^APCLV(APCLV) ;VISIT DATE
+4 ;S E=$$FMADD^XLFDT(D,60) ;END DATE TO LOOK
+5 SET PAT=$PIECE(^AUPNVSIT(APCLV,0),U,5)
+6 SET (C,P1,P2)=0
+7 SET (D,E)=""
+8 KILL APCLHAS
+9 IF D1=""
GOTO D2
+10 DO ALLV^APCLAPIU(PAT,D1,$$FMADD^XLFDT(D1,60),"APCL")
+11 SET APCLVDAT=D1
+12 DO D
+13 IF D1=D2
QUIT 1_U_D_U_E
D2 ;
+1 KILL APCL
+2 DO ALLV^APCLAPIU(PAT,D2,$$FMADD^XLFDT(D2,60),"APCL")
+3 SET APCLVDAT=D2
+4 DO D
+5 IF 'C
QUIT ""
+6 QUIT 1_U_D_U_E
D ;
+1 IF '$DATA(APCL)
QUIT
+2 ;NOW GET RID OF ALL NON PHN/ILI CLINIC VISITS
+3 SET APCLX=0
FOR
SET APCLX=$ORDER(APCL(APCLX))
IF APCLX'=+APCLX!(C>4)
QUIT
Begin DoDot:1
+4 SET V=$PIECE(APCL(APCLX),U,5)
+5 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+6 SET Z=0
+7 ;
+8 ;no chart reviews or Telephone calls
IF "AORSH"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+9 SET CLNTAX=$ORDER(^ATXAX("B","SURVEILLANCE ILI CLINICS",0))
+10 ;get clinic code
SET APCLCLIN=$$CLINIC^APCLV(V,"I")
+11 ;is there a PHN
+12 SET X=0
SET P=0
FOR
SET X=$ORDER(^AUPNVPRV("AD",V,X))
IF X'=+X!(P)
QUIT
Begin DoDot:2
+13 IF '$DATA(^AUPNVPRV(X,0))
QUIT
+14 SET Y=$PIECE(^AUPNVPRV(X,0),U)
+15 SET Z=$$VALI^XBDIQ1(200,Y,53.5)
+16 IF 'Z
QUIT
+17 IF $PIECE($GET(^DIC(7,Z,9999999)),U,1)=13
SET P=1
End DoDot:2
+18 IF P
GOTO HASADN61
+19 IF $PIECE(^AUPNVSIT(V,0),U,7)'="H"
IF APCLCLIN=""
QUIT
+20 ;not in clinic taxonomy
IF $PIECE(^AUPNVSIT(V,0),U,7)'="H"
IF '$DATA(^ATXAX(CLNTAX,21,"B",APCLCLIN))
QUIT
+21 SET P=1
+22 ;does it have aN ADVERSE EVENT
HASADN61 ;
+1 SET X=0
FOR
SET X=$ORDER(^AUPNVPOV("AD",V,X))
IF X'=+X!(C>4)
QUIT
Begin DoDot:2
+2 SET T=$PIECE(^AUPNVPOV(X,0),U)
+3 IF $$ICD^APCLSILU(T,$ORDER(^ATXAX("B","SURVEILLANCE ADV EVENTS DXS",0)),9)
Begin DoDot:3
+4 ;$$VD^APCLV(APCLV) ;NOT SAME DATE AS VACCINE
IF $$VD^APCLV(V)=APCLVDAT
QUIT
+5 ;Q:$$VD^APCLV(V)>$$FMADD^XLFDT($$VD^APCLV(APCLV),14)
+6 DO SET6
QUIT
End DoDot:3
+7 IF $$ICD^APCLSILU(T,$ORDER(^ATXAX("B","SURVEILLANCE ADV EVENTS LIVE",0)),9)
Begin DoDot:3
+8 SET A=$$AGE^APCLSILU(PAT,2,$$VD^APCLV(V))
+9 IF A<24
QUIT
+10 IF A>59
QUIT
+11 ;$$VD^APCLV(APCLV) ;NOT SAME DATE AS VACCINE
IF $$VD^APCLV(V)=APCLVDAT
QUIT
+12 IF $$VD^APCLV(V)>$$FMADD^XLFDT(APCLVDAT,14)
QUIT
+13 DO SET6
+14 QUIT
End DoDot:3
QUIT
+15 IF $$ICD^APCLSILU(T,$ORDER(^ATXAX("B","SURVEILLANCE ADV EVENT FEBRILE",0)),9)
Begin DoDot:3
+16 SET A=$$AGE^APCLSILU(PAT,2,$$VD^APCLV(V))
+17 IF A>59
QUIT
+18 IF $$VD^APCLV(V)>$$FMADD^XLFDT(APCLVDAT,15)
QUIT
+19 DO SET6
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+20 ;"" ;no diagnosis
IF 'C
QUIT
+21 ;
QUIT
SET6 ;
+1 ;ALREADY HAVE THIS ONE
IF $DATA(APCLHAS(X))
QUIT
+2 SET APCLHAS(X)=""
+3 SET C=C+1
SET P1=P1+1
SET P2=P2+1
+4 SET $PIECE(D,",",P1)=$$VAL^XBDIQ1(9000010.07,X,.01)
+5 SET $PIECE(E,",",P1)=$$VD^APCLV(V)
+6 QUIT
HASAVM(V) ;EP
+1 NEW C,X,Y,Z,T,L,M,N
+2 SET T=$ORDER(^ATXAX("B","FLU ANTIVIRAL MEDS",0))
+3 SET C=""
SET X=0
FOR
SET X=$ORDER(^AUPNVMED("AD",V,X))
IF X'=+X!(C)
QUIT
SET Y=$PIECE($GET(^AUPNVMED(X,0)),U)
Begin DoDot:1
+4 IF 'Y
QUIT
+5 IF '$DATA(^PSDRUG(Y,0))
QUIT
+6 SET Z=0
+7 SET N=$PIECE(^PSDRUG(Y,0),U)
+8 IF $DATA(^ATXAX(T,21,"B",Y))
SET Z=1
+9 IF N["OSELTAMIVIR"
SET Z=1
+10 IF N["ZANAMIVIR"
SET Z=1
+11 IF N["RIMANTADINE"
SET Z=1
+12 IF N["AMANTADINE"
SET Z=1
+13 IF Z=1
SET C=1_U_N_U_$PIECE(^AUPNVMED(X,0),U,7)
+14 QUIT
End DoDot:1
+15 QUIT C
HASNVAC(V) ;EP - get h1n1 vaccine
+1 NEW C,X,Y,Z,T,L,M
+2 SET T=$ORDER(^ATXAX("B","SURVEILLANCE PANDEMIC CVX",0))
+3 SET C=0
SET X=0
FOR
SET X=$ORDER(^AUPNVIMM("AD",V,X))
IF X'=+X!(C)
QUIT
SET Y=$PIECE($GET(^AUPNVIMM(X,0)),U)
Begin DoDot:1
+4 IF 'Y
QUIT
+5 IF '$DATA(^AUTTIMM(Y,0))
QUIT
+6 SET Z=$PIECE(^AUTTIMM(Y,0),U,3)
+7 IF '$DATA(^ATXAX(T,21,"B",Z))
QUIT
+8 SET C=1_U_Z_U_$$VAL^XBDIQ1(9000010.11,X,.05)
IF $PIECE(^AUPNVIMM(X,0),U,5)
IF $DATA(^AUTTIML($PIECE(^AUPNVIMM(X,0),U,5),0))
SET C=C_U_$$VAL^XBDIQ1(9999999.41,$PIECE(^AUPNVIMM(X,0),U,5),.02)
+9 SET Z=$$VALI^XBDIQ1(9000010.11,X,1201)
+10 SET $PIECE(C,U,5)=$SELECT(Z:$PIECE(Z,".",1),1:$$VD^APCLV(V))
+11 QUIT
End DoDot:1
+12 IF C
QUIT C
+13 SET T=$ORDER(^ATXAX("B","SURVEILLANCE PANDEMIC CPT",0))
+14 IF 'T
QUIT C
+15 SET C=0
SET X=0
FOR
SET X=$ORDER(^AUPNVCPT("AD",V,X))
IF X'=+X
QUIT
SET Y=$PIECE($GET(^AUPNVCPT(X,0)),U)
Begin DoDot:1
+16 IF 'Y
QUIT
+17 IF '$$ICD^APCLSILU(Y,T,1)
QUIT
+18 SET C=1_U_$$VAL^XBDIQ1(9000010.18,X,.01)
End DoDot:1
+19 QUIT C
