BIRPC6 ;IHS/CMI/MWR - REMOTE PROCEDURE CALLS; MAY 10, 2010
;;8.5;IMMUNIZATION;;SEP 01,2011
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; CALL TO PRODUCE TEMP GLOBAL OF PATIENTS FOR TWO-YR-OLD GPRA REPORT.
;; PATCH 1: If Code Set versioning is present, use standard call. CPTIMM+14
;
;
;----------
ACTLIST(BIQDT,BITAR,BISITE,BIERR) ;PEP - Produce ^TMP of Patients for Imm Report.
;---> Produce ^TMP array of Patients for Quarterly Immunization Report.
;---> Parameters:
; 1 - BIQDT (req) Quarter Ending Date.
; 2 - BITAR (opt) Two-Yr-Old Report Age Range: either "19-35" or "24-35"
; 3 - BISITE (req) Site IEN.
; 4 - BIERR (ret) Error text (if null, then no error).
;
K ^TMP("BIDUL",$J),^TMP("BIREPT1",$J)
;
;---> Check for required Variables.
I '$G(BIQDT) D ERRCD^BIUTL2(623,.BIERR) Q
I '$D(BITAR) D ERRCD^BIUTL2(613,.BIERR) Q
S:'%G(BISITE) BISITE=$G(DUZ(2)) I '$G(BISITE) S BIERR=109 Q
;
S BIBEN("ALL")="",BICC("ALL")="",BICM("ALL")="",BIHCF("ALL")=""
S BIAGRPS="3,5,7,16,19,36"
S:'$G(BITAR) BITAR="19-35"
;
;---> Gather data.
;***** GO BACK TO GETDATA^BIREPT3 AND CHECK OUT BIVAL (STORE/DON'T STORE) DEAL!!!!
D GETDATA^BIREPT3(.BICC,.BIHCF,.BICM,.BIBEN,BIQDT,BITAR,BIAGRPS,BISITE,.BIERR)
;
;***** NEXT LINE: PASS AS LOCAL ARRAY OR SIMPLER ^TMP ARRAY?
;***** ASK LORI HOW SHE WANTS IT?
;***** Array is stored in ^TMP("BIDUL",$J,CURRENT-COMMUNITY-IEN,1,HRCN,DFN)
;
;---> Clean up would be:
;K ^TMP("BIDUL",$J),^TMP("BIREPT1",$J)
Q
;
;
;----------
CPTIMM ;EP
;---> Create a V Immunization entry (if none exists) for a CPT Coded
;---> Immunization. Called by the AIMM Mumps Cross Reference on the
;---> .01 Field of the V CPT File# 9000010.18.
;
;---> Edit and uncomment next line to test directly.
;;S APCDVSIT=37529775,APCDPAT=227582,APCDDATE=3051017,X=90663,BICCPT=1776
;
Q:'$G(X)
N BICPT,BIDATE,BIDFN,BIPTR,BIVAC,BIVSIT
;
;********** PATCH 1, v8.2.1, FEB 01,2008, IHS/CMI/MWR
;---> If Code Set versioning is present, use standard call.
D
.I $L($T(^ICPTCOD)) S BICPT=$P($$CPT^ICPTCOD(X),"^",2) Q
.S BICPT=$P($G(^ICPT(X,0)),"^")
;**********
;
S BIVSIT=$G(APCDVSIT)
S BIDFN=$G(APCDPAT)
S BIDATE=$G(APCDDATE)
Q:'BICPT Q:'BIVSIT Q:'BIDFN Q:'BIDATE
;
;---> Quit if Site Parameter has Import CPT Visits feature disabled.
Q:'$$IMPCPT^BIUTL2($G(DUZ(2)))
;
;---> Set this piece = IEN in V CPT if available.
S BICCPT=$S($G(DA):DA,1:1)
;
;---> Quit if this CPT Code is not in the Immunization File (Vaccine Table).
S BIVAC=$O(^AUTTIMM("ACPT",BICPT,0))
Q:'BIVAC Q:'$D(^AUTTIMM(BIVAC,0))
;
;---> Quit if an Immunization for this Patient and this Vaccine
;---> on this Date already exists.
;
;********** PATCH 1, APR 4,2006, IHS/CMI/MWR
;---> Fix xref lookup when checking to avoid CPT-Coded duplicate
;---> immunizations by striping time from BIDATE.
Q:$D(^AUPNVIMM("AA",BIDFN,BIVAC,(9999999-$P(BIDATE,"."))))
;**********
;
N BIDATA
S BIDATA="I|"_BIDFN_"|"_BIVAC_"|||"_BIDATE_"||||||||||||||||||"_BICCPT
D
.D EN^XBNEW("VFILE1^BIVISIT","BIVSIT;BIDATA")
Q
BIRPC6 ;IHS/CMI/MWR - REMOTE PROCEDURE CALLS; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;;SEP 01,2011
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; CALL TO PRODUCE TEMP GLOBAL OF PATIENTS FOR TWO-YR-OLD GPRA REPORT.
+4 ;; PATCH 1: If Code Set versioning is present, use standard call. CPTIMM+14
+5 ;
+6 ;
+7 ;----------
ACTLIST(BIQDT,BITAR,BISITE,BIERR) ;PEP - Produce ^TMP of Patients for Imm Report.
+1 ;---> Produce ^TMP array of Patients for Quarterly Immunization Report.
+2 ;---> Parameters:
+3 ; 1 - BIQDT (req) Quarter Ending Date.
+4 ; 2 - BITAR (opt) Two-Yr-Old Report Age Range: either "19-35" or "24-35"
+5 ; 3 - BISITE (req) Site IEN.
+6 ; 4 - BIERR (ret) Error text (if null, then no error).
+7 ;
+8 KILL ^TMP("BIDUL",$JOB),^TMP("BIREPT1",$JOB)
+9 ;
+10 ;---> Check for required Variables.
+11 IF '$GET(BIQDT)
DO ERRCD^BIUTL2(623,.BIERR)
QUIT
+12 IF '$DATA(BITAR)
DO ERRCD^BIUTL2(613,.BIERR)
QUIT
+13 IF '%G(BISITE)
SET BISITE=$GET(DUZ(2))
IF '$GET(BISITE)
SET BIERR=109
QUIT
+14 ;
+15 SET BIBEN("ALL")=""
SET BICC("ALL")=""
SET BICM("ALL")=""
SET BIHCF("ALL")=""
+16 SET BIAGRPS="3,5,7,16,19,36"
+17 IF '$GET(BITAR)
SET BITAR="19-35"
+18 ;
+19 ;---> Gather data.
+20 ;***** GO BACK TO GETDATA^BIREPT3 AND CHECK OUT BIVAL (STORE/DON'T STORE) DEAL!!!!
+21 DO GETDATA^BIREPT3(.BICC,.BIHCF,.BICM,.BIBEN,BIQDT,BITAR,BIAGRPS,BISITE,.BIERR)
+22 ;
+23 ;***** NEXT LINE: PASS AS LOCAL ARRAY OR SIMPLER ^TMP ARRAY?
+24 ;***** ASK LORI HOW SHE WANTS IT?
+25 ;***** Array is stored in ^TMP("BIDUL",$J,CURRENT-COMMUNITY-IEN,1,HRCN,DFN)
+26 ;
+27 ;---> Clean up would be:
+28 ;K ^TMP("BIDUL",$J),^TMP("BIREPT1",$J)
+29 QUIT
+30 ;
+31 ;
+32 ;----------
CPTIMM ;EP
+1 ;---> Create a V Immunization entry (if none exists) for a CPT Coded
+2 ;---> Immunization. Called by the AIMM Mumps Cross Reference on the
+3 ;---> .01 Field of the V CPT File# 9000010.18.
+4 ;
+5 ;---> Edit and uncomment next line to test directly.
+6 ;;S APCDVSIT=37529775,APCDPAT=227582,APCDDATE=3051017,X=90663,BICCPT=1776
+7 ;
+8 IF '$GET(X)
QUIT
+9 NEW BICPT,BIDATE,BIDFN,BIPTR,BIVAC,BIVSIT
+10 ;
+11 ;********** PATCH 1, v8.2.1, FEB 01,2008, IHS/CMI/MWR
+12 ;---> If Code Set versioning is present, use standard call.
+13 Begin DoDot:1
+14 IF $LENGTH($TEXT(^ICPTCOD))
SET BICPT=$PIECE($$CPT^ICPTCOD(X),"^",2)
QUIT
+15 SET BICPT=$PIECE($GET(^ICPT(X,0)),"^")
End DoDot:1
+16 ;**********
+17 ;
+18 SET BIVSIT=$GET(APCDVSIT)
+19 SET BIDFN=$GET(APCDPAT)
+20 SET BIDATE=$GET(APCDDATE)
+21 IF 'BICPT
QUIT
IF 'BIVSIT
QUIT
IF 'BIDFN
QUIT
IF 'BIDATE
QUIT
+22 ;
+23 ;---> Quit if Site Parameter has Import CPT Visits feature disabled.
+24 IF '$$IMPCPT^BIUTL2($GET(DUZ(2)))
QUIT
+25 ;
+26 ;---> Set this piece = IEN in V CPT if available.
+27 SET BICCPT=$SELECT($GET(DA):DA,1:1)
+28 ;
+29 ;---> Quit if this CPT Code is not in the Immunization File (Vaccine Table).
+30 SET BIVAC=$ORDER(^AUTTIMM("ACPT",BICPT,0))
+31 IF 'BIVAC
QUIT
IF '$DATA(^AUTTIMM(BIVAC,0))
QUIT
+32 ;
+33 ;---> Quit if an Immunization for this Patient and this Vaccine
+34 ;---> on this Date already exists.
+35 ;
+36 ;********** PATCH 1, APR 4,2006, IHS/CMI/MWR
+37 ;---> Fix xref lookup when checking to avoid CPT-Coded duplicate
+38 ;---> immunizations by striping time from BIDATE.
+39 IF $DATA(^AUPNVIMM("AA",BIDFN,BIVAC,(9999999-$PIECE(BIDATE,"."))))
QUIT
+40 ;**********
+41 ;
+42 NEW BIDATA
+43 SET BIDATA="I|"_BIDFN_"|"_BIVAC_"|||"_BIDATE_"||||||||||||||||||"_BICCPT
+44 Begin DoDot:1
+45 DO EN^XBNEW("VFILE1^BIVISIT","BIVSIT;BIDATA")
End DoDot:1
+46 QUIT
