Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BQIIPUT1

BQIIPUT1.m

Go to the documentation of this file. 
  1. BQIIPUT1 ;GDIT/HCSD/ALA-IPC utilities ; 05 Apr 2018  7:44 AM
  1.  ;;2.7;ICARE MANAGEMENT SYSTEM;**1**;Dec 19, 2017;Build 12
  1.  ;
  1. OFV(DFN) ;EP - Office Visit in past year
  1.  NEW BDATE,EDATE,TREF,TAX,RVBDT,RVEDT,VISIT,VAL,RVDATE,BQQN,SNO
  1.  ; has the patient had an office visit in the past year
  1.  S BDATE=$$DATE^BQIUL1("T-12M"),EDATE=DT
  1.  S TREF=$NA(^TMP("BQITAX",$J)) K @TREF
  1.  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
  1.  . D BLD^BQITUTL(TAX,.TREF)
  1.  S RVBDT=9999999-BDATE,RVEDT=9999999-EDATE
  1.  F  S RVEDT=$O(^AUPNVSIT("AA",DFN,RVEDT)) Q:RVEDT=""!((RVEDT\1)>RVBDT)  D
  1.  . S VISIT="" F  S VISIT=$O(^AUPNVSIT("AA",DFN,RVEDT,VISIT)) Q:VISIT=""  D
  1.  .. ;no dependent entries
  1.  .. I '$P(^AUPNVSIT(VISIT,0),"^",9) Q
  1.  .. ;deleted
  1.  .. I $P(^AUPNVSIT(VISIT,0),"^",11) Q
  1.  .. I $$FTOF(VISIT,"PXRM BGP IPC FACE2FACE") S VAL((RVEDT\1),VISIT)="" Q
  1.  .. I $P(^AUPNVSIT(VISIT,0),"^",17)="" D CPT Q
  1.  .. S CP=$P(^AUPNVSIT(VISIT,0),"^",17) I $D(@TREF@(CP)) S VAL((RVEDT\1),VISIT)=""
  1.  ;
  1.  S RVDATE=$O(VAL("")) I RVDATE'="" S RVDATE=9999999-RVDATE
  1.  Q $$FMTMDY^BQIUL1(RVDATE)
  1.  ;
  1. CPT ;EP
  1.  NEW CP,CDT,IEN,VISIT
  1.  S CP="" F  S CP=$O(@TREF@(CP)) Q:CP=""  D
  1.  . S CDT="" F  S CDT=$O(^AUPNVCPT("AA",DFN,CP,CDT)) Q:CDT=""  D
  1.  .. I CDT=(RVEDT\1) D
  1.  ... S IEN="" F  S IEN=$O(^AUPNVCPT("AA",DFN,CP,CDT,IEN)) Q:IEN=""  S VISIT=$P(^AUPNVCPT(IEN,0),"^",3),VAL(CDT,VISIT)=""
  1.  Q
  1.  ;
  1. FLV(DFN) ;EP - Flu Visit
  1.  NEW BDATE,EDATE,TREF,TAX,RVBDT,RVEDT,VISIT,VAL,RVDATE,BQQN
  1.  ; has the patient had an office visit in the past year
  1.  S BDATE=$$DATE^BQIUL1("T-12M"),EDATE=BDATE
  1.  S BDATE=$$FMADD^XLFDT(BDATE,-92),EDATE=$$FMADD^XLFDT(EDATE,89)
  1.  S TREF=$NA(^TMP("BQITAX",$J)) K @TREF
  1.  F TAX="BGP IPC FLU ENCOUNTER CPTS","BGP IPC PERI DIALYSIS CPTS","BGP IPC HEMO DIALYSIS CPTS" D BLD^BQITUTL(TAX,.TREF)
  1.  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)
  1.  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)
  1.  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)
  1.  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)
  1.  S RVBDT=9999999-BDATE,RVEDT=9999999-EDATE
  1.  F  S RVEDT=$O(^AUPNVSIT("AA",DFN,RVEDT)) Q:RVEDT=""!((RVEDT\1)>RVBDT)  D
  1.  . S VISIT="" F  S VISIT=$O(^AUPNVSIT("AA",DFN,RVEDT,VISIT)) Q:VISIT=""  D
  1.  .. ;no dependent entries
  1.  .. I '$P(^AUPNVSIT(VISIT,0),"^",9) Q
  1.  .. ;deleted
  1.  .. I $P(^AUPNVSIT(VISIT,0),"^",11) Q
  1.  .. I $$FTOF(VISIT,"PXRM BGP IPC FLU ENCOUNTER") S VAL((RVEDT\1),VISIT)="" Q
  1.  .. I $$FTOF(VISIT,"PXRM BGP IPC PAT PROV INT") S VAL((RVEDT\1),VISIT)="" Q
  1.  .. I $P(^AUPNVSIT(VISIT,0),"^",17)="" D CPT Q
  1.  .. S CP=$P(^AUPNVSIT(VISIT,0),"^",17) I $D(@TREF@(CP)) S VAL((RVEDT\1),VISIT)=""
  1.  ;
  1.  S RVDATE=$O(VAL("")) I RVDATE'="" S RVDATE=9999999-RVDATE
  1.  Q $$FMTMDY^BQIUL1(RVDATE)_" ("_$$FMTMDY^BQIUL1(BDATE)_"-"_$$FMTMDY^BQIUL1(EDATE)_")"
  1.  ;
  1. FTOF(V,SNO) ;EP
  1.  NEW A,B,C
  1.  S A=0,B=""
  1.  F  S A=$O(^AUPNVSIT(V,28,"B",A)) Q:A=""!(B]"")  D
  1.  .I $D(^XTMP("BGPSNOMEDSUBSET",$J,SNO,A)) S B=A
  1.  Q B
  1.  ;
  1. PSV(DFN) ;EP - Psych Office Visit
  1.  ; for Depression Remission
  1.  NEW BDATE,EDATE,TREF,TAX,RVBDT,RVEDT,VISIT,VAL,RVDATE,BQQN
  1.  ; has the patient had an office visit in the past year
  1.  S BDATE=$$DATE^BQIUL1("T-12M"),EDATE=BDATE
  1.  S BDATE=$$FMADD^XLFDT(BDATE,-(13*30)),EDATE=$$FMADD^XLFDT(EDATE,-1)
  1.  S TREF=$NA(^TMP("BQITAX",$J)) K @TREF
  1.  F TAX="BGP IPC OFFICE VISIT CPTS","BGP IPC PSYCH VISIT CPTS" D BLD^BQITUTL(TAX,.TREF)
  1.  S RVBDT=9999999-BDATE,RVEDT=9999999-EDATE
  1.  F  S RVEDT=$O(^AUPNVSIT("AA",DFN,RVEDT)) Q:RVEDT=""!((RVEDT\1)>RVBDT)  D
  1.  . S VISIT="" F  S VISIT=$O(^AUPNVSIT("AA",DFN,RVEDT,VISIT)) Q:VISIT=""  D
  1.  .. ;no dependent entries
  1.  .. I '$P(^AUPNVSIT(VISIT,0),"^",9) Q
  1.  .. ;deleted
  1.  .. I $P(^AUPNVSIT(VISIT,0),"^",11) Q
  1.  .. S Q=$$PHQ9^BGP8PC13(VISIT)
  1.  .. I Q="" Q
  1.  .. I $P(^AUPNVSIT(VISIT,0),"^",17)="" D CPT Q
  1.  .. S CP=$P(^AUPNVSIT(VISIT,0),"^",17) I $D(@TREF@(CP)) S VAL((RVEDT\1),VISIT)=""
  1.  ;
  1.  S RVDATE=$O(VAL("")) I RVDATE'="" S RVDATE=9999999-RVDATE
  1.  Q $$FMTMDY^BQIUL1(RVDATE)_" ("_$$FMTMDY^BQIUL1(BDATE)_"-"_$$FMTMDY^BQIUL1(EDATE)_")"
  1.  ;
  1. ADZ(DFN) ;EP - Adolescent Immunization requirement
  1.  NEW BDATE,EDATE,A11,A13,A
  1.  S BDATE=$$DATE^BQIUL1("T-12M"),EDATE=DT
  1.  S A=$$YBD^BGP8PC7(DFN,13)
  1.  I A>EDATE!(A<BDATE) Q "N/A"
  1.  S A11=$$YBD^BGP8PC7(DFN,11)
  1.  S A13=$$YBD^BGP8PC7(DFN,13)
  1.  Q $$FMTMDY^BQIUL1(A11)_"-"_$$FMTMDY^BQIUL1(A13)