APCLRIN1 ; IHS/CMI/LAB - INTERNET ACCESS ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
;
ALL(P,EDATE,T,B) ;EP - is this patient in user pop?
S T=$G(T)
S B=$G(B)
I B=1,$$BEN^AUPNPAT(P,"C")'="01" Q 0 ;must be Indian/Alaskan Native
I B=2,$$BEN^AUPNPAT(P,"C")="01" Q 0 ;must not be I/A
S DOD=$$DOD^AUPNPAT(P) I DOD]"",DOD<EDATE Q 0
I 'T Q 1
S X=$P($G(^AUPNPAT(P,11)),U,18) I X="" Q 0
I '$D(^ATXAX(T,21,"B",($P(^AUPNPAT(P,11),U,18)))),'$D(^ATXAX(T,21,"AA",$P(^AUPNPAT(P,11),U,18),$P(^AUPNPAT(P,11),U,18))) Q 0
Q 1
;
UP(P,BDATE,EDATE,T,B) ;EP - is this patient in user pop?
S T=$G(T)
S B=$G(B)
I B=1,$$BEN^AUPNPAT(P,"C")'="01" Q 0 ;must be Indian/Alaskan Native
I B=2,$$BEN^AUPNPAT(P,"C")="01" Q 0 ;must not be I/A
S DOD=$$DOD^AUPNPAT(P) I DOD]"",DOD<EDATE Q 0
I T D I X="" Q 0
.S X=$P($G(^AUPNPAT(P,11)),U,18) I X="" Q
.I '$D(^ATXAX(T,21,"B",($P(^AUPNPAT(P,11),U,18)))),'$D(^ATXAX(T,21,"AA",$P(^AUPNPAT(P,11),U,18),$P(^AUPNPAT(P,11),U,18))) S X="" Q
S X=$$LASTVD(P,BDATE,EDATE)
Q $S(X:1,1:0)
;
ACTCL(P,BDATE,EDATE,APCLTAXI,APCLBEN,CHS) ;EP - clinical user
NEW X,GY,F,S,V
S T=$G(T)
S B=$G(B)
I B=1,$$BEN^AUPNPAT(P,"C")'="01" Q 0 ;must be Indian/Alaskan Native
I B=2,$$BEN^AUPNPAT(P,"C")="01" Q 0 ;must not be I/A
S DOD=$$DOD^AUPNPAT(P) I DOD]"",DOD<EDATE Q 0
I T D I X="" Q 0
.S X=$P($G(^AUPNPAT(P,11)),U,18) I X="" Q
.I '$D(^ATXAX(T,21,"B",($P(^AUPNPAT(P,11),U,18)))),'$D(^ATXAX(T,21,"AA",$P(^AUPNPAT(P,11),U,18),$P(^AUPNPAT(P,11),U,18))) S X="" Q
S X=$$LASTVD(P,BDATE,EDATE)
I CHS G CHSACTCL
NEW GY
S X=0 F S X=$O(^BGPCTRL("B",X)) Q:X'=+X S GY=X
S GY=$O(^BGPCTRL("B",GY,0))
S (X,G,F,S)=0 F S X=$O(^TMP($J,"A",X)) Q:X'=+X!(F) S V=$P(^TMP($J,"A",X),U,5) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$P(^AUPNVSIT(V,0),U,9)
.Q:$P(^AUPNVSIT(V,0),U,11)
.Q:'$D(^AUPNVPRV("AD",V))
.Q:"SAHO"'[$P(^AUPNVSIT(V,0),U,7)
.Q:"V"[$P(^AUPNVSIT(V,0),U,3)
.Q:$P(^AUPNVSIT(V,0),U,6)=""
.I $G(APCLMFIY),'$D(^ATXAX(APCLMFIY,21,"B",$P(^AUPNVSIT(V,0),U,6))) Q
.S B=$$CLINIC^APCLV(V,"C")
.Q:B=""
.I 'G,$D(^BGPCTRL(GY,11,"B",B)) S G=V ;must be a primary clinic S G=V
.I V'=G,$D(^BGPCTRL(GY,12,"B",B)) S S=1
.I G,S S F=1
.Q
Q $S(F:1,1:0)
;
LASTVD(P,BDATE,EDATE) ;
I '$D(^AUPNVSIT("AC",P)) Q ""
K ^TMP($J,"A")
S A="^TMP($J,""A"",",B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)
I '$D(^TMP($J,"A",1)) Q ""
S (X,G)=0 F S X=$O(^TMP($J,"A",X)) Q:X'=+X!(G) S V=$P(^TMP($J,"A",X),U,5) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$P(^AUPNVSIT(V,0),U,9)
.Q:$P(^AUPNVSIT(V,0),U,11)
.Q:'$D(^AUPNVPRV("AD",V))
.Q:"SAHO"'[$P(^AUPNVSIT(V,0),U,7)
.Q:"V"[$P(^AUPNVSIT(V,0),U,3)
.Q:$P(^AUPNVSIT(V,0),U,6)=""
.I $G(APCLMFIY),'$D(^ATXAX(APCLMFIY,21,"B",$P(^AUPNVSIT(V,0),U,6))) Q
.S G=1
.Q
Q G
;
CHSACTCL ;chs only sites active clinical defintion
;2 chs visits in past 3 years
S (X,G,F,S)=0 F S X=$O(^TMP($J,"A",X)) Q:X'=+X!(F>1) S V=$P(^TMP($J,"A",X),U,5) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$P(^AUPNVSIT(V,0),U,9)
.Q:$P(^AUPNVSIT(V,0),U,11)
.Q:'$D(^AUPNVPRV("AD",V))
.Q:"SAHOI"'[$P(^AUPNVSIT(V,0),U,7)
.Q:"C"'[$P(^AUPNVSIT(V,0),U,3)
.S F=F+1
Q $S(F>1:1,1:0)
;
APCLRIN1 ; IHS/CMI/LAB - INTERNET ACCESS ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
+3 ;
ALL(P,EDATE,T,B) ;EP - is this patient in user pop?
+1 SET T=$GET(T)
+2 SET B=$GET(B)
+3 ;must be Indian/Alaskan Native
IF B=1
IF $$BEN^AUPNPAT(P,"C")'="01"
QUIT 0
+4 ;must not be I/A
IF B=2
IF $$BEN^AUPNPAT(P,"C")="01"
QUIT 0
+5 SET DOD=$$DOD^AUPNPAT(P)
IF DOD]""
IF DOD<EDATE
QUIT 0
+6 IF 'T
QUIT 1
+7 SET X=$PIECE($GET(^AUPNPAT(P,11)),U,18)
IF X=""
QUIT 0
+8 IF '$DATA(^ATXAX(T,21,"B",($PIECE(^AUPNPAT(P,11),U,18))))
IF '$DATA(^ATXAX(T,21,"AA",$PIECE(^AUPNPAT(P,11),U,18),$PIECE(^AUPNPAT(P,11),U,18)))
QUIT 0
+9 QUIT 1
+10 ;
UP(P,BDATE,EDATE,T,B) ;EP - is this patient in user pop?
+1 SET T=$GET(T)
+2 SET B=$GET(B)
+3 ;must be Indian/Alaskan Native
IF B=1
IF $$BEN^AUPNPAT(P,"C")'="01"
QUIT 0
+4 ;must not be I/A
IF B=2
IF $$BEN^AUPNPAT(P,"C")="01"
QUIT 0
+5 SET DOD=$$DOD^AUPNPAT(P)
IF DOD]""
IF DOD<EDATE
QUIT 0
+6 IF T
Begin DoDot:1
+7 SET X=$PIECE($GET(^AUPNPAT(P,11)),U,18)
IF X=""
QUIT
+8 IF '$DATA(^ATXAX(T,21,"B",($PIECE(^AUPNPAT(P,11),U,18))))
IF '$DATA(^ATXAX(T,21,"AA",$PIECE(^AUPNPAT(P,11),U,18),$PIECE(^AUPNPAT(P,11),U,18)))
SET X=""
QUIT
End DoDot:1
IF X=""
QUIT 0
+9 SET X=$$LASTVD(P,BDATE,EDATE)
+10 QUIT $SELECT(X:1,1:0)
+11 ;
ACTCL(P,BDATE,EDATE,APCLTAXI,APCLBEN,CHS) ;EP - clinical user
+1 NEW X,GY,F,S,V
+2 SET T=$GET(T)
+3 SET B=$GET(B)
+4 ;must be Indian/Alaskan Native
IF B=1
IF $$BEN^AUPNPAT(P,"C")'="01"
QUIT 0
+5 ;must not be I/A
IF B=2
IF $$BEN^AUPNPAT(P,"C")="01"
QUIT 0
+6 SET DOD=$$DOD^AUPNPAT(P)
IF DOD]""
IF DOD<EDATE
QUIT 0
+7 IF T
Begin DoDot:1
+8 SET X=$PIECE($GET(^AUPNPAT(P,11)),U,18)
IF X=""
QUIT
+9 IF '$DATA(^ATXAX(T,21,"B",($PIECE(^AUPNPAT(P,11),U,18))))
IF '$DATA(^ATXAX(T,21,"AA",$PIECE(^AUPNPAT(P,11),U,18),$PIECE(^AUPNPAT(P,11),U,18)))
SET X=""
QUIT
End DoDot:1
IF X=""
QUIT 0
+10 SET X=$$LASTVD(P,BDATE,EDATE)
+11 IF CHS
GOTO CHSACTCL
+12 NEW GY
+13 SET X=0
FOR
SET X=$ORDER(^BGPCTRL("B",X))
IF X'=+X
QUIT
SET GY=X
+14 SET GY=$ORDER(^BGPCTRL("B",GY,0))
+15 SET (X,G,F,S)=0
FOR
SET X=$ORDER(^TMP($JOB,"A",X))
IF X'=+X!(F)
QUIT
SET V=$PIECE(^TMP($JOB,"A",X),U,5)
Begin DoDot:1
+16 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+17 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+18 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+19 IF '$DATA(^AUPNVPRV("AD",V))
QUIT
+20 IF "SAHO"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+21 IF "V"[$PIECE(^AUPNVSIT(V,0),U,3)
QUIT
+22 IF $PIECE(^AUPNVSIT(V,0),U,6)=""
QUIT
+23 IF $GET(APCLMFIY)
IF '$DATA(^ATXAX(APCLMFIY,21,"B",$PIECE(^AUPNVSIT(V,0),U,6)))
QUIT
+24 SET B=$$CLINIC^APCLV(V,"C")
+25 IF B=""
QUIT
+26 ;must be a primary clinic S G=V
IF 'G
IF $DATA(^BGPCTRL(GY,11,"B",B))
SET G=V
+27 IF V'=G
IF $DATA(^BGPCTRL(GY,12,"B",B))
SET S=1
+28 IF G
IF S
SET F=1
+29 QUIT
End DoDot:1
+30 QUIT $SELECT(F:1,1:0)
+31 ;
LASTVD(P,BDATE,EDATE) ;
+1 IF '$DATA(^AUPNVSIT("AC",P))
QUIT ""
+2 KILL ^TMP($JOB,"A")
+3 SET A="^TMP($J,""A"","
SET B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(B,A)
+4 IF '$DATA(^TMP($JOB,"A",1))
QUIT ""
+5 SET (X,G)=0
FOR
SET X=$ORDER(^TMP($JOB,"A",X))
IF X'=+X!(G)
QUIT
SET V=$PIECE(^TMP($JOB,"A",X),U,5)
Begin DoDot:1
+6 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+7 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+8 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+9 IF '$DATA(^AUPNVPRV("AD",V))
QUIT
+10 IF "SAHO"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+11 IF "V"[$PIECE(^AUPNVSIT(V,0),U,3)
QUIT
+12 IF $PIECE(^AUPNVSIT(V,0),U,6)=""
QUIT
+13 IF $GET(APCLMFIY)
IF '$DATA(^ATXAX(APCLMFIY,21,"B",$PIECE(^AUPNVSIT(V,0),U,6)))
QUIT
+14 SET G=1
+15 QUIT
End DoDot:1
+16 QUIT G
+17 ;
CHSACTCL ;chs only sites active clinical defintion
+1 ;2 chs visits in past 3 years
+2 SET (X,G,F,S)=0
FOR
SET X=$ORDER(^TMP($JOB,"A",X))
IF X'=+X!(F>1)
QUIT
SET V=$PIECE(^TMP($JOB,"A",X),U,5)
Begin DoDot:1
+3 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+4 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+5 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+6 IF '$DATA(^AUPNVPRV("AD",V))
QUIT
+7 IF "SAHOI"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+8 IF "C"'[$PIECE(^AUPNVSIT(V,0),U,3)
QUIT
+9 SET F=F+1
End DoDot:1
+10 QUIT $SELECT(F>1:1,1:0)
+11 ;
