BQIIPEMP ;VNGT/HS/ALA-Empanelled Patients ; 06 May 2011 1:38 PM
;;2.7;ICARE MANAGEMENT SYSTEM;;Dec 19, 2017;Build 23
;
;
EN(BQDATE,BQFROM,BQTHRU) ;EP
NEW BQMON,BQDTE,BEGDT,EDAY,ENDT,PYR,CYR,ID,FAC,BQITOTP,BQITOTR,DFN,BD,ED
NEW BQGOTA,F,QFL,X,Y,CRST
S QFL=0
S CRST=$P($G(^BQI(90508,1,11)),U,2) S:CRST="" CRST=1
S CRST="0"_CRST
;
I $G(BQDATE)'="",$G(WEEK)="" D
. S BEGDT=$E(BQDATE,1,5)_"01",CYR=$E(BQDATE,1,3),BQMON=$E(BQDATE,4,5)
. I $L(BQMON)=1 S BQMON="0"_BQMON
. S EDAY="31^"_($$LEAP^XLFDT2(CYR)+28)_"^31^30^31^30^31^31^30^31^30^31"
. S ENDT=$E(BQDATE,1,5)_$P(EDAY,U,+BQMON)
;
I $G(BQDATE)="",$G(WEEK)="" D Q:QFL
. I $E(DT,6,7)'=CRST S QFL=1 Q
. S BQMON=$E(DT,4,5)-1,CYR=$E(DT,1,3),PYR=CYR-1
. S BQDTE=$P($T(BQM+BQMON),";;",2)
. I $L(BQMON)=1 S BQMON="0"_BQMON
. S BEGDT=@($P(BQDTE,U,2))_$P(BQDTE,U,1)_"01"
. S EDAY="31^"_($$LEAP^XLFDT2(CYR)+28)_"^31^30^31^30^31^31^30^31^30^31"
. S ENDT=@($P(BQDTE,U,2))_$P(BQDTE,U,1)_$P(EDAY,U,+$P(BQDTE,U,1))
. S BQDATE=$S(BQMON="01":PYR,1:CYR)_BQMON_"00"
;
I $G(WEEK)=1 D
. S BGDT=BQFROM-.9999,ENDT=BQTHRU
;
S ID="IPC_PEMP"
S FAC=$$HME^BQIGPUTL()
;
I $G(WEEK)="" S BGDT=$$FMADD^XLFDT(ENDT,1),BGDT=($E(BGDT,1,3)-3)_$E(BGDT,4,7)
; BQITOTP = Total active patients ; BQITOTR = Total active patients empanelled
S BQITOTP=0,BQITOTR=0
;
S DFN=0
F S DFN=$O(^AUPNPAT(DFN)) Q:'DFN D
. I $G(^AUPNPAT(DFN,0))="" Q
. I $G(^DPT(DFN,0))="" Q
. ; If patient merged to a different IEN
. I $P(^DPT(DFN,0),U,19)'="" Q
. ; if a demo patient
. I $$DEMO^APCLUTL(DFN,"E") Q
. ; if deceased
. I $D(^DPT(DFN,.35)),$P(^(.35),U)]"",$P(^(.35),U)'>ENDT Q
. ; if no HRN for this facility
. I $G(^AUPNPAT(DFN,41,FAC,0))="" Q
. ; if HRN marked inactive
. ;I $P($G(^AUPNPAT(DFN,41,FAC,0)),U,3)'="",$P($G(^AUPNPAT(DFN,41,FAC,0)),U,3)'>ENDT Q
. ;
. S BD=(9999999-ENDT)-.0001,ED=9999999-BGDT,BQGOTA=0
. F S BD=$O(^AUPNVSIT("AA",DFN,BD)) Q:BD=""!(BD\1>ED) D
.. S VISIT=""
.. F S VISIT=$O(^AUPNVSIT("AA",DFN,BD,VISIT)) Q:VISIT="" D
... I $G(^AUPNVSIT(VISIT,0))="" Q
... I $P(^AUPNVSIT(VISIT,0),U,11) Q
... I BQGOTA=1 Q
... Q:'$P(^AUPNVSIT(VISIT,0),U,9)
... Q:"DXECTI"[$P(^AUPNVSIT(VISIT,0),U,7)
... S CL=$$CLINIC^APCLV(VISIT,"C") I CL=11!(CL=68)!(CL=51)!(CL=52) Q
... Q:'$D(^AUPNVPOV("AD",VISIT))
... Q:$$PRIMPROV^APCLV(VISIT,"I")=""
... S F=$P(^AUPNVSIT(VISIT,0),U,6) I F="" Q
... I F'=FAC Q
... S BQGOTA=1
... S BQITOTP=BQITOTP+1 ; Denominator
... I $P(^AUPNPAT(DFN,0),U,14) S BQITOTR=BQITOTR+1 ; Numerator
;
I $G(WEEK)="" D STORF^BQIIPUTL(FAC,ID,BQDATE,BQITOTP,BQITOTR)
I $G(WEEK)=1 D STORFW^BQIIPUTL(FAC,ID,BQFROM,BQTHRU,BQITOTP,BQITOTR)
Q
;
BQM ;
;;12^PYR
;;01^CYR
;;02^CYR
;;03^CYR
;;04^CYR
;;05^CYR
;;06^CYR
;;07^CYR
;;08^CYR
;;09^CYR
;;10^CYR
;;11^CYR
BQIIPEMP ;VNGT/HS/ALA-Empanelled Patients ; 06 May 2011 1:38 PM
+1 ;;2.7;ICARE MANAGEMENT SYSTEM;;Dec 19, 2017;Build 23
+2 ;
+3 ;
EN(BQDATE,BQFROM,BQTHRU) ;EP
+1 NEW BQMON,BQDTE,BEGDT,EDAY,ENDT,PYR,CYR,ID,FAC,BQITOTP,BQITOTR,DFN,BD,ED
+2 NEW BQGOTA,F,QFL,X,Y,CRST
+3 SET QFL=0
+4 SET CRST=$PIECE($GET(^BQI(90508,1,11)),U,2)
IF CRST=""
SET CRST=1
+5 SET CRST="0"_CRST
+6 ;
+7 IF $GET(BQDATE)'=""
IF $GET(WEEK)=""
Begin DoDot:1
+8 SET BEGDT=$EXTRACT(BQDATE,1,5)_"01"
SET CYR=$EXTRACT(BQDATE,1,3)
SET BQMON=$EXTRACT(BQDATE,4,5)
+9 IF $LENGTH(BQMON)=1
SET BQMON="0"_BQMON
+10 SET EDAY="31^"_($$LEAP^XLFDT2(CYR)+28)_"^31^30^31^30^31^31^30^31^30^31"
+11 SET ENDT=$EXTRACT(BQDATE,1,5)_$PIECE(EDAY,U,+BQMON)
End DoDot:1
+12 ;
+13 IF $GET(BQDATE)=""
IF $GET(WEEK)=""
Begin DoDot:1
+14 IF $EXTRACT(DT,6,7)'=CRST
SET QFL=1
QUIT
+15 SET BQMON=$EXTRACT(DT,4,5)-1
SET CYR=$EXTRACT(DT,1,3)
SET PYR=CYR-1
+16 SET BQDTE=$PIECE($TEXT(BQM+BQMON),";;",2)
+17 IF $LENGTH(BQMON)=1
SET BQMON="0"_BQMON
+18 SET BEGDT=@($PIECE(BQDTE,U,2))_$PIECE(BQDTE,U,1)_"01"
+19 SET EDAY="31^"_($$LEAP^XLFDT2(CYR)+28)_"^31^30^31^30^31^31^30^31^30^31"
+20 SET ENDT=@($PIECE(BQDTE,U,2))_$PIECE(BQDTE,U,1)_$PIECE(EDAY,U,+$PIECE(BQDTE,U,1))
+21 SET BQDATE=$SELECT(BQMON="01":PYR,1:CYR)_BQMON_"00"
End DoDot:1
IF QFL
QUIT
+22 ;
+23 IF $GET(WEEK)=1
Begin DoDot:1
+24 SET BGDT=BQFROM-.9999
SET ENDT=BQTHRU
End DoDot:1
+25 ;
+26 SET ID="IPC_PEMP"
+27 SET FAC=$$HME^BQIGPUTL()
+28 ;
+29 IF $GET(WEEK)=""
SET BGDT=$$FMADD^XLFDT(ENDT,1)
SET BGDT=($EXTRACT(BGDT,1,3)-3)_$EXTRACT(BGDT,4,7)
+30 ; BQITOTP = Total active patients ; BQITOTR = Total active patients empanelled
+31 SET BQITOTP=0
SET BQITOTR=0
+32 ;
+33 SET DFN=0
+34 FOR
SET DFN=$ORDER(^AUPNPAT(DFN))
IF 'DFN
QUIT
Begin DoDot:1
+35 IF $GET(^AUPNPAT(DFN,0))=""
QUIT
+36 IF $GET(^DPT(DFN,0))=""
QUIT
+37 ; If patient merged to a different IEN
+38 IF $PIECE(^DPT(DFN,0),U,19)'=""
QUIT
+39 ; if a demo patient
+40 IF $$DEMO^APCLUTL(DFN,"E")
QUIT
+41 ; if deceased
+42 IF $DATA(^DPT(DFN,.35))
IF $PIECE(^(.35),U)]""
IF $PIECE(^(.35),U)'>ENDT
QUIT
+43 ; if no HRN for this facility
+44 IF $GET(^AUPNPAT(DFN,41,FAC,0))=""
QUIT
+45 ; if HRN marked inactive
+46 ;I $P($G(^AUPNPAT(DFN,41,FAC,0)),U,3)'="",$P($G(^AUPNPAT(DFN,41,FAC,0)),U,3)'>ENDT Q
+47 ;
+48 SET BD=(9999999-ENDT)-.0001
SET ED=9999999-BGDT
SET BQGOTA=0
+49 FOR
SET BD=$ORDER(^AUPNVSIT("AA",DFN,BD))
IF BD=""!(BD\1>ED)
QUIT
Begin DoDot:2
+50 SET VISIT=""
+51 FOR
SET VISIT=$ORDER(^AUPNVSIT("AA",DFN,BD,VISIT))
IF VISIT=""
QUIT
Begin DoDot:3
+52 IF $GET(^AUPNVSIT(VISIT,0))=""
QUIT
+53 IF $PIECE(^AUPNVSIT(VISIT,0),U,11)
QUIT
+54 IF BQGOTA=1
QUIT
+55 IF '$PIECE(^AUPNVSIT(VISIT,0),U,9)
QUIT
+56 IF "DXECTI"[$PIECE(^AUPNVSIT(VISIT,0),U,7)
QUIT
+57 SET CL=$$CLINIC^APCLV(VISIT,"C")
IF CL=11!(CL=68)!(CL=51)!(CL=52)
QUIT
+58 IF '$DATA(^AUPNVPOV("AD",VISIT))
QUIT
+59 IF $$PRIMPROV^APCLV(VISIT,"I")=""
QUIT
+60 SET F=$PIECE(^AUPNVSIT(VISIT,0),U,6)
IF F=""
QUIT
+61 IF F'=FAC
QUIT
+62 SET BQGOTA=1
+63 ; Denominator
SET BQITOTP=BQITOTP+1
+64 ; Numerator
IF $PIECE(^AUPNPAT(DFN,0),U,14)
SET BQITOTR=BQITOTR+1
End DoDot:3
End DoDot:2
End DoDot:1
+65 ;
+66 IF $GET(WEEK)=""
DO STORF^BQIIPUTL(FAC,ID,BQDATE,BQITOTP,BQITOTR)
+67 IF $GET(WEEK)=1
DO STORFW^BQIIPUTL(FAC,ID,BQFROM,BQTHRU,BQITOTP,BQITOTR)
+68 QUIT
+69 ;
BQM ;
+1 ;;12^PYR
+2 ;;01^CYR
+3 ;;02^CYR
+4 ;;03^CYR
+5 ;;04^CYR
+6 ;;05^CYR
+7 ;;06^CYR
+8 ;;07^CYR
+9 ;;08^CYR
+10 ;;09^CYR
+11 ;;10^CYR
+12 ;;11^CYR