BGPD22 ; IHS/CMI/LAB - indicator 18 ;
;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007
;
I22 ;EP ;EP - indicator 22
;Q:'$D(BGPIND(22))
S BGPSEX=$P(^DPT(DFN,0),U,2),BGPSEX=$S(BGPSEX="M":1,1:2)
S BGPNODE=$S(BGPTIME=1:180,BGPTIME=0:480,BGPTIME=8:880,1:99999)
S X=$$PHNV(DFN,BGPBDATE,BGPEDATE,BGPHOME,BGPRPT,BGPNODE,BGPTIME,BGPSEX)
I $P(X,U) D SAGE(BGPRPT,$S(BGPTIME=1:18,BGPTIME=0:48,BGPTIME=8:88,1:999),1,BGPSEX,1)
I $P(X,U,2) D SAGE(BGPRPT,$S(BGPTIME=1:18,BGPTIME=0:48,BGPTIME=8:88,1:999),3,BGPSEX,1)
D SAGE(BGPRPT,$S(BGPTIME=1:18,BGPTIME=0:48,BGPTIME=8:88,1:999),2,BGPSEX,$P(X,U))
D SAGE(BGPRPT,$S(BGPTIME=1:18,BGPTIME=0:48,BGPTIME=8:88,1:999),4,BGPSEX,$P(X,U,2))
I $D(BGPLIST(22)),BGPTIME=1 S ^XTMP("BGPD",BGPJ,BGPH,"LIST",22,$S($P($G(^AUPNPAT(DFN,11)),U,18)]"":$P(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$P(^DPT(DFN,0),U,2),BGPAGEE,DFN)=$P(X,U)_" tot vis "_$P(X,U,2)_" home vis"
Q
SAGE(R,N,P,S,V) ;set age into file
I 'V Q ;no value
NEW X,Y
S X=$P($G(^BGPD(R,N)),U,P)
S $P(X,"!",S)=$P(X,"!",S)+V
S $P(^BGPD(R,N),U,P)=X
Q
S(R,N,P,V) ;
I 'V Q ;no value to add
S $P(^BGPD(R,N),U,P)=$P($G(^BGPD(R,N)),U,P)+V
Q
;
PHNV(P,BDATE,EDATE,LOC,R,N,TIME,SEX) ;count all phn visits for this patient
I $G(LOC)="" S LOC=""
NEW A,B,C,X,Y,%,H,Q,V,D,Z,HV
K ^TMP($J,"A") S A="^TMP($J,""A"","
S B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)
I '$D(^TMP($J,"A",1)) Q 0
S (X,Y,C)=0 F S X=$O(^TMP($J,"A",X)) Q:X'=+X S V=$P(^TMP($J,"A",X),U,5) D I Y S $P(C,U)=$P(C,U)+1 S HV=2 D POV,AGE D HOME
.S (D,Y)=0
.F S D=$O(^AUPNVPRV("AD",V,D)) Q:D'=+D S Q=$P(^AUPNVPRV(D,0),U),%=$$VALI^XBDIQ1($S($P(^AUTTSITE(1,0),U,22):200,1:6),Q,$S($P(^AUTTSITE(1,0),U,22):53.5,1:2)) I % S %=$P($G(^DIC(7,+%,9999999)),U) I %=13!(%=32) S Y=1
Q C
;
POV ;
NEW POVZ,POVX,POVY,POVA,POVB
S POVA=0 F S POVA=$O(^AUPNVPOV("AD",V,POVA)) Q:POVA'=+POVA D
.S POVB=$P(^AUPNVPOV(POVA,0),U),POVZ=$P($$ICDDX^ICDCODE(POVB),U,2)
.;S POVZ=$$PRIMPOV^APCLV(V,"C")
.Q:POVZ=""
.I '$D(^BGPD(R,N,"B",POVZ)) D
..S POVY=$P(^BGPD(R,N,0),U,3)
..S POVY=POVY+1
..S ^BGPD(R,N,POVY,0)=POVZ_"^"_0_"^"_0
..S $P(^BGPD(R,N,0),U,3)=POVY,$P(^BGPD(R,N,0),U,4)=POVY
..S ^BGPD(R,N,"B",POVZ,POVY)=""
.S POVY=$O(^BGPD(R,N,"B",POVZ,0)),$P(^BGPD(R,N,POVY,0),U,HV)=$P(^BGPD(R,N,POVY,0),U,HV)+1
Q
AGE ;
N DAYS,YRS
;set this visit is appropriate age group
S VD=$P($P(^AUPNVSIT(V,0),U),".")
S DAYS=$$FMDIFF^XLFDT(VD,$P(^DPT(P,0),U,3))
S YRS=$$AGE^AUPNPAT(P,VD)
I DAYS<29,HV=2 D SAGE(R,$S(TIME=1:18,TIME=0:48,TIME=8:88,1:999),5,SEX,1) Q
I DAYS>28,DAYS<366,HV=2 D SAGE(R,$S(TIME=1:18,TIME=0:48,TIME=8:88,1:999),6,SEX,1) Q
I YRS>0&(YRS<65),HV=2 D SAGE(R,$S(TIME=1:18,TIME=0:48,TIME=8:88,1:999),7,SEX,1) Q
I YRS>64,HV=2 D SAGE(R,$S(TIME=1:18,TIME=0:48,TIME=8:88,1:999),8,SEX,1) Q
I DAYS<29,HV=3 D SAGE(R,$S(TIME=1:18,TIME=0:48,TIME=8:88,1:999),9,SEX,1) Q
I DAYS>28,DAYS<366,HV=3 D SAGE(R,$S(TIME=1:18,TIME=0:48,TIME=8:88,1:999),10,SEX,1) Q
I YRS>0&(YRS<65),HV=3 D SAGE(R,$S(TIME=1:18,TIME=0:48,TIME=8:88,1:999),11,SEX,1) Q
I YRS>64,HV=3 D SAGE(R,$S(TIME=1:18,TIME=0:48,TIME=8:88,1:999),12,SEX,1) Q
Q
HOME ;
I $$CLINIC^APCLV(V,"C")=11 S $P(C,U,2)=$P(C,U,2)+1 S HV=3 D POV,AGE Q
Q:LOC=""
I LOC=$P(^AUPNVSIT(V,0),U,6) S $P(C,U,2)=$P(C,U,2)+1 S HV=3 D POV,AGE Q
Q
BGPD22 ; IHS/CMI/LAB - indicator 18 ;
+1 ;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007
+2 ;
I22 ;EP ;EP - indicator 22
+1 ;Q:'$D(BGPIND(22))
+2 SET BGPSEX=$PIECE(^DPT(DFN,0),U,2)
SET BGPSEX=$SELECT(BGPSEX="M":1,1:2)
+3 SET BGPNODE=$SELECT(BGPTIME=1:180,BGPTIME=0:480,BGPTIME=8:880,1:99999)
+4 SET X=$$PHNV(DFN,BGPBDATE,BGPEDATE,BGPHOME,BGPRPT,BGPNODE,BGPTIME,BGPSEX)
+5 IF $PIECE(X,U)
DO SAGE(BGPRPT,$SELECT(BGPTIME=1:18,BGPTIME=0:48,BGPTIME=8:88,1:999),1,BGPSEX,1)
+6 IF $PIECE(X,U,2)
DO SAGE(BGPRPT,$SELECT(BGPTIME=1:18,BGPTIME=0:48,BGPTIME=8:88,1:999),3,BGPSEX,1)
+7 DO SAGE(BGPRPT,$SELECT(BGPTIME=1:18,BGPTIME=0:48,BGPTIME=8:88,1:999),2,BGPSEX,$PIECE(X,U))
+8 DO SAGE(BGPRPT,$SELECT(BGPTIME=1:18,BGPTIME=0:48,BGPTIME=8:88,1:999),4,BGPSEX,$PIECE(X,U,2))
+9 IF $DATA(BGPLIST(22))
IF BGPTIME=1
SET ^XTMP("BGPD",BGPJ,BGPH,"LIST",22,$SELECT($PIECE($GET(^AUPNPAT(DFN,11)),U,18)]"":$PIECE(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$PIECE(^DPT(DFN,0),U,2),BGPAGEE,DFN)=$PIECE(X,U)_" tot vis "_$PIECE(X,U,2)_" home vis"
+10 QUIT
SAGE(R,N,P,S,V) ;set age into file
+1 ;no value
IF 'V
QUIT
+2 NEW X,Y
+3 SET X=$PIECE($GET(^BGPD(R,N)),U,P)
+4 SET $PIECE(X,"!",S)=$PIECE(X,"!",S)+V
+5 SET $PIECE(^BGPD(R,N),U,P)=X
+6 QUIT
S(R,N,P,V) ;
+1 ;no value to add
IF 'V
QUIT
+2 SET $PIECE(^BGPD(R,N),U,P)=$PIECE($GET(^BGPD(R,N)),U,P)+V
+3 QUIT
+4 ;
PHNV(P,BDATE,EDATE,LOC,R,N,TIME,SEX) ;count all phn visits for this patient
+1 IF $GET(LOC)=""
SET LOC=""
+2 NEW A,B,C,X,Y,%,H,Q,V,D,Z,HV
+3 KILL ^TMP($JOB,"A")
SET A="^TMP($J,""A"","
+4 SET B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(B,A)
+5 IF '$DATA(^TMP($JOB,"A",1))
QUIT 0
+6 SET (X,Y,C)=0
FOR
SET X=$ORDER(^TMP($JOB,"A",X))
IF X'=+X
QUIT
SET V=$PIECE(^TMP($JOB,"A",X),U,5)
Begin DoDot:1
+7 SET (D,Y)=0
+8 FOR
SET D=$ORDER(^AUPNVPRV("AD",V,D))
IF D'=+D
QUIT
SET Q=$PIECE(^AUPNVPRV(D,0),U)
SET %=$$VALI^XBDIQ1($SELECT($PIECE(^AUTTSITE(1,0),U,22):200,1:6),Q,$SELECT($PIECE(^AUTTSITE(1,0),U,22):53.5,1:2))
IF %
SET %=$PIECE($GET(^DIC(7,+%,9999999)),U)
IF %=13!(%=32)
SET Y=1
End DoDot:1
IF Y
SET $PIECE(C,U)=$PIECE(C,U)+1
SET HV=2
DO POV
DO AGE
DO HOME
+9 QUIT C
+10 ;
POV ;
+1 NEW POVZ,POVX,POVY,POVA,POVB
+2 SET POVA=0
FOR
SET POVA=$ORDER(^AUPNVPOV("AD",V,POVA))
IF POVA'=+POVA
QUIT
Begin DoDot:1
+3 SET POVB=$PIECE(^AUPNVPOV(POVA,0),U)
SET POVZ=$PIECE($$ICDDX^ICDCODE(POVB),U,2)
+4 ;S POVZ=$$PRIMPOV^APCLV(V,"C")
+5 IF POVZ=""
QUIT
+6 IF '$DATA(^BGPD(R,N,"B",POVZ))
Begin DoDot:2
+7 SET POVY=$PIECE(^BGPD(R,N,0),U,3)
+8 SET POVY=POVY+1
+9 SET ^BGPD(R,N,POVY,0)=POVZ_"^"_0_"^"_0
+10 SET $PIECE(^BGPD(R,N,0),U,3)=POVY
SET $PIECE(^BGPD(R,N,0),U,4)=POVY
+11 SET ^BGPD(R,N,"B",POVZ,POVY)=""
End DoDot:2
+12 SET POVY=$ORDER(^BGPD(R,N,"B",POVZ,0))
SET $PIECE(^BGPD(R,N,POVY,0),U,HV)=$PIECE(^BGPD(R,N,POVY,0),U,HV)+1
End DoDot:1
+13 QUIT
AGE ;
+1 NEW DAYS,YRS
+2 ;set this visit is appropriate age group
+3 SET VD=$PIECE($PIECE(^AUPNVSIT(V,0),U),".")
+4 SET DAYS=$$FMDIFF^XLFDT(VD,$PIECE(^DPT(P,0),U,3))
+5 SET YRS=$$AGE^AUPNPAT(P,VD)
+6 IF DAYS<29
IF HV=2
DO SAGE(R,$SELECT(TIME=1:18,TIME=0:48,TIME=8:88,1:999),5,SEX,1)
QUIT
+7 IF DAYS>28
IF DAYS<366
IF HV=2
DO SAGE(R,$SELECT(TIME=1:18,TIME=0:48,TIME=8:88,1:999),6,SEX,1)
QUIT
+8 IF YRS>0&(YRS<65)
IF HV=2
DO SAGE(R,$SELECT(TIME=1:18,TIME=0:48,TIME=8:88,1:999),7,SEX,1)
QUIT
+9 IF YRS>64
IF HV=2
DO SAGE(R,$SELECT(TIME=1:18,TIME=0:48,TIME=8:88,1:999),8,SEX,1)
QUIT
+10 IF DAYS<29
IF HV=3
DO SAGE(R,$SELECT(TIME=1:18,TIME=0:48,TIME=8:88,1:999),9,SEX,1)
QUIT
+11 IF DAYS>28
IF DAYS<366
IF HV=3
DO SAGE(R,$SELECT(TIME=1:18,TIME=0:48,TIME=8:88,1:999),10,SEX,1)
QUIT
+12 IF YRS>0&(YRS<65)
IF HV=3
DO SAGE(R,$SELECT(TIME=1:18,TIME=0:48,TIME=8:88,1:999),11,SEX,1)
QUIT
+13 IF YRS>64
IF HV=3
DO SAGE(R,$SELECT(TIME=1:18,TIME=0:48,TIME=8:88,1:999),12,SEX,1)
QUIT
+14 QUIT
HOME ;
+1 IF $$CLINIC^APCLV(V,"C")=11
SET $PIECE(C,U,2)=$PIECE(C,U,2)+1
SET HV=3
DO POV
DO AGE
QUIT
+2 IF LOC=""
QUIT
+3 IF LOC=$PIECE(^AUPNVSIT(V,0),U,6)
SET $PIECE(C,U,2)=$PIECE(C,U,2)+1
SET HV=3
DO POV
DO AGE
QUIT
+4 QUIT
