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

BIPATE.m

Go to the documentation of this file. 
  1. BIPATE ;IHS/CMI/MWR - PATIENT CASE DATA EDIT; MAY 10, 2010
  1.  ;;8.5;IMMUNIZATION;;SEP 01,2011
  1.  ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
  1.  ;;  EDIT PATIENT CASE DATA.
  1.  ;
  1.  ;
  1.  ;----------
  1. MAIN ;EP
  1.  ;---> Not called from Menus.
  1.  D SETVARS^BIUTL5
  1.  F  D PATIENT Q:BIPOP
  1.  ;
  1. EXIT ;EP
  1.  D KILLALL^BIUTL8(1)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. PATIENT ;EP
  1.  D TITLE^BIUTL5("EDIT PATIENT CASE DATA")
  1.  ;
  1. PATIENT1 ;EP
  1.  ;---> To avoid @IOF and title.
  1.  ;---> Select Patient.
  1.  N Y S Y=""
  1.  W !!,"   Select the patient you wish to add or edit."
  1.  D PATLKUP^BIUTL8(.BIDFN,"ADD",DUZ(2),.BIPOP)
  1.  Q:BIPOP
  1.  I BIDFN<0 S BIPOP=1 Q
  1.  S BIDFN=+BIDFN
  1.  ;---> Quit if this patient is Locked (being edited by another user).
  1.  L +^BIP(BIDFN):1 I '$T D ERRCD^BIUTL2(212,.BIERR) Q
  1.  ;---> If called from here, do not do HDR & INIT in ^BIPATVW.
  1.  D SCREEN(BIDFN) S BIPOP=0
  1.  L -^BIP($G(BIDFN))
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. SCREEN(BIDFN) ;EP
  1.  ;---> Edit Patient Case Data with Screenman.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN  (req) Patient's IEN in VA PATIENT File #2.
  1.  ;
  1.  ;---> If <STKOV> errors appear here, increase STACK in SYSGEN,
  1.  ;---> System Configuration Parameters.
  1.  ;
  1.  ;---> Quit if BIDFN not provided.
  1.  I '$G(BIDFN) D ERRCD^BIUTL2(206,,1)
  1.  ;
  1.  ;---> Gather Case Data for this Patient to load for Screenman edit.
  1.  N Y S Y=""
  1.  D CASEDAT^BIRPC5(.Y,BIDFN) ;EP
  1.  ;
  1.  ;---> If an error is passed back, display it and quit.
  1.  N BI31,BIRETERR S BI31=$C(31)_$C(31)
  1.  S BIRETERR=$P(Y,BI31,2)
  1.  I BIRETERR]"" D EN^DDIOL("* "_BIRETERR,"","!!?5"),DIRZ^BIUTL3() Q
  1.  S Y=$P(Y,BI31)
  1.  ;
  1.  ;---> Build BI array for Case Data edit via Screenman.
  1.  N BI
  1.  S BI("A")=+BIDFN       ;Patient DFN.
  1.  S BI("B")=$P(Y,U)      ;Case Manager's name, text.
  1.  S BI("C")=$P(Y,U,2)    ;Parent or Guardian, text.
  1.  S BI("D")=$P(Y,U,3)    ;Mother's HBsAG Status (P,N,A,U).
  1.  S BI("E")=$P(Y,U,4)    ;Date Patient became Inactive (DD-Mmm-YYYY).
  1.  S BI("F")=$P(Y,U,5)    ;Reason for Inactive.
  1.  S BI("G")=$P(Y,U,6)    ;Other Info.
  1.  S BI("H")=$P(Y,U,7)    ;Forecast Influenza/Pneumococcal.
  1.  S BI("I")=$P(Y,U,8)    ;Location Moved or Tx Elsewhere.
  1.  S BI("K")=$P(Y,U,9)    ;State Registry Consent, 1=YES, 0/""=NO.
  1.  ;
  1.  N DR S DR="[BI FORM-CASE DATA EDIT]"
  1.  D DDS^BIFMAN(9002084,DR,BIDFN,"","",.BIPOP)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. AUTOADD(BIDFN,BISITE,BIERR,BINACT) ;PEP - Automatically add a Patient to the Imm DB.
  1.  ;---> Automatically add a Patient to the Imm Register.
  1.  ;---> If an Inactive Date is passed, Patient will be added as Inactive today.
  1.  ;---> If no Inactive Date is passed and the Patient is under 36 months of age
  1.  ;---> and has a Current Community in the GPRA Set of Communities (defined by
  1.  ;---> Imm Manager under Edit Site Parameters), or if the Patient has NO Current
  1.  ;---> Cummunity set yet, then the Patient will be added as Active.
  1.  ;---> Otherwise the Patient is added as Inactive.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN  (req)   Patient's IEN in VA PATIENT File #2.
  1.  ;     2 - BISITE (req)   DUZ(2) for default Case Manager.
  1.  ;     3 - BIERR  (ret)   Error text, if any.
  1.  ;     4 - BINACT (opt)   Fileman internal date Patient became Inactive.
  1.  ;
  1.  ;---> Check for valid Patient.
  1.  I '$G(BIDFN) D ERRCD^BIUTL2(201,.BIERR) Q
  1.  I '$D(^AUPNPAT(BIDFN,0)) D ERRCD^BIUTL2(203,.BIERR) Q
  1.  ;---> Check for valid Site.
  1.  S:'$G(BISITE) BISITE=$G(DUZ(2))
  1.  I '$G(BISITE) D ERRCD^BIUTL2(105,.BIERR) Q
  1.  ;
  1.  N BINACTR S BINACTR=""
  1.  D
  1.  .;---> Forced Inactive by passing Inactive Date.
  1.  .I $G(BINACT) S BINACTR="n" Q
  1.  .;---> Under 36 mths and in GPRA, this patient will be Active.
  1.  .;I $$AGE^BIUTL1(BIDFN,2)<36,$$ISGPRA^BIUTL11(BIDFN,BISITE) Q
  1.  .N BIAGE S BIAGE=$$AGE^BIUTL1(BIDFN,2)
  1.  .;---> Request by Amy Groom:
  1.  .;---> If under 36 mths and patient has NO Cur Community, add as Active.
  1.  .I BIAGE<36,'$$CURCOM^BIUTL11(BIDFN) Q
  1.  .I BIAGE<36,$$ISGPRA^BIUTL11(BIDFN,BISITE) Q
  1.  .;---> Older than 36 mths or not in GPRA, this patient will be Inactive
  1.  .;---> as of today with a Reason of "Never Activated."
  1.  .S BINACT=$G(DT),BINACTR="n"
  1.  ;
  1.  D ADDPAT(BIDFN,BISITE,.BIERR,$G(BINACT),BINACTR,1)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. ADDPAT(BIDFN,BISITE,BIERR,BINACT,BINACTR,BIAUTO) ;PEP  Add a Patient to Imm DB
  1.  ;---> Add new Patient to Immunization Database (BI PATIENT File).
  1.  ;---> Sets Case Manger to Site Parameter default.
  1.  ;---> Also records User and date first entered.
  1.  ;---> Called by AGZIMM at ANMC to add newborns from RPMS Registration.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN   (req)   Patient's IEN in VA PATIENT File #2.
  1.  ;     2 - BISITE  (req)   DUZ(2) for default Case Manager.
  1.  ;     3 - BIERR   (ret)   Error text, if any.
  1.  ;     4 - BINACT  (opt)   Fileman internal date Patient became Inactive.
  1.  ;     5 - BINACTR (opt)   Internal code for Inactive Reason:
  1.  ;                            m:Moved Elsewhere, t:Treatment Elsewhere, d:Deceased
  1.  ;                            p:Previously Inactivated, n:Never Activated
  1.  ;     6 - BIAUTO  (opt)   If BIAUTO=1, set Field# .22="Automatically" added.
  1.  ;
  1.  ;     Example: D AUTOADD^BIPATE(BIDFN,1665,.X,DT,"n")
  1.  ;
  1.  ;---> If BIDFN not provided, return error and quit.
  1.  I '$G(BIDFN) D ERRCD^BIUTL2(201,.BIERR) Q
  1.  ;
  1.  ;---> If Patient is already in the Imm Database, return error and quit.
  1.  I $D(^BIP(BIDFN,0)) D ERRCD^BIUTL2(218,.BIERR) Q
  1.  ;
  1.  ;---> If no Site IEN was passed, try to get it from local symbol table.
  1.  S:'$G(BISITE) BISITE=$G(DUZ(2))
  1.  ;---> If BISITE not provided, return error and quit.
  1.  I '$G(BISITE) D ERRCD^BIUTL2(105,.BIERR) Q
  1.  ;
  1.  ;---> If Default Case Manager is INACTIVE, return error and quit.
  1.  N BICMGR S BICMGR=$$CMGRDEF^BIUTL2(BISITE)
  1.  I BICMGR,$$CMGRACT^BIUTL2(BICMGR) D ERRCD^BIUTL2(214,.BIERR) Q
  1.  ;
  1.  ;---> Trim time from BINACT (seed if necessary).
  1.  S BINACT=$P($G(BINACT),".") S:BINACT<2000000 BINACT=""
  1.  ;
  1.  ;---> Check/set Inactive reason.
  1.  S:"mtdpn"'[$E($G(BINACTR)) BINACTR=""
  1.  S:'BINACT BINACTR=""
  1.  ;
  1.  N BIERR,BIFLD,BIIEN
  1.  S BIIEN(1)=BIDFN
  1.  S BIFLD(.01)=BIDFN
  1.  S BIFLD(.08)=BINACT
  1.  S BIFLD(.1)=BICMGR
  1.  S BIFLD(.16)=BINACTR
  1.  S BIFLD(.2)=$G(DUZ)
  1.  S BIFLD(.21)=$G(DT)
  1.  S BIFLD(.22)=$S($G(BIAUTO):1,1:"")
  1.  D UPDATE^BIFMAN(9002084,.BIIEN,.BIFLD,.BIERR)
  1.  I $G(BIERR)]"" W !!?3,BIERR D DIRZ^BIUTL3()
  1.  Q