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

BIRPC5.m

Go to the documentation of this file. 
  1. BIRPC5 ;IHS/CMI/MWR - REMOTE PROCEDURE CALLS; MAY 10, 2010
  1.  ;;8.5;IMMUNIZATION;**2**;MAY 15,2012
  1.  ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
  1.  ;;  RETURN IMMUNIZATION CONTRAINDICATIONS, CASE DATA, AND LAST LETTER.
  1.  ;   PATCH 2: New Public Entry Point to automatically add Lot Number.  ADDLOT+0
  1.  ;
  1.  ;
  1.  ;----------
  1. CONTRAS(BICONTR,BIDFN) ;PEP - Return Patient's Contraindications and their Reasons.
  1.  ;---> Return Patient's Contraindications and their Reasons.
  1.  ;---> Contraindications returned in one string, delimited by "^".
  1.  ;---> Each Contra has 3 "|" pieces: Vaccine Name|Reason|Date Entered.
  1.  ;---> Parameters:
  1.  ;     1 - BICONTR (ret) String of patient's Contraindications_||_Error.
  1.  ;     2 - BIDFN   (req) DFN of patient.
  1.  ;
  1.  ;---> Delimiter to pass error with result to GUI.
  1.  N BI31,BIERR,U,V S BI31=$C(31)_$C(31),U="^",V="|"
  1.  S BICONTR="",BIERR=""
  1.  ;
  1.  ;---> If DFN not provided, set Error Code and quit.
  1.  I '$G(BIDFN) D  Q
  1.  .D ERRCD^BIUTL2(308,.BIERR) S BICONTR=BI31_BIERR
  1.  ;
  1.  N N,X S N=0,X=""
  1.  F  S N=$O(^BIPC("B",BIDFN,N)) Q:'N  D
  1.  .;
  1.  .;---> Kill any false xref.
  1.  .I '$D(^BIPC(N,0)) K ^BIPC("B",BIDFN,N) Q
  1.  .;
  1.  .N Y S Y=^BIPC(N,0)
  1.  .;---> Get Contraindication:
  1.  .;---> IEN of Contraindication, Vaccine Short Name, Reason, Date.
  1.  .S X=X_N_V_$$VNAME^BIUTL2($P(Y,U,2))_V_$$CONTXT^BIUTL6($P(Y,U,3))
  1.  .S X=X_V_$$TXDT1^BIUTL5($P(Y,U,4))_U
  1.  ;
  1.  S BICONTR=X_BI31
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. CASEDAT(BICASED,BIDFN) ;PEP - Return Patient's Case Data, pieces delimited by "^".
  1.  ;---> Parameters:
  1.  ;     1 - BICASED (ret) String of Patient's Case Data_||_Error.
  1.  ;     2 - BIDFN   (req) DFN of patient.
  1.  ;
  1.  ;---> Delimiter to pass error with result to GUI.
  1.  N BI31,BIERR,U S BI31=$C(31)_$C(31),U="^"
  1.  S BICASED="",BIERR=""
  1.  ;
  1.  ;---> If DFN not provided, set Error Code and quit.
  1.  I '$G(BIDFN) D  Q
  1.  .D ERRCD^BIUTL2(206,.BIERR) S BICASED=BI31_BIERR
  1.  ;
  1.  ;---> If Patient not in Immunization database, set Error Code and quit.
  1.  I '$D(^BIP(BIDFN,0)) D  Q
  1.  .D ERRCD^BIUTL2(204,.BIERR) S BICASED=BI31_BIERR
  1.  ;
  1.  ;---> Case Data Elements returned as follows:
  1.  ;
  1.  ;--->  PC  DATA
  1.  ;--->  --  ----
  1.  ;--->   1 = Text of Case Manager's name.
  1.  ;--->   2 = Text of Parent or Guardian in Immunization database.
  1.  ;--->   3 = Mother's HBsAG Status Code (P,N,A,U).
  1.  ;--->   4 = Date Patient became Inactive (DD-Mmm-YYYY).
  1.  ;--->   5 = Reason for Inactive.
  1.  ;--->   6 = Other Info.
  1.  ;--->   7 = Forecast Influenza/Pneumococcal.
  1.  ;--->   8 = Location Moved or Tx Elsewhere.
  1.  ;--->   9 = State Registry Consent.
  1.  ;
  1.  N X
  1.  S X=$$CMGR^BIUTL1(BIDFN,1) S:X="Unknown" X=""
  1.  S X=X_U_$$PARENT^BIUTL1(BIDFN)
  1.  S X=X_U_$$MOTHER^BIUTL11(BIDFN)
  1.  S Z=$$TXDT1^BIUTL5($$INACT^BIUTL1(BIDFN)) S:Z="NO DATE" Z=""
  1.  S X=X_U_Z
  1.  S X=X_U_$$INACTRE^BIUTL1(BIDFN)_U_$$OTHERIN^BIUTL11(BIDFN)
  1.  S X=X_U_$$INFL^BIUTL11(BIDFN)
  1.  S X=X_U_$$MOVEDLOC^BIUTL1(BIDFN)
  1.  S X=X_U_$$CONSENT^BIUTL1(BIDFN)
  1.  ;
  1.  S BICASED=X_BI31
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. LASTLET(BILASTL,BIDFN) ;EP
  1.  ;---> Return date of last letter sent to this patient.
  1.  ;---> Parameters:
  1.  ;     1 - BILASTL (ret) Date of last letter_||_Error.
  1.  ;     2 - BIDFN   (req) DFN of patient.
  1.  ;
  1.  ;---> Delimiter to pass error with result to GUI.
  1.  N BI31,BIERR,U S BI31=$C(31)_$C(31),U="^"
  1.  S BILASTL="",BIERR=""
  1.  ;
  1.  ;---> If DFN not provided, set Error Code and quit.
  1.  I '$G(BIDFN) D  Q
  1.  .D ERRCD^BIUTL2(201,.BIERR) S BILASTL=BI31_BIERR
  1.  ;
  1.  ;---> Last Letter Elements returned as follows:
  1.  ;
  1.  ;--->  PC  DATA
  1.  ;--->  --  ----
  1.  ;--->   1 = Date of last letter (DD-Mmm-YYYY) or "None".
  1.  ;
  1.  S BILASTL=$$LASTLET^BIUTL1(BIDFN,1)_BI31
  1.  Q
  1.  ;
  1.  ;********** PATCH 2, v8.5, MAY 15,2012, IHS/CMI/MWR
  1.  ;---> New Public Entry Point to automatically add Lot Number.
  1.  ;
  1.  ;
  1.  ;----------
  1. ADDLOT(BIERR,BIDATA,BIIEN) ;PEP - Add a new Lot Number for imported data.
  1.  ;---> Add new (imported) Lot Number to the IMMUNIZATION LOT File #9999999.41.
  1.  ;---> Called by RPC: BI LOT NUMBER ADD.
  1.  ;---> Parameters:
  1.  ;     1 - BIERR   (ret) Text of Error Code if any, otherwise null.
  1.  ;     2 - BIDATA  (req) String of data for the Lot Number to be added.
  1.  ;     3 - BIIEN   (ret) IEN of newly added Lot Number in ^AUTTIML(.
  1.  ;                       NOTE: If Lot Number already exists, BIERR will return
  1.  ;                             error #444, but BIIEN will be returned with IEN
  1.  ;                             pre-existing Lot Number.
  1.  ;
  1.  ;---> Pieces of BIDATA delimited by "|":
  1.  ;     ----------------------------------
  1.  ;     1 - (req) Text of the Lot Number.
  1.  ;     2 - (req) CVX Code of the Vaccine associated with this Lot Number.
  1.  ;     3 - (req) MVX Code of the Manufacturer associated with this Lot Number.
  1.  ;
  1.  ;---> Define delimiter to pass error and error variable.
  1.  N BI31
  1.  S BI31=$C(31)_$C(31),BIERR=""
  1.  ;
  1.  ;---> If DATA not supplied, set Error Code and quit.
  1.  I $G(BIDATA)']"" D  Q
  1.  .D ERRCD^BIUTL2(442,.BIERR) S BIERR=BI31_BIERR
  1.  ;
  1.  ;---> Set data values in BI local array.
  1.  N BI
  1.  S BI("AS")=$P(BIDATA,"|",1)   ;Full Lot Number Text.
  1.  S BI("B")=$P(BIDATA,"|",2)    ;CVX Code of Vaccine.
  1.  S BI("M")=$P(BIDATA,"|",3)    ;MVX Code of Manufacturer.
  1.  ;
  1.  ;---> If Lot Number="", quit with error.
  1.  I 'BI("AS")']"" D  Q
  1.  .D ERRCD^BIUTL2(442,.BIERR) S BIERR=BI31_BIERR
  1.  ;
  1.  ;---> If Lot Number is too long, quit with error.
  1.  I $L(BI("AS"))>19 D  Q
  1.  .D ERRCD^BIUTL2(443,.BIERR) S BIERR=BI31_BIERR
  1.  ;
  1.  ;---> If Lot Number already exists, set BIIEN=IEN, BUT quit with error.
  1.  I $D(^AUTTIML("B",BI("AS"))) D  Q
  1.  .N Y S Y=$O(^AUTTIML("B",BI("AS"),0))
  1.  .I $P($G(^AUTTIML(Y,0)),U)=BI("AS") S BIIEN=Y
  1.  .D ERRCD^BIUTL2(444,.BIERR) S BIERR=BI31_BIERR
  1.  ;
  1.  ;
  1.  ;---> S BI("B")=IEN of Vaccine.
  1.  S BI("B")=$O(^AUTTIMM("C",+$G(BI("B")),0))
  1.  ;---> If CVX Code is invalid, quit with error.
  1.  I 'BI("B") D  Q
  1.  .D ERRCD^BIUTL2(445,.BIERR) S BIERR=BI31_BIERR
  1.  ;
  1.  ;
  1.  ;---> S BI("M")=IEN of Manufacturer.
  1.  ;---> If MVX Code is invalid, quit with error.
  1.  I BI("M")="" D  Q
  1.  .D ERRCD^BIUTL2(446,.BIERR) S BIERR=BI31_BIERR
  1.  S BI("M")=$O(^AUTTIMAN("C",BI("M"),0))
  1.  I BI("M")="" D  Q
  1.  .D ERRCD^BIUTL2(446,.BIERR) S BIERR=BI31_BIERR
  1.  ;
  1.  ;
  1.  ;---> Build local array for this Lot Number.
  1.  S BIFLD(.01)=$G(BI("AS")),BIFLD(.02)=$G(BI("M"))
  1.  ;---> Imported Lot Number will have a Status of Inactive.
  1.  S BIFLD(.03)=1,BIFLD(.04)=$G(BI("B"))
  1.  ;
  1.  ;---> Add the Lot Number.  BIIEN1(1) will equal IEN of newly added Lot Number.
  1.  N BIIEN1
  1.  D UPDATE^BIFMAN(9999999.41,.BIIEN1,.BIFLD,.BIERR)
  1.  ;
  1.  ;---> If there was an error, return it.
  1.  S BIERR=BI31_BIERR
  1.  ;
  1.  ;---> Return BIIEN.
  1.  S BIIEN=$G(BIIEN1(1))
  1.  ;
  1.  ;---> Check IEN.
  1.  I $P($G(^AUTTIML(+BIIEN,0)),U)'=BI("AS") D  Q
  1.  .D ERRCD^BIUTL2(447,.BIERR) S BIERR=BI31_BIERR
  1.  ;
  1.  Q