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

BIRPC6.m

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