BQIIPUT1 ;GDIT/HCSD/ALA-IPC utilities ; 05 Apr 2018 7:44 AM
;;2.7;ICARE MANAGEMENT SYSTEM;**1**;Dec 19, 2017;Build 12
;
OFV(DFN) ;EP - Office Visit in past year
NEW BDATE,EDATE,TREF,TAX,RVBDT,RVEDT,VISIT,VAL,RVDATE,BQQN,SNO
; has the patient had an office visit in the past year
S BDATE=$$DATE^BQIUL1("T-12M"),EDATE=DT
S TREF=$NA(^TMP("BQITAX",$J)) K @TREF
F TAX="BGP IPC OFFICE VISIT CPTS","BGP IPC PREVCARE EOV >=18 CPTS","BGP IPC PREVCARE IOV >=18 CPTS","BGP IPC HOMEHEALTH VISIT CPTS","BGP IPC ANNUAL WELLNESS CPTS" D
. D BLD^BQITUTL(TAX,.TREF)
S RVBDT=9999999-BDATE,RVEDT=9999999-EDATE
F S RVEDT=$O(^AUPNVSIT("AA",DFN,RVEDT)) Q:RVEDT=""!((RVEDT\1)>RVBDT) D
. S VISIT="" F S VISIT=$O(^AUPNVSIT("AA",DFN,RVEDT,VISIT)) Q:VISIT="" D
.. ;no dependent entries
.. I '$P(^AUPNVSIT(VISIT,0),"^",9) Q
.. ;deleted
.. I $P(^AUPNVSIT(VISIT,0),"^",11) Q
.. I $$FTOF(VISIT,"PXRM BGP IPC FACE2FACE") S VAL((RVEDT\1),VISIT)="" Q
.. I $P(^AUPNVSIT(VISIT,0),"^",17)="" D CPT Q
.. S CP=$P(^AUPNVSIT(VISIT,0),"^",17) I $D(@TREF@(CP)) S VAL((RVEDT\1),VISIT)=""
;
S RVDATE=$O(VAL("")) I RVDATE'="" S RVDATE=9999999-RVDATE
Q $$FMTMDY^BQIUL1(RVDATE)
;
CPT ;EP
NEW CP,CDT,IEN,VISIT
S CP="" F S CP=$O(@TREF@(CP)) Q:CP="" D
. S CDT="" F S CDT=$O(^AUPNVCPT("AA",DFN,CP,CDT)) Q:CDT="" D
.. I CDT=(RVEDT\1) D
... S IEN="" F S IEN=$O(^AUPNVCPT("AA",DFN,CP,CDT,IEN)) Q:IEN="" S VISIT=$P(^AUPNVCPT(IEN,0),"^",3),VAL(CDT,VISIT)=""
Q
;
FLV(DFN) ;EP - Flu Visit
NEW BDATE,EDATE,TREF,TAX,RVBDT,RVEDT,VISIT,VAL,RVDATE,BQQN
; has the patient had an office visit in the past year
S BDATE=$$DATE^BQIUL1("T-12M"),EDATE=BDATE
S BDATE=$$FMADD^XLFDT(BDATE,-92),EDATE=$$FMADD^XLFDT(EDATE,89)
S TREF=$NA(^TMP("BQITAX",$J)) K @TREF
F TAX="BGP IPC FLU ENCOUNTER CPTS","BGP IPC PERI DIALYSIS CPTS","BGP IPC HEMO DIALYSIS CPTS" D BLD^BQITUTL(TAX,.TREF)
F TAX="BGP IPC OFFICE VISIT CPTS","BGP IPC OUTPT CONSULT CPTS","BGP IPC LT RES FACILITY CPTS","BGP IPC HOMEHEALTH VISIT CPTS" D BLD^BQITUTL(TAX,.TREF)
F TAX="BGP IPC PREVCARE IOV 0-17 CPTS","BGP IPC PREVCARE IOV >=18 CPTS","BGP IPC PREVCARE IND COUN CPTS","BGP IPC PREVCARE GRP COUN CPTS" D BLD^BQITUTL(TAX,.TREF)
F TAX="BGP IPC PREVCARE OTHER CPTS","BGP IPC DSCH SRV NURS FAC CPTS","BGP IPC NURS FAC VISIT CPTS","BGP IPC ANNUAL WELLNESS CPTS" D BLD^BQITUTL(TAX,.TREF)
F TAX="BGP IPC PERI DIALYSIS CPTS","BGP IPC HEMO DIALYSIS CPTS","BGP IPC PREVCARE EOV 0-17 CPTS","BGP IPC PREVCARE EOV >=18 CPTS" D BLD^BQITUTL(TAX,.TREF)
S RVBDT=9999999-BDATE,RVEDT=9999999-EDATE
F S RVEDT=$O(^AUPNVSIT("AA",DFN,RVEDT)) Q:RVEDT=""!((RVEDT\1)>RVBDT) D
. S VISIT="" F S VISIT=$O(^AUPNVSIT("AA",DFN,RVEDT,VISIT)) Q:VISIT="" D
.. ;no dependent entries
.. I '$P(^AUPNVSIT(VISIT,0),"^",9) Q
.. ;deleted
.. I $P(^AUPNVSIT(VISIT,0),"^",11) Q
.. I $$FTOF(VISIT,"PXRM BGP IPC FLU ENCOUNTER") S VAL((RVEDT\1),VISIT)="" Q
.. I $$FTOF(VISIT,"PXRM BGP IPC PAT PROV INT") S VAL((RVEDT\1),VISIT)="" Q
.. I $P(^AUPNVSIT(VISIT,0),"^",17)="" D CPT Q
.. S CP=$P(^AUPNVSIT(VISIT,0),"^",17) I $D(@TREF@(CP)) S VAL((RVEDT\1),VISIT)=""
;
S RVDATE=$O(VAL("")) I RVDATE'="" S RVDATE=9999999-RVDATE
Q $$FMTMDY^BQIUL1(RVDATE)_" ("_$$FMTMDY^BQIUL1(BDATE)_"-"_$$FMTMDY^BQIUL1(EDATE)_")"
;
FTOF(V,SNO) ;EP
NEW A,B,C
S A=0,B=""
F S A=$O(^AUPNVSIT(V,28,"B",A)) Q:A=""!(B]"") D
.I $D(^XTMP("BGPSNOMEDSUBSET",$J,SNO,A)) S B=A
Q B
;
PSV(DFN) ;EP - Psych Office Visit
; for Depression Remission
NEW BDATE,EDATE,TREF,TAX,RVBDT,RVEDT,VISIT,VAL,RVDATE,BQQN
; has the patient had an office visit in the past year
S BDATE=$$DATE^BQIUL1("T-12M"),EDATE=BDATE
S BDATE=$$FMADD^XLFDT(BDATE,-(13*30)),EDATE=$$FMADD^XLFDT(EDATE,-1)
S TREF=$NA(^TMP("BQITAX",$J)) K @TREF
F TAX="BGP IPC OFFICE VISIT CPTS","BGP IPC PSYCH VISIT CPTS" D BLD^BQITUTL(TAX,.TREF)
S RVBDT=9999999-BDATE,RVEDT=9999999-EDATE
F S RVEDT=$O(^AUPNVSIT("AA",DFN,RVEDT)) Q:RVEDT=""!((RVEDT\1)>RVBDT) D
. S VISIT="" F S VISIT=$O(^AUPNVSIT("AA",DFN,RVEDT,VISIT)) Q:VISIT="" D
.. ;no dependent entries
.. I '$P(^AUPNVSIT(VISIT,0),"^",9) Q
.. ;deleted
.. I $P(^AUPNVSIT(VISIT,0),"^",11) Q
.. S Q=$$PHQ9^BGP8PC13(VISIT)
.. I Q="" Q
.. I $P(^AUPNVSIT(VISIT,0),"^",17)="" D CPT Q
.. S CP=$P(^AUPNVSIT(VISIT,0),"^",17) I $D(@TREF@(CP)) S VAL((RVEDT\1),VISIT)=""
;
S RVDATE=$O(VAL("")) I RVDATE'="" S RVDATE=9999999-RVDATE
Q $$FMTMDY^BQIUL1(RVDATE)_" ("_$$FMTMDY^BQIUL1(BDATE)_"-"_$$FMTMDY^BQIUL1(EDATE)_")"
;
ADZ(DFN) ;EP - Adolescent Immunization requirement
NEW BDATE,EDATE,A11,A13,A
S BDATE=$$DATE^BQIUL1("T-12M"),EDATE=DT
S A=$$YBD^BGP8PC7(DFN,13)
I A>EDATE!(A<BDATE) Q "N/A"
S A11=$$YBD^BGP8PC7(DFN,11)
S A13=$$YBD^BGP8PC7(DFN,13)
Q $$FMTMDY^BQIUL1(A11)_"-"_$$FMTMDY^BQIUL1(A13)
BQIIPUT1 ;GDIT/HCSD/ALA-IPC utilities ; 05 Apr 2018 7:44 AM
+1 ;;2.7;ICARE MANAGEMENT SYSTEM;**1**;Dec 19, 2017;Build 12
+2 ;
OFV(DFN) ;EP - Office Visit in past year
+1 NEW BDATE,EDATE,TREF,TAX,RVBDT,RVEDT,VISIT,VAL,RVDATE,BQQN,SNO
+2 ; has the patient had an office visit in the past year
+3 SET BDATE=$$DATE^BQIUL1("T-12M")
SET EDATE=DT
+4 SET TREF=$NAME(^TMP("BQITAX",$JOB))
KILL @TREF
+5 FOR TAX="BGP IPC OFFICE VISIT CPTS","BGP IPC PREVCARE EOV >=18 CPTS","BGP IPC PREVCARE IOV >=18 CPTS","BGP IPC HOMEHEALTH VISIT CPTS","BGP IPC ANNUAL WELLNESS CPTS"
Begin DoDot:1
+6 DO BLD^BQITUTL(TAX,.TREF)
End DoDot:1
+7 SET RVBDT=9999999-BDATE
SET RVEDT=9999999-EDATE
+8 FOR
SET RVEDT=$ORDER(^AUPNVSIT("AA",DFN,RVEDT))
IF RVEDT=""!((RVEDT\1)>RVBDT)
QUIT
Begin DoDot:1
+9 SET VISIT=""
FOR
SET VISIT=$ORDER(^AUPNVSIT("AA",DFN,RVEDT,VISIT))
IF VISIT=""
QUIT
Begin DoDot:2
+10 ;no dependent entries
+11 IF '$PIECE(^AUPNVSIT(VISIT,0),"^",9)
QUIT
+12 ;deleted
+13 IF $PIECE(^AUPNVSIT(VISIT,0),"^",11)
QUIT
+14 IF $$FTOF(VISIT,"PXRM BGP IPC FACE2FACE")
SET VAL((RVEDT\1),VISIT)=""
QUIT
+15 IF $PIECE(^AUPNVSIT(VISIT,0),"^",17)=""
DO CPT
QUIT
+16 SET CP=$PIECE(^AUPNVSIT(VISIT,0),"^",17)
IF $DATA(@TREF@(CP))
SET VAL((RVEDT\1),VISIT)=""
End DoDot:2
End DoDot:1
+17 ;
+18 SET RVDATE=$ORDER(VAL(""))
IF RVDATE'=""
SET RVDATE=9999999-RVDATE
+19 QUIT $$FMTMDY^BQIUL1(RVDATE)
+20 ;
CPT ;EP
+1 NEW CP,CDT,IEN,VISIT
+2 SET CP=""
FOR
SET CP=$ORDER(@TREF@(CP))
IF CP=""
QUIT
Begin DoDot:1
+3 SET CDT=""
FOR
SET CDT=$ORDER(^AUPNVCPT("AA",DFN,CP,CDT))
IF CDT=""
QUIT
Begin DoDot:2
+4 IF CDT=(RVEDT\1)
Begin DoDot:3
+5 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVCPT("AA",DFN,CP,CDT,IEN))
IF IEN=""
QUIT
SET VISIT=$PIECE(^AUPNVCPT(IEN,0),"^",3)
SET VAL(CDT,VISIT)=""
End DoDot:3
End DoDot:2
End DoDot:1
+6 QUIT
+7 ;
FLV(DFN) ;EP - Flu Visit
+1 NEW BDATE,EDATE,TREF,TAX,RVBDT,RVEDT,VISIT,VAL,RVDATE,BQQN
+2 ; has the patient had an office visit in the past year
+3 SET BDATE=$$DATE^BQIUL1("T-12M")
SET EDATE=BDATE
+4 SET BDATE=$$FMADD^XLFDT(BDATE,-92)
SET EDATE=$$FMADD^XLFDT(EDATE,89)
+5 SET TREF=$NAME(^TMP("BQITAX",$JOB))
KILL @TREF
+6 FOR TAX="BGP IPC FLU ENCOUNTER CPTS","BGP IPC PERI DIALYSIS CPTS","BGP IPC HEMO DIALYSIS CPTS"
DO BLD^BQITUTL(TAX,.TREF)
+7 FOR TAX="BGP IPC OFFICE VISIT CPTS","BGP IPC OUTPT CONSULT CPTS","BGP IPC LT RES FACILITY CPTS","BGP IPC HOMEHEALTH VISIT CPTS"
DO BLD^BQITUTL(TAX,.TREF)
+8 FOR TAX="BGP IPC PREVCARE IOV 0-17 CPTS","BGP IPC PREVCARE IOV >=18 CPTS","BGP IPC PREVCARE IND COUN CPTS","BGP IPC PREVCARE GRP COUN CPTS"
DO BLD^BQITUTL(TAX,.TREF)
+9 FOR TAX="BGP IPC PREVCARE OTHER CPTS","BGP IPC DSCH SRV NURS FAC CPTS","BGP IPC NURS FAC VISIT CPTS","BGP IPC ANNUAL WELLNESS CPTS"
DO BLD^BQITUTL(TAX,.TREF)
+10 FOR TAX="BGP IPC PERI DIALYSIS CPTS","BGP IPC HEMO DIALYSIS CPTS","BGP IPC PREVCARE EOV 0-17 CPTS","BGP IPC PREVCARE EOV >=18 CPTS"
DO BLD^BQITUTL(TAX,.TREF)
+11 SET RVBDT=9999999-BDATE
SET RVEDT=9999999-EDATE
+12 FOR
SET RVEDT=$ORDER(^AUPNVSIT("AA",DFN,RVEDT))
IF RVEDT=""!((RVEDT\1)>RVBDT)
QUIT
Begin DoDot:1
+13 SET VISIT=""
FOR
SET VISIT=$ORDER(^AUPNVSIT("AA",DFN,RVEDT,VISIT))
IF VISIT=""
QUIT
Begin DoDot:2
+14 ;no dependent entries
+15 IF '$PIECE(^AUPNVSIT(VISIT,0),"^",9)
QUIT
+16 ;deleted
+17 IF $PIECE(^AUPNVSIT(VISIT,0),"^",11)
QUIT
+18 IF $$FTOF(VISIT,"PXRM BGP IPC FLU ENCOUNTER")
SET VAL((RVEDT\1),VISIT)=""
QUIT
+19 IF $$FTOF(VISIT,"PXRM BGP IPC PAT PROV INT")
SET VAL((RVEDT\1),VISIT)=""
QUIT
+20 IF $PIECE(^AUPNVSIT(VISIT,0),"^",17)=""
DO CPT
QUIT
+21 SET CP=$PIECE(^AUPNVSIT(VISIT,0),"^",17)
IF $DATA(@TREF@(CP))
SET VAL((RVEDT\1),VISIT)=""
End DoDot:2
End DoDot:1
+22 ;
+23 SET RVDATE=$ORDER(VAL(""))
IF RVDATE'=""
SET RVDATE=9999999-RVDATE
+24 QUIT $$FMTMDY^BQIUL1(RVDATE)_" ("_$$FMTMDY^BQIUL1(BDATE)_"-"_$$FMTMDY^BQIUL1(EDATE)_")"
+25 ;
FTOF(V,SNO) ;EP
+1 NEW A,B,C
+2 SET A=0
SET B=""
+3 FOR
SET A=$ORDER(^AUPNVSIT(V,28,"B",A))
IF A=""!(B]"")
QUIT
Begin DoDot:1
+4 IF $DATA(^XTMP("BGPSNOMEDSUBSET",$JOB,SNO,A))
SET B=A
End DoDot:1
+5 QUIT B
+6 ;
PSV(DFN) ;EP - Psych Office Visit
+1 ; for Depression Remission
+2 NEW BDATE,EDATE,TREF,TAX,RVBDT,RVEDT,VISIT,VAL,RVDATE,BQQN
+3 ; has the patient had an office visit in the past year
+4 SET BDATE=$$DATE^BQIUL1("T-12M")
SET EDATE=BDATE
+5 SET BDATE=$$FMADD^XLFDT(BDATE,-(13*30))
SET EDATE=$$FMADD^XLFDT(EDATE,-1)
+6 SET TREF=$NAME(^TMP("BQITAX",$JOB))
KILL @TREF
+7 FOR TAX="BGP IPC OFFICE VISIT CPTS","BGP IPC PSYCH VISIT CPTS"
DO BLD^BQITUTL(TAX,.TREF)
+8 SET RVBDT=9999999-BDATE
SET RVEDT=9999999-EDATE
+9 FOR
SET RVEDT=$ORDER(^AUPNVSIT("AA",DFN,RVEDT))
IF RVEDT=""!((RVEDT\1)>RVBDT)
QUIT
Begin DoDot:1
+10 SET VISIT=""
FOR
SET VISIT=$ORDER(^AUPNVSIT("AA",DFN,RVEDT,VISIT))
IF VISIT=""
QUIT
Begin DoDot:2
+11 ;no dependent entries
+12 IF '$PIECE(^AUPNVSIT(VISIT,0),"^",9)
QUIT
+13 ;deleted
+14 IF $PIECE(^AUPNVSIT(VISIT,0),"^",11)
QUIT
+15 SET Q=$$PHQ9^BGP8PC13(VISIT)
+16 IF Q=""
QUIT
+17 IF $PIECE(^AUPNVSIT(VISIT,0),"^",17)=""
DO CPT
QUIT
+18 SET CP=$PIECE(^AUPNVSIT(VISIT,0),"^",17)
IF $DATA(@TREF@(CP))
SET VAL((RVEDT\1),VISIT)=""
End DoDot:2
End DoDot:1
+19 ;
+20 SET RVDATE=$ORDER(VAL(""))
IF RVDATE'=""
SET RVDATE=9999999-RVDATE
+21 QUIT $$FMTMDY^BQIUL1(RVDATE)_" ("_$$FMTMDY^BQIUL1(BDATE)_"-"_$$FMTMDY^BQIUL1(EDATE)_")"
+22 ;
ADZ(DFN) ;EP - Adolescent Immunization requirement
+1 NEW BDATE,EDATE,A11,A13,A
+2 SET BDATE=$$DATE^BQIUL1("T-12M")
SET EDATE=DT
+3 SET A=$$YBD^BGP8PC7(DFN,13)
+4 IF A>EDATE!(A<BDATE)
QUIT "N/A"
+5 SET A11=$$YBD^BGP8PC7(DFN,11)
+6 SET A13=$$YBD^BGP8PC7(DFN,13)
+7 QUIT $$FMTMDY^BQIUL1(A11)_"-"_$$FMTMDY^BQIUL1(A13)
