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

BIPATUP.m

Go to the documentation of this file. 
  1. BIPATUP ;IHS/CMI/MWR - UPDATE PATIENT FORECAST; MAY 10, 2010
  1.  ;;8.5;IMMUNIZATION;**14**;AUG 01,2017
  1.  ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
  1.  ;;  UPDATE PATIENT FORECAST DATA, IMM PROFILE IN ^BIP(DFN,
  1.  ;;  AND IMM FORECAST IN ^BIPDUE(.
  1.  ;;  PATCH 8: Changes to accommodate new TCH Forecaster  UPDATE+81,+99, LDPROF+18, BIDE+6
  1.  ;;  PATCH 9: Insert patient name and DOB at top of Report Text (for EHR).  LDPROF+28
  1.  ;;           Add DUZ2 so that BIXTCH can retrieve IP address for TCH.
  1.  ;;  PATCH 14: Add IHS Addendum to TCH Report.  UPDATE+118
  1.  ;
  1.  ;
  1.  ;----------
  1. UPDATE(BIDFN,BIFDT,BIERR,BINOP,BIDUZ2,BIPDSS) ;EP
  1.  ;---> Update Patient Imms Due (in ^BIPDUE) using Immserve Utility.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN  (req) Patient IEN.
  1.  ;     2 - BIFDT  (opt) Forecast Date (date used for forecast).
  1.  ;     3 - BIERR  (ret) String returning text of error code.
  1.  ;     4 - BINOP  (opt) If BINOP=1 do not retrieve Imm Profile.
  1.  ;     5 - BIDUZ2 (opt) User's DUZ(2) to indicate Immserve Forecasting
  1.  ;                      Rules in Patient History data string.
  1.  ;     6 - BIPDSS (ret) Returned string of Visit IEN's that are
  1.  ;                      Problem Doses, according to TCH.
  1.  ;
  1.  S BIERR=""
  1.  ;
  1.  ;---> If Vaccine global (^AUTTIMM) is not standard, set Error Text
  1.  ;---> in patient's Profile global, return Error Text and quit.
  1.  I $D(^BISITE(-1)) D  Q
  1.  .K ^BIP(BIDFN,1)
  1.  .D ERRCD^BIUTL2(503,.BIERR)
  1.  .S ^BIP(BIDFN,1,1,0)=BIERR
  1.  .S ^BIP(BIDFN,1,0)=U_U_1_U_1_U_DT
  1.  ;
  1.  I '$G(BIDFN) D ERRCD^BIUTL2(201,.BIERR) Q
  1.  ;
  1.  ;---> Return 1 if Forecasting is enabled.
  1.  I '$$FORECAS^BIUTL2(DUZ(2)) D ERRCD^BIUTL2(314,.BIERR) Q
  1.  ;
  1.  ;---> If no Forecast Date passed, set it equal to today.
  1.  S:'$G(BIFDT) BIFDT=DT
  1.  ;
  1.  ;---> If no BIDUZ2, try DUZ(2); otherwise, defaults will be used.
  1.  S:'$G(BIDUZ2) BIDUZ2=$G(DUZ(2))
  1.  ;
  1.  ;---> If BINOP not specified, retrieve and store Imm Profile.
  1.  S:'$G(BINOP) BINOP=0
  1.  ;
  1.  ;---> Quit if this patient is Locked (being edited by another user).
  1.  L +^BIP(BIDFN):0 I '$T D ERRCD^BIUTL2(212,.BIERR) Q
  1.  ;
  1.  ;---> Set required variables, kill ^BITMP($J).
  1.  D SETVARS^BIUTL5 K ^BITMP($J)
  1.  ;
  1.  ;---> Set the patient temp global.
  1.  S ^BITMP($J,1,BIDFN)=""
  1.  ;
  1.  ;---> Gather Immunization History for this patient (into ^BITMP) .
  1.  ;---> Parameters:
  1.  ;     1 - BIFMT  (req) Format: 1=ASCII, 2=HL7, 3=IMM/SERVE
  1.  ;     2 - BIDE   (req) Data Elements array (null if HL7)
  1.  ;     3 - BIMM   (req) Array of Imms to be passed to forecasting.
  1.  ;     4 - BIFDT  (opt) Forecast Date (date used to calc Imms due).
  1.  ;     5 - BISKIN (opt) ""=Do not retrieve Skin Tests.
  1.  ;     6 - BIDUZ2 (opt) User's DUZ(2) to indicate Immserve Forecasting
  1.  ;                      Rules in Patient History data string.
  1.  ;     7 - BINF   (opt) Array of Vaccines that should not be forecast.
  1.  ;
  1.  ;
  1.  ;---> Build local array of Vaccines (by HL7 Code) that should not
  1.  ;---> be forecast, according to this machine's Immunization File.
  1.  N BINF D NOFORC(.BINF)
  1.  ;
  1.  N BIDE S BIDE="" D BIDE(.BIDE)
  1.  N BIMM S BIMM("ALL")=""
  1.  ;
  1.  ;---> Gather Patient Imm History in ^BITMP.
  1.  D HISTORY^BIEXPRT3(3,.BIDE,.BIMM,BIFDT,,BIDUZ2,.BINF)
  1.  ;
  1.  ;---> Retrieve data for this patient from ^BITMP, return in BIHX.
  1.  ;---> Parameters:
  1.  ;     1 - BIEXP    (req) Export: 0=screen, 1=host file, 2=string
  1.  ;     2 - BIFMT    (req) Format: 1=ASCII, 2=HL7, 3=IMM/SERVE
  1.  ;     3 - BIFLNM   (opt) File name
  1.  ;     4 - BIPATH   (opt) BI Path name for host files
  1.  ;     5 - BIHX     (ret) Immunization History in "^"-delimited string
  1.  ;
  1.  N BIHX S BIHX=""
  1.  D WRITE^BIEXPRT4(2,3,,,.BIHX)
  1.  ;
  1.  ;---> Check for precise Date of Birth.
  1.  N X S X=$P(BIHX,U,8)
  1.  ;
  1.  ;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR
  1.  ;---> Change error check to accommodate new TCH date format.
  1.  ;I ('$E(X,1,2))!('$E(X,3,4))!('$E(X,5,8)) D ERRCD^BIUTL2(215,.BIERR) Q
  1.  I ('$E(X,1,4))!('$E(X,5,6))!('$E(X,7,8)) D ERRCD^BIUTL2(215,.BIERR) Q
  1.  ;**********
  1.  ;
  1.  ;
  1.  ;---> Use Immunization History (in BIHX) to obtain Immserve Forecast.
  1.  ;---> Parameters:
  1.  ;     1 - BIHX   (req) String contain Patient's Immunization History.
  1.  ;     2 - BIPROF (ret) String returning text version of profile.
  1.  ;     3 - BIFORC (ret) String returning data version of forecast.
  1.  ;     4 - BIERR  (ret) String returning text of error code.
  1.  ;
  1.  N BIPROF,BIFORC S (BIPROF,BIFORC)=""
  1.  ;
  1.  ;---> Call ImmServe and get Forecast and Profile.
  1.  ;
  1.  ;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR
  1.  ;---> Call new TCH Forecaster.
  1.  ;D RUN^BIXCALL(BIHX,.BIPROF,.BIFORC,.BIERR)
  1.  ;
  1.  ;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
  1.  ;---> Add DUZ2 so that BIXTCH can retrieve IP address for TCH.
  1.  ;D RUN^BIXTCH(BIHX,.BIPROF,.BIFORC,.BIERR)
  1.  D RUN^BIXTCH(BIHX,BIDUZ2,.BIPROF,.BIFORC,.BIERR)
  1.  ;**********
  1.  ;
  1.  ;---> For diagnostic purposes.
  1.  ;D DISPLAY
  1.  ;
  1.  I BIERR]"" D UNLOCK(BIDFN) Q
  1.  ;
  1.  ;---> Load Forecast into BI PATIENT IMMUNIZATIONS DUE File (^BIPDUE).
  1.  ;---> Pass BIHX (history) and BIFDT to check for >65yrs need for Pneumo.
  1.  ;---> need for Influenza and Pneumo.
  1.  ;
  1.  ;********** PATCH 14, v8.5, AUG 01,2017, IHS/CMI/MWR
  1.  ;---> Add IHS Addendum to TCH Report.
  1.  N BIADDND
  1.  D LDFORC^BIPATUP1(BIDFN,BIFORC,BIHX,BIFDT,BIDUZ2,.BINF,.BIPDSS,.BIADDND)
  1.  ;W !,BIPROF R ZZZ
  1.  D
  1.  .;---> Below preserves some ending character on TCH Report String.
  1.  .N X,Y S X=$L(BIPROF) S Y=$E(BIPROF,X) S BIPROF=$E(BIPROF,1,(X-1))
  1.  .I $G(BIADDND)="" D  Q
  1.  ..S BIPROF=BIPROF_"|||---------------------------|||No IHS Addendum|||"_Y
  1.  .S BIPROF=BIPROF_"|||---------------------------|||IHS Addendum: "_BIADDND_"|||"_Y
  1.  ;
  1.  ;**********
  1.  ;
  1.  ;---> Load Report Text into patient WP global (^BIP(DFN,1,).
  1.  D:'BINOP LDPROF(BIDFN,BIPROF)
  1.  ;
  1.  ;---> Unlock patient.
  1.  D UNLOCK(BIDFN)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. LDPROF(BIDFN,BIPROF,BIERR) ;EP
  1.  ;---> Entry point to load Immserve Profile into Patient's global.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN  (req) Patient IEN.
  1.  ;     2 - BIPROF (req) String containing text of Patient's Imm Profile.
  1.  ;     3 - BIERR  (ret) String returning text of error code.
  1.  ;
  1.  S BIERR=""
  1.  ;
  1.  I '$G(BIDFN) D ERRCD^BIUTL2(201,.BIERR) Q
  1.  ;
  1.  ;---> Quit if Patient does not exist in Immunization Register.
  1.  I '$D(^BIP(BIDFN,0)) D ERRCD^BIUTL2(204,.BIERR) Q
  1.  ;
  1.  ;---> Load Report Text into Patient's WP Node.
  1.  D SETVARS^BIUTL5
  1.  K ^BIP(BIDFN,1)
  1.  ;
  1.  ;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR
  1.  ;---> Switch to $C(13,10)) to accommodate new TCH Report.
  1.  ;S X=$L(BIPROF,$C(13))
  1.  ;F I=1:1:X S ^BIP(BIDFN,1,I,0)=$P(BIPROF,$C(13),I)
  1.  ;N X S X=$L(BIPROF,$C(13,10))
  1.  ;F I=1:1:X S ^BIP(BIDFN,1,I,0)=$P(BIPROF,$C(13,10),I)
  1.  N X S X=$L(BIPROF,"|||")
  1.  ;
  1.  ;
  1.  ;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
  1.  ;---> Insert patient name and DOB at top of Report Text (for EHR).
  1.  ;F I=1:1:X S ^BIP(BIDFN,1,I,0)=$P(BIPROF,"|||",I)
  1.  S ^BIP(BIDFN,1,1,0)=" "
  1.  S ^BIP(BIDFN,1,2,0)="Patient: "_$$NAME^BIUTL1(BIDFN)_"    DOB: "_$$DOBF^BIUTL1(BIDFN,$G(BIFDT))
  1.  S ^BIP(BIDFN,1,3,0)=" "
  1.  F I=1:1:X S ^BIP(BIDFN,1,(I+3),0)=$P(BIPROF,"|||",I)
  1.  ;**********
  1.  ;
  1.  S ^BIP(BIDFN,1,0)=U_U_X_U_X_U_DT
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. BIDE(BIDE) ;EP
  1.  ;---> Set Data Elements for TCH Format.
  1.  ;---> (Old v7.x: 6=Dose#, 23=Date of Visit, 25=HL7 Code.)
  1.  ;---> 25=CVX Code, 65=Dose Override, 88=TCH Date of Visit.
  1.  K BIDE
  1.  ;
  1.  ;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR
  1.  ;---> Pull TCH date format instead of Immserve.
  1.  ;N I F I=23,25,65 S BIDE(I)=""
  1.  N I F I=25,65,88 S BIDE(I)=""
  1.  ;**********
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. UNLOCK(BIDFN) ;EP
  1.  ;---> Unlock BI PATIENT global for this patient.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN (req) Patient DFN to unlock.
  1.  ;
  1.  Q:'$G(BIDFN)
  1.  L -^BIP(BIDFN)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. NOFORC(BINF) ;EP
  1.  ;---> Build local array of Vaccines Group IEN's that Site has
  1.  ;---> specified should not be forecast.
  1.  ;---> Parameters:
  1.  ;     1 - BINF (ret) Array of Vaccine Group IEN's that should not be forecast.
  1.  ;
  1.  N N S N=0
  1.  F  S N=$O(^BISERT(N)) Q:'N  D
  1.  .I '$P(^BISERT(N,0),U,5) S BINF(N)=""
  1.  Q
  1.  ;
  1.  ;
  1. DISPLAY ;EP
  1.  ;---> Display Input and Output Data Strings.
  1.  ;---> Uncomment any of the next lines to see History or ImmServe data:
  1.  ;W !!,"BIHX Out: ",BIHX R ZZZ
  1.  ;W !!,"BIFORC Full: ",BIFORC R ZZZ
  1.  ;
  1.  D  R ZZZ:600
  1.  .W #!," RPMS INPUT String, Patient Data: "
  1.  .W !,"   ",$P(BIHX,"~~~",1)
  1.  .;
  1.  .W !!," RPMS INPUT String, Dose History Input doses: "
  1.  .N BIDOSE,BIDOSES,I S BIDOSES=$P(BIHX,"~~~",2)
  1.  .F I=1:1 S BIDOSE=$P(BIDOSES,"|||",I) Q:(BIDOSE="")  W !,"   ",BIDOSE
  1.  ;
  1.  D  R ZZZ:600
  1.  .W !!!," TCH OUTPUT String, Input doses: "
  1.  .N BIDOSE,BIDOSES,I S BIDOSES=$P(BIFORC,"~~~",2)
  1.  .F I=1:1 S BIDOSE=$P(BIDOSES,"|||",I) Q:(BIDOSE="")  W !,"   ",BIDOSE
  1.  ;
  1.  D  R ZZZ:600
  1.  .W !!!," TCH OUTPUT String, Doses Due: "
  1.  .N BIDOSE,BIDOSES,I S BIDOSES=$P(BIFORC,"~~~",3)
  1.  .F I=1:1 S BIDOSE=$P(BIDOSES,"|||",I) Q:(BIDOSE="")  W !,"   ",BIDOSE
  1.  ;
  1.  Q