BIPATUP ;IHS/CMI/MWR - UPDATE PATIENT FORECAST; MAY 10, 2010
;;8.5;IMMUNIZATION;**14**;AUG 01,2017
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; UPDATE PATIENT FORECAST DATA, IMM PROFILE IN ^BIP(DFN,
;; AND IMM FORECAST IN ^BIPDUE(.
;; PATCH 8: Changes to accommodate new TCH Forecaster UPDATE+81,+99, LDPROF+18, BIDE+6
;; PATCH 9: Insert patient name and DOB at top of Report Text (for EHR). LDPROF+28
;; Add DUZ2 so that BIXTCH can retrieve IP address for TCH.
;; PATCH 14: Add IHS Addendum to TCH Report. UPDATE+118
;
;
;----------
UPDATE(BIDFN,BIFDT,BIERR,BINOP,BIDUZ2,BIPDSS) ;EP
;---> Update Patient Imms Due (in ^BIPDUE) using Immserve Utility.
;---> Parameters:
; 1 - BIDFN (req) Patient IEN.
; 2 - BIFDT (opt) Forecast Date (date used for forecast).
; 3 - BIERR (ret) String returning text of error code.
; 4 - BINOP (opt) If BINOP=1 do not retrieve Imm Profile.
; 5 - BIDUZ2 (opt) User's DUZ(2) to indicate Immserve Forecasting
; Rules in Patient History data string.
; 6 - BIPDSS (ret) Returned string of Visit IEN's that are
; Problem Doses, according to TCH.
;
S BIERR=""
;
;---> If Vaccine global (^AUTTIMM) is not standard, set Error Text
;---> in patient's Profile global, return Error Text and quit.
I $D(^BISITE(-1)) D Q
.K ^BIP(BIDFN,1)
.D ERRCD^BIUTL2(503,.BIERR)
.S ^BIP(BIDFN,1,1,0)=BIERR
.S ^BIP(BIDFN,1,0)=U_U_1_U_1_U_DT
;
I '$G(BIDFN) D ERRCD^BIUTL2(201,.BIERR) Q
;
;---> Return 1 if Forecasting is enabled.
I '$$FORECAS^BIUTL2(DUZ(2)) D ERRCD^BIUTL2(314,.BIERR) Q
;
;---> If no Forecast Date passed, set it equal to today.
S:'$G(BIFDT) BIFDT=DT
;
;---> If no BIDUZ2, try DUZ(2); otherwise, defaults will be used.
S:'$G(BIDUZ2) BIDUZ2=$G(DUZ(2))
;
;---> If BINOP not specified, retrieve and store Imm Profile.
S:'$G(BINOP) BINOP=0
;
;---> Quit if this patient is Locked (being edited by another user).
L +^BIP(BIDFN):0 I '$T D ERRCD^BIUTL2(212,.BIERR) Q
;
;---> Set required variables, kill ^BITMP($J).
D SETVARS^BIUTL5 K ^BITMP($J)
;
;---> Set the patient temp global.
S ^BITMP($J,1,BIDFN)=""
;
;---> Gather Immunization History for this patient (into ^BITMP) .
;---> Parameters:
; 1 - BIFMT (req) Format: 1=ASCII, 2=HL7, 3=IMM/SERVE
; 2 - BIDE (req) Data Elements array (null if HL7)
; 3 - BIMM (req) Array of Imms to be passed to forecasting.
; 4 - BIFDT (opt) Forecast Date (date used to calc Imms due).
; 5 - BISKIN (opt) ""=Do not retrieve Skin Tests.
; 6 - BIDUZ2 (opt) User's DUZ(2) to indicate Immserve Forecasting
; Rules in Patient History data string.
; 7 - BINF (opt) Array of Vaccines that should not be forecast.
;
;
;---> Build local array of Vaccines (by HL7 Code) that should not
;---> be forecast, according to this machine's Immunization File.
N BINF D NOFORC(.BINF)
;
N BIDE S BIDE="" D BIDE(.BIDE)
N BIMM S BIMM("ALL")=""
;
;---> Gather Patient Imm History in ^BITMP.
D HISTORY^BIEXPRT3(3,.BIDE,.BIMM,BIFDT,,BIDUZ2,.BINF)
;
;---> Retrieve data for this patient from ^BITMP, return in BIHX.
;---> Parameters:
; 1 - BIEXP (req) Export: 0=screen, 1=host file, 2=string
; 2 - BIFMT (req) Format: 1=ASCII, 2=HL7, 3=IMM/SERVE
; 3 - BIFLNM (opt) File name
; 4 - BIPATH (opt) BI Path name for host files
; 5 - BIHX (ret) Immunization History in "^"-delimited string
;
N BIHX S BIHX=""
D WRITE^BIEXPRT4(2,3,,,.BIHX)
;
;---> Check for precise Date of Birth.
N X S X=$P(BIHX,U,8)
;
;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR
;---> Change error check to accommodate new TCH date format.
;I ('$E(X,1,2))!('$E(X,3,4))!('$E(X,5,8)) D ERRCD^BIUTL2(215,.BIERR) Q
I ('$E(X,1,4))!('$E(X,5,6))!('$E(X,7,8)) D ERRCD^BIUTL2(215,.BIERR) Q
;**********
;
;
;---> Use Immunization History (in BIHX) to obtain Immserve Forecast.
;---> Parameters:
; 1 - BIHX (req) String contain Patient's Immunization History.
; 2 - BIPROF (ret) String returning text version of profile.
; 3 - BIFORC (ret) String returning data version of forecast.
; 4 - BIERR (ret) String returning text of error code.
;
N BIPROF,BIFORC S (BIPROF,BIFORC)=""
;
;---> Call ImmServe and get Forecast and Profile.
;
;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR
;---> Call new TCH Forecaster.
;D RUN^BIXCALL(BIHX,.BIPROF,.BIFORC,.BIERR)
;
;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
;---> Add DUZ2 so that BIXTCH can retrieve IP address for TCH.
;D RUN^BIXTCH(BIHX,.BIPROF,.BIFORC,.BIERR)
D RUN^BIXTCH(BIHX,BIDUZ2,.BIPROF,.BIFORC,.BIERR)
;**********
;
;---> For diagnostic purposes.
;D DISPLAY
;
I BIERR]"" D UNLOCK(BIDFN) Q
;
;---> Load Forecast into BI PATIENT IMMUNIZATIONS DUE File (^BIPDUE).
;---> Pass BIHX (history) and BIFDT to check for >65yrs need for Pneumo.
;---> need for Influenza and Pneumo.
;
;********** PATCH 14, v8.5, AUG 01,2017, IHS/CMI/MWR
;---> Add IHS Addendum to TCH Report.
N BIADDND
D LDFORC^BIPATUP1(BIDFN,BIFORC,BIHX,BIFDT,BIDUZ2,.BINF,.BIPDSS,.BIADDND)
;W !,BIPROF R ZZZ
D
.;---> Below preserves some ending character on TCH Report String.
.N X,Y S X=$L(BIPROF) S Y=$E(BIPROF,X) S BIPROF=$E(BIPROF,1,(X-1))
.I $G(BIADDND)="" D Q
..S BIPROF=BIPROF_"|||---------------------------|||No IHS Addendum|||"_Y
.S BIPROF=BIPROF_"|||---------------------------|||IHS Addendum: "_BIADDND_"|||"_Y
;
;**********
;
;---> Load Report Text into patient WP global (^BIP(DFN,1,).
D:'BINOP LDPROF(BIDFN,BIPROF)
;
;---> Unlock patient.
D UNLOCK(BIDFN)
Q
;
;
;----------
LDPROF(BIDFN,BIPROF,BIERR) ;EP
;---> Entry point to load Immserve Profile into Patient's global.
;---> Parameters:
; 1 - BIDFN (req) Patient IEN.
; 2 - BIPROF (req) String containing text of Patient's Imm Profile.
; 3 - BIERR (ret) String returning text of error code.
;
S BIERR=""
;
I '$G(BIDFN) D ERRCD^BIUTL2(201,.BIERR) Q
;
;---> Quit if Patient does not exist in Immunization Register.
I '$D(^BIP(BIDFN,0)) D ERRCD^BIUTL2(204,.BIERR) Q
;
;---> Load Report Text into Patient's WP Node.
D SETVARS^BIUTL5
K ^BIP(BIDFN,1)
;
;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR
;---> Switch to $C(13,10)) to accommodate new TCH Report.
;S X=$L(BIPROF,$C(13))
;F I=1:1:X S ^BIP(BIDFN,1,I,0)=$P(BIPROF,$C(13),I)
;N X S X=$L(BIPROF,$C(13,10))
;F I=1:1:X S ^BIP(BIDFN,1,I,0)=$P(BIPROF,$C(13,10),I)
N X S X=$L(BIPROF,"|||")
;
;
;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
;---> Insert patient name and DOB at top of Report Text (for EHR).
;F I=1:1:X S ^BIP(BIDFN,1,I,0)=$P(BIPROF,"|||",I)
S ^BIP(BIDFN,1,1,0)=" "
S ^BIP(BIDFN,1,2,0)="Patient: "_$$NAME^BIUTL1(BIDFN)_" DOB: "_$$DOBF^BIUTL1(BIDFN,$G(BIFDT))
S ^BIP(BIDFN,1,3,0)=" "
F I=1:1:X S ^BIP(BIDFN,1,(I+3),0)=$P(BIPROF,"|||",I)
;**********
;
S ^BIP(BIDFN,1,0)=U_U_X_U_X_U_DT
Q
;
;
;----------
BIDE(BIDE) ;EP
;---> Set Data Elements for TCH Format.
;---> (Old v7.x: 6=Dose#, 23=Date of Visit, 25=HL7 Code.)
;---> 25=CVX Code, 65=Dose Override, 88=TCH Date of Visit.
K BIDE
;
;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR
;---> Pull TCH date format instead of Immserve.
;N I F I=23,25,65 S BIDE(I)=""
N I F I=25,65,88 S BIDE(I)=""
;**********
Q
;
;
;----------
UNLOCK(BIDFN) ;EP
;---> Unlock BI PATIENT global for this patient.
;---> Parameters:
; 1 - BIDFN (req) Patient DFN to unlock.
;
Q:'$G(BIDFN)
L -^BIP(BIDFN)
Q
;
;
;----------
NOFORC(BINF) ;EP
;---> Build local array of Vaccines Group IEN's that Site has
;---> specified should not be forecast.
;---> Parameters:
; 1 - BINF (ret) Array of Vaccine Group IEN's that should not be forecast.
;
N N S N=0
F S N=$O(^BISERT(N)) Q:'N D
.I '$P(^BISERT(N,0),U,5) S BINF(N)=""
Q
;
;
DISPLAY ;EP
;---> Display Input and Output Data Strings.
;---> Uncomment any of the next lines to see History or ImmServe data:
;W !!,"BIHX Out: ",BIHX R ZZZ
;W !!,"BIFORC Full: ",BIFORC R ZZZ
;
D R ZZZ:600
.W #!," RPMS INPUT String, Patient Data: "
.W !," ",$P(BIHX,"~~~",1)
.;
.W !!," RPMS INPUT String, Dose History Input doses: "
.N BIDOSE,BIDOSES,I S BIDOSES=$P(BIHX,"~~~",2)
.F I=1:1 S BIDOSE=$P(BIDOSES,"|||",I) Q:(BIDOSE="") W !," ",BIDOSE
;
D R ZZZ:600
.W !!!," TCH OUTPUT String, Input doses: "
.N BIDOSE,BIDOSES,I S BIDOSES=$P(BIFORC,"~~~",2)
.F I=1:1 S BIDOSE=$P(BIDOSES,"|||",I) Q:(BIDOSE="") W !," ",BIDOSE
;
D R ZZZ:600
.W !!!," TCH OUTPUT String, Doses Due: "
.N BIDOSE,BIDOSES,I S BIDOSES=$P(BIFORC,"~~~",3)
.F I=1:1 S BIDOSE=$P(BIDOSES,"|||",I) Q:(BIDOSE="") W !," ",BIDOSE
;
Q
BIPATUP ;IHS/CMI/MWR - UPDATE PATIENT FORECAST; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;**14**;AUG 01,2017
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; UPDATE PATIENT FORECAST DATA, IMM PROFILE IN ^BIP(DFN,
+4 ;; AND IMM FORECAST IN ^BIPDUE(.
+5 ;; PATCH 8: Changes to accommodate new TCH Forecaster UPDATE+81,+99, LDPROF+18, BIDE+6
+6 ;; PATCH 9: Insert patient name and DOB at top of Report Text (for EHR). LDPROF+28
+7 ;; Add DUZ2 so that BIXTCH can retrieve IP address for TCH.
+8 ;; PATCH 14: Add IHS Addendum to TCH Report. UPDATE+118
+9 ;
+10 ;
+11 ;----------
UPDATE(BIDFN,BIFDT,BIERR,BINOP,BIDUZ2,BIPDSS) ;EP
+1 ;---> Update Patient Imms Due (in ^BIPDUE) using Immserve Utility.
+2 ;---> Parameters:
+3 ; 1 - BIDFN (req) Patient IEN.
+4 ; 2 - BIFDT (opt) Forecast Date (date used for forecast).
+5 ; 3 - BIERR (ret) String returning text of error code.
+6 ; 4 - BINOP (opt) If BINOP=1 do not retrieve Imm Profile.
+7 ; 5 - BIDUZ2 (opt) User's DUZ(2) to indicate Immserve Forecasting
+8 ; Rules in Patient History data string.
+9 ; 6 - BIPDSS (ret) Returned string of Visit IEN's that are
+10 ; Problem Doses, according to TCH.
+11 ;
+12 SET BIERR=""
+13 ;
+14 ;---> If Vaccine global (^AUTTIMM) is not standard, set Error Text
+15 ;---> in patient's Profile global, return Error Text and quit.
+16 IF $DATA(^BISITE(-1))
Begin DoDot:1
+17 KILL ^BIP(BIDFN,1)
+18 DO ERRCD^BIUTL2(503,.BIERR)
+19 SET ^BIP(BIDFN,1,1,0)=BIERR
+20 SET ^BIP(BIDFN,1,0)=U_U_1_U_1_U_DT
End DoDot:1
QUIT
+21 ;
+22 IF '$GET(BIDFN)
DO ERRCD^BIUTL2(201,.BIERR)
QUIT
+23 ;
+24 ;---> Return 1 if Forecasting is enabled.
+25 IF '$$FORECAS^BIUTL2(DUZ(2))
DO ERRCD^BIUTL2(314,.BIERR)
QUIT
+26 ;
+27 ;---> If no Forecast Date passed, set it equal to today.
+28 IF '$GET(BIFDT)
SET BIFDT=DT
+29 ;
+30 ;---> If no BIDUZ2, try DUZ(2); otherwise, defaults will be used.
+31 IF '$GET(BIDUZ2)
SET BIDUZ2=$GET(DUZ(2))
+32 ;
+33 ;---> If BINOP not specified, retrieve and store Imm Profile.
+34 IF '$GET(BINOP)
SET BINOP=0
+35 ;
+36 ;---> Quit if this patient is Locked (being edited by another user).
+37 LOCK +^BIP(BIDFN):0
IF '$TEST
DO ERRCD^BIUTL2(212,.BIERR)
QUIT
+38 ;
+39 ;---> Set required variables, kill ^BITMP($J).
+40 DO SETVARS^BIUTL5
KILL ^BITMP($JOB)
+41 ;
+42 ;---> Set the patient temp global.
+43 SET ^BITMP($JOB,1,BIDFN)=""
+44 ;
+45 ;---> Gather Immunization History for this patient (into ^BITMP) .
+46 ;---> Parameters:
+47 ; 1 - BIFMT (req) Format: 1=ASCII, 2=HL7, 3=IMM/SERVE
+48 ; 2 - BIDE (req) Data Elements array (null if HL7)
+49 ; 3 - BIMM (req) Array of Imms to be passed to forecasting.
+50 ; 4 - BIFDT (opt) Forecast Date (date used to calc Imms due).
+51 ; 5 - BISKIN (opt) ""=Do not retrieve Skin Tests.
+52 ; 6 - BIDUZ2 (opt) User's DUZ(2) to indicate Immserve Forecasting
+53 ; Rules in Patient History data string.
+54 ; 7 - BINF (opt) Array of Vaccines that should not be forecast.
+55 ;
+56 ;
+57 ;---> Build local array of Vaccines (by HL7 Code) that should not
+58 ;---> be forecast, according to this machine's Immunization File.
+59 NEW BINF
DO NOFORC(.BINF)
+60 ;
+61 NEW BIDE
SET BIDE=""
DO BIDE(.BIDE)
+62 NEW BIMM
SET BIMM("ALL")=""
+63 ;
+64 ;---> Gather Patient Imm History in ^BITMP.
+65 DO HISTORY^BIEXPRT3(3,.BIDE,.BIMM,BIFDT,,BIDUZ2,.BINF)
+66 ;
+67 ;---> Retrieve data for this patient from ^BITMP, return in BIHX.
+68 ;---> Parameters:
+69 ; 1 - BIEXP (req) Export: 0=screen, 1=host file, 2=string
+70 ; 2 - BIFMT (req) Format: 1=ASCII, 2=HL7, 3=IMM/SERVE
+71 ; 3 - BIFLNM (opt) File name
+72 ; 4 - BIPATH (opt) BI Path name for host files
+73 ; 5 - BIHX (ret) Immunization History in "^"-delimited string
+74 ;
+75 NEW BIHX
SET BIHX=""
+76 DO WRITE^BIEXPRT4(2,3,,,.BIHX)
+77 ;
+78 ;---> Check for precise Date of Birth.
+79 NEW X
SET X=$PIECE(BIHX,U,8)
+80 ;
+81 ;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR
+82 ;---> Change error check to accommodate new TCH date format.
+83 ;I ('$E(X,1,2))!('$E(X,3,4))!('$E(X,5,8)) D ERRCD^BIUTL2(215,.BIERR) Q
+84 IF ('$EXTRACT(X,1,4))!('$EXTRACT(X,5,6))!('$EXTRACT(X,7,8))
DO ERRCD^BIUTL2(215,.BIERR)
QUIT
+85 ;**********
+86 ;
+87 ;
+88 ;---> Use Immunization History (in BIHX) to obtain Immserve Forecast.
+89 ;---> Parameters:
+90 ; 1 - BIHX (req) String contain Patient's Immunization History.
+91 ; 2 - BIPROF (ret) String returning text version of profile.
+92 ; 3 - BIFORC (ret) String returning data version of forecast.
+93 ; 4 - BIERR (ret) String returning text of error code.
+94 ;
+95 NEW BIPROF,BIFORC
SET (BIPROF,BIFORC)=""
+96 ;
+97 ;---> Call ImmServe and get Forecast and Profile.
+98 ;
+99 ;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR
+100 ;---> Call new TCH Forecaster.
+101 ;D RUN^BIXCALL(BIHX,.BIPROF,.BIFORC,.BIERR)
+102 ;
+103 ;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
+104 ;---> Add DUZ2 so that BIXTCH can retrieve IP address for TCH.
+105 ;D RUN^BIXTCH(BIHX,.BIPROF,.BIFORC,.BIERR)
+106 DO RUN^BIXTCH(BIHX,BIDUZ2,.BIPROF,.BIFORC,.BIERR)
+107 ;**********
+108 ;
+109 ;---> For diagnostic purposes.
+110 ;D DISPLAY
+111 ;
+112 IF BIERR]""
DO UNLOCK(BIDFN)
QUIT
+113 ;
+114 ;---> Load Forecast into BI PATIENT IMMUNIZATIONS DUE File (^BIPDUE).
+115 ;---> Pass BIHX (history) and BIFDT to check for >65yrs need for Pneumo.
+116 ;---> need for Influenza and Pneumo.
+117 ;
+118 ;********** PATCH 14, v8.5, AUG 01,2017, IHS/CMI/MWR
+119 ;---> Add IHS Addendum to TCH Report.
+120 NEW BIADDND
+121 DO LDFORC^BIPATUP1(BIDFN,BIFORC,BIHX,BIFDT,BIDUZ2,.BINF,.BIPDSS,.BIADDND)
+122 ;W !,BIPROF R ZZZ
+123 Begin DoDot:1
+124 ;---> Below preserves some ending character on TCH Report String.
+125 NEW X,Y
SET X=$LENGTH(BIPROF)
SET Y=$EXTRACT(BIPROF,X)
SET BIPROF=$EXTRACT(BIPROF,1,(X-1))
+126 IF $GET(BIADDND)=""
Begin DoDot:2
+127 SET BIPROF=BIPROF_"|||---------------------------|||No IHS Addendum|||"_Y
End DoDot:2
QUIT
+128 SET BIPROF=BIPROF_"|||---------------------------|||IHS Addendum: "_BIADDND_"|||"_Y
End DoDot:1
+129 ;
+130 ;**********
+131 ;
+132 ;---> Load Report Text into patient WP global (^BIP(DFN,1,).
+133 IF 'BINOP
DO LDPROF(BIDFN,BIPROF)
+134 ;
+135 ;---> Unlock patient.
+136 DO UNLOCK(BIDFN)
+137 QUIT
+138 ;
+139 ;
+140 ;----------
LDPROF(BIDFN,BIPROF,BIERR) ;EP
+1 ;---> Entry point to load Immserve Profile into Patient's global.
+2 ;---> Parameters:
+3 ; 1 - BIDFN (req) Patient IEN.
+4 ; 2 - BIPROF (req) String containing text of Patient's Imm Profile.
+5 ; 3 - BIERR (ret) String returning text of error code.
+6 ;
+7 SET BIERR=""
+8 ;
+9 IF '$GET(BIDFN)
DO ERRCD^BIUTL2(201,.BIERR)
QUIT
+10 ;
+11 ;---> Quit if Patient does not exist in Immunization Register.
+12 IF '$DATA(^BIP(BIDFN,0))
DO ERRCD^BIUTL2(204,.BIERR)
QUIT
+13 ;
+14 ;---> Load Report Text into Patient's WP Node.
+15 DO SETVARS^BIUTL5
+16 KILL ^BIP(BIDFN,1)
+17 ;
+18 ;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR
+19 ;---> Switch to $C(13,10)) to accommodate new TCH Report.
+20 ;S X=$L(BIPROF,$C(13))
+21 ;F I=1:1:X S ^BIP(BIDFN,1,I,0)=$P(BIPROF,$C(13),I)
+22 ;N X S X=$L(BIPROF,$C(13,10))
+23 ;F I=1:1:X S ^BIP(BIDFN,1,I,0)=$P(BIPROF,$C(13,10),I)
+24 NEW X
SET X=$LENGTH(BIPROF,"|||")
+25 ;
+26 ;
+27 ;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
+28 ;---> Insert patient name and DOB at top of Report Text (for EHR).
+29 ;F I=1:1:X S ^BIP(BIDFN,1,I,0)=$P(BIPROF,"|||",I)
+30 SET ^BIP(BIDFN,1,1,0)=" "
+31 SET ^BIP(BIDFN,1,2,0)="Patient: "_$$NAME^BIUTL1(BIDFN)_" DOB: "_$$DOBF^BIUTL1(BIDFN,$GET(BIFDT))
+32 SET ^BIP(BIDFN,1,3,0)=" "
+33 FOR I=1:1:X
SET ^BIP(BIDFN,1,(I+3),0)=$PIECE(BIPROF,"|||",I)
+34 ;**********
+35 ;
+36 SET ^BIP(BIDFN,1,0)=U_U_X_U_X_U_DT
+37 QUIT
+38 ;
+39 ;
+40 ;----------
BIDE(BIDE) ;EP
+1 ;---> Set Data Elements for TCH Format.
+2 ;---> (Old v7.x: 6=Dose#, 23=Date of Visit, 25=HL7 Code.)
+3 ;---> 25=CVX Code, 65=Dose Override, 88=TCH Date of Visit.
+4 KILL BIDE
+5 ;
+6 ;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR
+7 ;---> Pull TCH date format instead of Immserve.
+8 ;N I F I=23,25,65 S BIDE(I)=""
+9 NEW I
FOR I=25,65,88
SET BIDE(I)=""
+10 ;**********
+11 QUIT
+12 ;
+13 ;
+14 ;----------
UNLOCK(BIDFN) ;EP
+1 ;---> Unlock BI PATIENT global for this patient.
+2 ;---> Parameters:
+3 ; 1 - BIDFN (req) Patient DFN to unlock.
+4 ;
+5 IF '$GET(BIDFN)
QUIT
+6 LOCK -^BIP(BIDFN)
+7 QUIT
+8 ;
+9 ;
+10 ;----------
NOFORC(BINF) ;EP
+1 ;---> Build local array of Vaccines Group IEN's that Site has
+2 ;---> specified should not be forecast.
+3 ;---> Parameters:
+4 ; 1 - BINF (ret) Array of Vaccine Group IEN's that should not be forecast.
+5 ;
+6 NEW N
SET N=0
+7 FOR
SET N=$ORDER(^BISERT(N))
IF 'N
QUIT
Begin DoDot:1
+8 IF '$PIECE(^BISERT(N,0),U,5)
SET BINF(N)=""
End DoDot:1
+9 QUIT
+10 ;
+11 ;
DISPLAY ;EP
+1 ;---> Display Input and Output Data Strings.
+2 ;---> Uncomment any of the next lines to see History or ImmServe data:
+3 ;W !!,"BIHX Out: ",BIHX R ZZZ
+4 ;W !!,"BIFORC Full: ",BIFORC R ZZZ
+5 ;
+6 Begin DoDot:1
+7 WRITE #!," RPMS INPUT String, Patient Data: "
+8 WRITE !," ",$PIECE(BIHX,"~~~",1)
+9 ;
+10 WRITE !!," RPMS INPUT String, Dose History Input doses: "
+11 NEW BIDOSE,BIDOSES,I
SET BIDOSES=$PIECE(BIHX,"~~~",2)
+12 FOR I=1:1
SET BIDOSE=$PIECE(BIDOSES,"|||",I)
IF (BIDOSE="")
QUIT
WRITE !," ",BIDOSE
End DoDot:1
READ ZZZ:600
+13 ;
+14 Begin DoDot:1
+15 WRITE !!!," TCH OUTPUT String, Input doses: "
+16 NEW BIDOSE,BIDOSES,I
SET BIDOSES=$PIECE(BIFORC,"~~~",2)
+17 FOR I=1:1
SET BIDOSE=$PIECE(BIDOSES,"|||",I)
IF (BIDOSE="")
QUIT
WRITE !," ",BIDOSE
End DoDot:1
READ ZZZ:600
+18 ;
+19 Begin DoDot:1
+20 WRITE !!!," TCH OUTPUT String, Doses Due: "
+21 NEW BIDOSE,BIDOSES,I
SET BIDOSES=$PIECE(BIFORC,"~~~",3)
+22 FOR I=1:1
SET BIDOSE=$PIECE(BIDOSES,"|||",I)
IF (BIDOSE="")
QUIT
WRITE !," ",BIDOSE
End DoDot:1
READ ZZZ:600
+23 ;
+24 QUIT
