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

BIRPC.m

Go to the documentation of this file. 
  1. BIRPC ;IHS/CMI/MWR - REMOTE PROCEDURE CALLS; MAY 10, 2010
  1.  ;;8.5;IMMUNIZATION;**9**;OCT 01,2014
  1.  ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
  1.  ;;  RETURNS IMMUNIZATION HISTORY, FORECAST, IMM/SERV PROFILE.
  1.  ;;  PATCH 1: Add API: FORCALL, to allow queued update of all BI Patients.
  1.  ;;  PATCH 3: Add NDC and Elig Codes, plus Date of Event to default Hx string. IMMHX+60
  1.  ;;  PATCH 5: Add Admin Note to default Hx string. IMMHX+60
  1.  ;;  PATCH 9: Add Date VIS Presented to Patient as piece 26.  IMMHX+65
  1.  ;
  1.  ;
  1.  ;----------
  1. IMMHX(BIHX,BIDFN,BIDE,BISKIN,BIFMT) ;PEP - Return Immunization History.
  1.  ;---> Return Patient's Immunization History.
  1.  ;---> Immunizations returned in one string, delimited by "^".
  1.  ;---> Parameters:
  1.  ;     1 - BIHX   (ret) String of patient's immunizations_||_Error.
  1.  ;     2 - BIDFN  (req) DFN of patient.
  1.  ;     3 - BIDE   (opt) Array of Data Elements to be returned:
  1.  ;                      BIDE(IEN of Data Element).
  1.  ;     4 - BISKIN (opt) =1 if Skin Tests should be included (DEFAULT);
  1.  ;                      =0 if Skin Tests should NOT be included.
  1.  ;     5 - BIFMT  (opt) Format: 0=ASCII Split, 1=ASCII, 3=IMM/SERVE
  1.  ;                      "Split" means the components of a combination vaccine
  1.  ;                      will be split out as if they were given individually.
  1.  ;
  1.  ;---> Delimiter to pass error with result to GUI.
  1.  N BI31,BIERR S BI31=$C(31)_$C(31)
  1.  S BIHX="",BIERR=""
  1.  ;
  1.  ;---> If DFN not provided, set Error Code and quit.
  1.  ;I $G(BIDFN) D  Q  ;---> Use this line to test error handling.
  1.  I '$G(BIDFN) D  Q
  1.  .D ERRCD^BIUTL2(306,.BIERR) S BIHX=BI31_BIERR
  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.  ;---> If BIDE local array (Data Elements to be returned) is not
  1.  ;---> passed, then set the following default Data Elements.
  1.  ;---> The following are IEN's in ^BIEXPDD(.
  1.  ;---> IEN PC  DATA
  1.  ;---> --- --  ----
  1.  ;--->     1 = Visit Type: "I"=Immunization, "S"=Skin Test.
  1.  ;--->  4  2 = Vaccine Name, Short.
  1.  ;--->  8  3 = Vaccine Component IEN'S.  ;v8.0
  1.  ;---> 24  4 = IEN, V File Visit.
  1.  ;---> 26  5 = Location (or Outside Location) where Imm was given.
  1.  ;---> 27  6 = Vaccine Group (Series Type) for grouping of vaccines.
  1.  ;---> 29  7 = Date of Visit (DD-Mmm-YYYY @HH:MM).
  1.  ;---> 38  8 = Skin Test Result.
  1.  ;---> 39  9 = Skin Test Reading.
  1.  ;---> 40 10 = Skin Test date read.
  1.  ;---> 41 11 = Skin Test Name.
  1.  ;---> 42 12 = Skin Test Name IEN.
  1.  ;---> 44 13 = Reaction to Immunization, text.
  1.  ;---> 51 14 = Release/Revision Date of VIS (DD-Mmm-YYYY).
  1.  ;---> 61 15 = Encounter Provider.
  1.  ;---> 65 16 = Dose Override.
  1.  ;---> 66 17 = Date of Visit (MM/DD/YY).
  1.  ;---> 69 18 = Vaccine Component CVX Code.
  1.  ;---> 74 19 = CPT-Coded Visit.
  1.  ;---> 78 20 = Imported from Outside Registry (if = 1).
  1.  ;---> 80 21 = NDC Code pointer IEN.
  1.  ;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR
  1.  ;---> Add NDC and Eligibility Codes, plus Date of Event to default Hx string.
  1.  ;---> 82 22 = Elilgibility Code Text.
  1.  ;---> 84 23 = NDC Code text.
  1.  ;---> 85 24 = Date of Event/Administer shot (1201 field of V File) in MM/DD/YY
  1.  ;
  1.  ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
  1.  ;---> Add Admin Note to default Hx string.
  1.  ;---> 87 25 = Administrative Note.
  1.  ;
  1.  ;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
  1.  ;---> Add Date VIS Presented to Patient (MM/DD/YY).
  1.  ;---> 90 26 = Date VIS Presented to Patient.
  1.  ;
  1.  D:'$D(BIDE)
  1.  .;N I F I=4,8,24,26,27,29,38,39,40,41,42,44,51,61,65,66,69,74,78,80,82,84,85,87 S BIDE(I)=""
  1.  .N I F I=4,8,24,26,27,29,38,39,40,41,42,44,51,61,65,66,69,74,78,80,82,84,85,87,90 S BIDE(I)=""
  1.  ;**********
  1.  N BIMM S BIMM("ALL")=""
  1.  ;
  1.  ;---> Next, gather Immunization History for this patient.
  1.  ;     1 - BIFMT  (req) Format: 0=ASCII Split, 1=ASCII, 2=HL7, 3=IMM/SERVE
  1.  ;     2 - BIDE   (req) Data Elements array (null if HL7)
  1.  ;     3 - BIMM   (req) Array of Vaccine Types
  1.  ;     4 - BIFDT  (opt) Forecast Date (not needed for history only).
  1.  ;     5 - BISKIN (opt) =1 if Skin Tests should be included.
  1.  ;
  1.  S:'$D(BISKIN) BISKIN=1
  1.  S:'$D(BIFMT) BIFMT=0
  1.  D HISTORY^BIEXPRT3(BIFMT,.BIDE,.BIMM,,BISKIN)
  1.  ;
  1.  ;
  1.  ;---> Next, set parameters for writing data as a string 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.  D WRITE^BIEXPRT4(2,1,,,.BIHX)
  1.  ;
  1.  ;W !,BIHX,!,"IMMHX^BIRPC" R ZZZ
  1.  S BIHX=BIHX_BI31
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. IMMFORC(BIFORC,BIDFN,BIFDT,BIUPD,BIDUZ2,BIPDSS) ;PEP - Return Immunization Forecast.
  1.  ;---> Return Immserve Patient Forecast in one string.
  1.  ;---> Lines delimited by "^".
  1.  ;---> Called by RPC: BI IMMSERVE PT PROFILE
  1.  ;---> Parameters:
  1.  ;     1 - BIFORC (ret) String of patient's forecast_||_Error.
  1.  ;     2 - BIDFN  (req) DFN of patient.
  1.  ;     3 - BIFDT  (opt) Forecast Date (date used for forecast).
  1.  ;     4 - BIUPD  (opt) If BIUPD=1, do NOT update Immserve Forecast.
  1.  ;                      Default $G(BIUPD)="", forecast gets updated.
  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 V IMM IEN's that are
  1.  ;                      Problem Doses, according to TCH.
  1.  ;
  1.  ;---> Define delimiter to pass error and error variable.
  1.  N BI31,BIERR S BI31=$C(31)_$C(31),BIERR=""
  1.  ;
  1.  ;---> If the Vaccine Table is not standard, set Error Code and quit.
  1.  I $D(^BISITE(-1)) D  Q
  1.  .D ERRCD^BIUTL2(503,.BIERR) S BIFORC=BI31_BIERR
  1.  ;
  1.  I '$G(BIDFN) D ERRCD^BIUTL2(301,.BIERR) S BIFORC=BI31_BIERR Q
  1.  ;
  1.  ;---> If patient is deceased, report it as error (in msgbox).
  1.  I $$DECEASED^BIUTL1(BIDFN) D  Q
  1.  .D ERRCD^BIUTL2(205,.BIERR) S BIFORC=BI31_BIERR Q
  1.  ;
  1.  ;---> If no Forecast Date passed, set it equal to today.
  1.  S:'$G(BIFDT) BIFDT=DT
  1.  ;
  1.  ;---> If Forecast Date is before Patient's DOB, set Error Code and quit.
  1.  I BIFDT<$$DOB^BIUTL1(BIDFN) D  Q
  1.  .D ERRCD^BIUTL2(315,.BIERR) S BIFORC=BI31_BIERR
  1.  ;
  1.  ;---> Update patient's forecast with Immserve Utility (in ^BIPDUE).
  1.  D:'$G(BIUPD) UPDATE^BIPATUP(BIDFN,BIFDT,.BIERR,1,$G(BIDUZ2),.BIPDSS)
  1.  I BIERR]"" S BIFORC=BI31_BIERR Q
  1.  ;
  1.  ;---> If no Immunizations are due for this patient, return message.
  1.  I '$D(^BIPDUE("B",BIDFN))&('$D(^BIPERR("B",BIDFN))) D  Q
  1.  .S BIFORC="No immunizations due."_BI31
  1.  .;---> NOTE! The above text is specifically checked for in ^BIPATVW1.
  1.  ;
  1.  ;---> Copy Immserve Patient Forecast (stored in ^BIPDUE) to string.
  1.  N A,B,C,N,U,V,X,Z
  1.  S:'$D(BIFORC) BIFORC="" S U="^",V="|"
  1.  S N=0
  1.  F  S N=$O(^BIPDUE("B",BIDFN,N)) Q:'N  D
  1.  .S Z=$G(^BIPDUE(N,0))
  1.  .I $P(Z,U)'=BIDFN K ^BIPDUE(N),^BIPDUE("B",BIDFN,N) Q
  1.  .;
  1.  .;---> A=Date Due, B=Date Past Due.
  1.  .S A=$P(Z,U,4),B=$P(Z,U,5)
  1.  .S X="  "_$$VNAME^BIUTL2($P(Z,U,2))  ;v8.0
  1.  .;
  1.  .;---> Concatenate due by/past due appropriate text and date.
  1.  .S X=X_V_$S(B:" past due",1:" due")
  1.  .S BIFORC=BIFORC_X_U
  1.  ;
  1.  ;
  1.  ;---> Copy any Forecasting Errors (stored in ^BIPERR) to string.
  1.  S N=0
  1.  F  S N=$O(^BIPERR("B",BIDFN,N)) Q:'N  D
  1.  .S Z=$G(^BIPERR(N,0))
  1.  .I $P(Z,U)'=BIDFN K ^BIPERR(N),^BIPERR("B",BIDFN,N) Q
  1.  .S X=$P(Z,U,2) S:'X X=999
  1.  .;
  1.  .S X=$P(Z,U,3)_" ERROR: "_$P((^BIERR(X,0)),"^",2)
  1.  .S BIFORC=BIFORC_X_U
  1.  ;
  1.  S BIFORC=BIFORC_BI31
  1.  Q
  1.  ;
  1.  ;
  1.  ;
  1.  ;----------
  1. IMMPROF(BIGBL,BIDFN,BIFDT,BIDUZ2) ;PEP - Return ImmServe Profile in global array.
  1.  ;---> Return ImmServe Profile in global array, ^BITEMP($J,"PROF".
  1.  ;---> Lines delimited by "^".
  1.  ;---> Called by RPC: BI PATIENT PROFILE GET
  1.  ;---> Parameters:
  1.  ;     1 - BIGBL  (ret) Name of result global containing patient's
  1.  ;                      ImmServe Profile, passed to Broker.
  1.  ;     2 - BIDFN  (req) DFN of patient.
  1.  ;     3 - BIFDT  (opt) Forecast Date (date used to calc Imms due).
  1.  ;     4 - BIDUZ2 (opt) User's DUZ(2) to indicate Immserve Forecasting
  1.  ;                      Rules in Patient History data string.
  1.  ;
  1.  ;---> Delimiters to pass error with result to GUI.
  1.  N BI30,BI31,BIERR,X
  1.  S BI30=$C(30),BI31=$C(31)_$C(31)
  1.  S BIGBL="^BITEMP("_$J_",""PROF"")",BIERR=""
  1.  K ^BITEMP($J,"PROF")
  1.  ;
  1.  I '$G(BIDFN) D  Q
  1.  .D ERRCD^BIUTL2(305,.BIERR) S ^BITEMP($J,"PROF",1)=BI31_BIERR
  1.  ;
  1.  ;---> If patient is deceased, report it as error (in msgbox).
  1.  I $$DECEASED^BIUTL1(BIDFN) D  Q
  1.  .D ERRCD^BIUTL2(205,.BIERR) S ^BITEMP($J,"PROF",1)=BI31_BIERR
  1.  ;
  1.  ;---> If the Patient is not in the Immunization Register,
  1.  ;---> report the fact in the Profile (instead of as an error).
  1.  I '$D(^BIP(BIDFN)) D  Q
  1.  .N X
  1.  .S X="This patient is not in the Immunization Register."
  1.  .S ^BITEMP($J,"PROF",1)=X_BI30
  1.  .S X="The Immserve Profile cannot be stored and displayed"
  1.  .S ^BITEMP($J,"PROF",2)=X_BI30
  1.  .S X="if the patient is not in the Register."
  1.  .S ^BITEMP($J,"PROF",3)=X_BI30
  1.  .S ^BITEMP($J,"PROF",4)=BI31
  1.  ;
  1.  ;---> If no Forecast Date passed, set it equal to today.
  1.  S:'$G(BIFDT) BIFDT=DT
  1.  ;
  1.  ;---> Update patient's profile with Immserve Utility.
  1.  D UPDATE^BIPATUP(BIDFN,BIFDT,.BIERR,,$G(BIDUZ2))
  1.  ;
  1.  ;---> Copy Immserve Patient Profile to string.
  1.  N I,N,U,X S U="^"
  1.  S N=0
  1.  F I=1:1 S N=$O(^BIP(BIDFN,1,N)) Q:'N  D
  1.  .;---> Set null lines (line breaks) equal to one space, so that
  1.  .;---> Windows reader will quit only at the final "null" line.
  1.  .S X=^BIP(BIDFN,1,N,0) S:X="" X=" "
  1.  .S ^BITEMP($J,"PROF",I)=X_BI30
  1.  ;
  1.  ;---> If no ImmServe Profile produced, report it as an error.
  1.  I '$O(^BITEMP($J,"PROF",0)) D ERRCD^BIUTL2(307,.BIERR)
  1.  ;
  1.  ;---> Tack on Error Delimiter and any error.
  1.  S ^BITEMP($J,"PROF",I)=BI31_BIERR
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. FORCALL ;PEP - Update Forecast for all Immunization Patients.
  1.  ;---> Can be called by RPC: BI FORECAST ALL
  1.  ;---> Can be called by OPTION: BI FORECAST ALL (may be queued in Taskman)
  1.  ;---> This subroutine updates the immunization forecast for all patients in
  1.  ;---> the File BI PATIENT IMMUNIZATIONS DUE File #9002084.1 for today.
  1.  D ^XBKVAR
  1.  N ZTIO S ZTIO=""
  1.  N BIN S BIN=0
  1.  F  S BIN=$O(^BIP(BIN)) Q:'BIN  D IMMFORC^BIRPC(,BIN)
  1.  Q