- 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 ;
