BILETPR1 ;IHS/CMI/MWR - PRINT PATIENT LETTERS.; DEC 15, 2011
;;8.5;IMMUNIZATION;**14**;AUG 01,2017
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; BUILD ^TMP WP ARRAY FOR PRINTING LETTERS.
;; PATCH 10: If no skin tests on record, display explicitly. HISTORY1+190
;; Display only the most recent three dates of Skin Tests. HISTORY1+209
;; PATCH 14: Remove "NOS" from forecasted vaccines in letters. FORECAST+41
;
;
;----------
BUILD(BIDFN,BILET,BIDLOC,BIFDT) ;EP
;---> Build temporary global of populated letter in ^TMP("BILET",$J).
;---> Parameters:
; 1 - BIDFN (req) Patient's IEN in VA PATIENT File #2.
; 2 - BILET (req) IEN of Letter in BI LETTER File.
; 3 - BIDLOC (opt) Text of Date/Location line.
; 4 - BIFDT (opt) Forecast Date.
;
K ^TMP("BILET",$J)
N BILINE,BI31 S BILINE=0,BI31=$C(31)_$C(31)
;
;---> Error check.
N BIERR S BIERR=""
D I BIERR]"" D WRITE(.BILINE,BIERR) Q
.I '$G(BIDFN) D ERRCD^BIUTL2(201,.BIERR) Q
.I '$D(^DPT(BIDFN,0)) D ERRCD^BIUTL2(203,.BIERR) Q
.I '$G(BILET) D ERRCD^BIUTL2(609,.BIERR) Q
.I '$D(^BILET(BILET,0)) D ERRCD^BIUTL2(610,.BIERR) Q
.S:'$G(BIFDT) BIFDT=DT
;
;---> Get forecast string (BIFORCST) and problem dose string (BIPDSS).
;---> Pass BIPDSS to HISTORY to mark problem doses with asterisks.
;---> Pass BIFORCST to FORECAST for display.
N BIFORCST,BIPDSS S BIPDSS=""
D IMMFORC^BIRPC(.BIFORCST,BIDFN,BIFDT,,$G(BIDUZ2),.BIPDSS)
;---> If Forecast comes first, set BIFF=1
N BIFF S BIFF=$P(^BILET(BILET,0),U,6)
;
;---> Retrieve and store sections of letter in WP ^TMP global.
D SECTION(BILET,.BILINE,1)
D
.I BIFF D FORECAST(BILET,.BILINE,BIFORCST,BIFDT) Q
.D HISTORY(BILET,.BILINE,BIDFN,BIPDSS)
D SECTION(BILET,.BILINE,2)
D
.I BIFF D HISTORY(BILET,.BILINE,BIDFN,BIPDSS) Q
.D FORECAST(BILET,.BILINE,BIFORCST,BIFDT)
D SECTION(BILET,.BILINE,3)
D DATELOC(BILET,.BILINE,BIDLOC)
D SECTION(BILET,.BILINE,4)
Q
;
;
;----------
SECTION(BILET,BILINE,BISEC) ;EP
;---> Store Section of letter in ^TMP("BILET",$J).
;---> Parameters:
; 1 - BILET (req) IEN of Letter in BI LETTER File.
; 2 - BILINE (ret) Last line written into ^TMP array.
; 3 - BISEC (req) Section of Form Letter to retrieve.
;
N N S N=0
F S N=$O(^BILET(BILET,BISEC,N)) Q:'N D
.D WRITE(.BILINE,^BILET(BILET,BISEC,N,0))
Q
;
;
;----------
HISTORY(BILET,BILINE,BIDFN,BIPDSS) ;EP
;---> Retrieve and store Imm History in WP ^TMP global.
;---> Parameters:
; 1 - BILET (req) IEN of Letter in BI LETTER File.
; 2 - BILINE (ret) Last line written into ^TMP array.
; 3 - BIDFN (req) Patient's IEN in VA PATIENT File #2.
; 4 - BIPDSS (opt) Returned string of Visit IEN's that are Problem Doses,
;
;---> Quit if this Form Letter does not included Imm History.
N BIFORM S BIFORM=$P(^BILET(BILET,0),U,2)
N BINVAL S BINVAL=+$P(^BILET(BILET,0),U,5)
Q:'BIFORM
;
;---> If History should be listed by Date, BIFORM=1 or 2;
;---> If History should be listed by Vaccine, BIFORM=3 or 4.
D WRITE(.BILINE)
D HISTORY1(.BILINE,BIDFN,BIFORM,BINVAL,"BILET",BIPDSS)
D WRITE(.BILINE)
D CONTRAS(.BILINE,BIDFN,"BILET")
D WRITE(.BILINE)
Q
;
;
;----------
HISTORY1(BILINE,BIDFN,BIFORM,BINVAL,BIGBL,BIPDSS,BIHDRS,BINOSK,BILOC,BIMMRF,BIMMLF) ;EP
;---> Retrieve and store Imm History in WP ^TMP global.
;---> Parameters:
; 1 - BILINE (ret) Last line written into ^TMP array.
; 2 - BIDFN (req) Patient's IEN in VA PATIENT File #2.
; 3 - BIFORM (opt) 1=List by Date (default), 2=by Date w/Lot#,
; 3=List by Vaccine, 4=by Vaccine w/Lot#,
; 5=by Date w/VFC, 6=by Vaccine w/VFC
; 7=by Date w/Lot & VFC, 8=by Vaccine w/Lot & VFC.
; 4 - BINVAL (opt) 0=Include Invalid Doses, 1=Exclude Invalid Doses.
; 5 - BIGBL (opt) ^TMP global node to write to (def="BILET").
; 6 - BIPDSS (opt) Returned string of Visit IEN's that are
; Problem Doses, according to ImmServe.
; 7 - BIHDRS (opt) 0=Print Imm and Skin Subheaders; 1=No Subeaders.
; 8 - BINOSK (opt) 0=Include Skin Tests, 1=Do not include Skin Tests
; 2=Include Skin Tests ONLY (NO Immunizations).
; 9 - BILOC (opt) 1=Add Location in the form: [4-char] for BIFORM 1&2.
; 10 - BIMMRF (opt) Imms Received Filter array (subscript=CVX's included).
; 11 - BIMMLF (opt) Lot Number Filter array (subscript=lot number text).
;
S:$G(BIGBL)="" BIGBL="BILET"
S:$G(BIFORM)="" BIFORM=1 S:$G(BINVAL)="" BINVAL=0
;
;---> RPC to gather Imm Hx.
; BIRETVAL - Return value of valid data from RPC.
; BIRETERR - Return value (text string) of error from RPC.
;
N BIDE,BIRETVAL,BIRETERR,I S BIRETVAL=""
;
;---> Set BIDE local array for Data Elements to be returned.
;---> The following are IEN's in ^BIEXPDD(.
;---> IEN PC DATA
;---> --- -- ----
;---> 1 = Visit Type: "I"=Immunization, "S"=Skin Test.
;---> 4 2 = Vaccine Name, Short.
;---> 8 3 = Vaccine Components. ;v8.0
;---> 24 4 = IEN, V File Visit.
;---> 26 5 = Location (or Outside Location) where Imm was given.
;---> 27 6 = Vaccine Group.
;---> 33 7 = Vaccine Lot#, Text.
;---> 38 8 = Skin Test Result.
;---> 39 9 = Skin Test Reading.
;---> 41 10 = Skin Test Name.
;---> 44 11 = Reaction to Imm, text.
;---> 56 12 = Date of Visit Fileman format (YYYMMDD).
;---> 65 13 = Dose Override.
;---> 69 14 = Vaccine Component CVX Code.
;---> 77 15 = VFC for this immunization.
;
;
F I=4,8,24,26,27,33,38,39,41,44,56,65,69,77 S BIDE(I)=""
D IMMHX^BIRPC(.BIRETVAL,BIDFN,.BIDE,1,0)
;
;---> If BIRETERR has a value, store it and quit.
S BIRETERR=$P(BIRETVAL,BI31,2)
I BIRETERR]"" D Q
.D WRITE(.BILINE," "_BIRETERR,BIGBL)
.D WRITE(.BILINE,,BIGBL)
;
;---> Set BIHX=to a valid Imm Hx for this patient.
N BIHX S BIHX=$P(BIRETVAL,BI31,1)
;
;---> Build Listmanager array from BIHX string.
;
;---> List Immunization (and Skin Test) History by Vaccine, and quit.
I (BIFORM=3)!(BIFORM=4) D HISTORY2^BILETPR3(.BILINE,BIHX,BIDFN,BIFORM,BINVAL,BIPDSS) Q
;
D:$G(BINOSK)'=2 WRITE(.BILINE,,BIGBL)
;
N BIAR,I,V,Y S V="|"
;
;---> List Imm Hx by Date (if call is not for Skin Test ONLY).
;---> Loop through "^"-pieces of Imm History, getting data.
I $G(BINOSK)'=2 F I=1:1 S Y=$P(BIHX,U,I) Q:Y="" D
.;---> Quit if this is not an Immunization.
.Q:$P(Y,V)'="I"
.;
.;---> Set BIPD=1 if Immserve has a problem with this dose.
.N BIPD S BIPD=$$PDSS^BIUTL8($P(Y,V,4),$P(Y,V,14),$G(BIPDSS))
.;
.;---> Quit if not displaying Invalid Doses (but will display a Forced Valid).
.;Q:((BINVAL=1)&(($P(Y,V,13)&($P(Y,V,13)'=9))!BIPD))
.;
.;---> Do not display if this vaccine is not in the display filter array.
.I $D(BIMMRF) Q:('$D(BIMMRF(+$P(Y,V,14))))
.;
.;---> Do not display if this lot number is not in the display filter array.
.I $D(BIMMLF) Q:('$D(BIMMLF(+$P(Y,V,7))))
.;
.;---> Set Vaccine Name.
.N X S X=$P(Y,V,2)
.;
.;---> Tack on Lot# if specified.
.N BILOT S BILOT=$P(Y,V,7)
.S:((BIFORM=2)&(BILOT]"")) X=X_" (#"_BILOT_")"
.;
.;---> Tack on VFC if specified.
.N BIVFC S BIVFC=$P(Y,V,15)
.S:((BIFORM=5)&(BIVFC>1)) X=X_" (VFC+)"
.;
.;---> Tack on Lot# & VFC if specified.
.I BIFORM=7 D
..I (BILOT="")&(BIVFC<2) Q
..S X=X_" ("
..I BILOT]"" S X=X_"#"_BILOT
..I (BILOT]"")&(BIVFC>1) S X=X_", "
..I BIVFC>1 S X=X_"VFC+"
..S X=X_")"
.;
.;---> Tack on Location if specified.
.S:$G(BILOC) X=X_" ["_$E($P(Y,V,5),1,4)_"]"
.;
.;---> If this Dose has a User Override or is an ImmServe Problem Dose,
.;---> prepend an asterisk and tack the reason on the end.
.D
..I $P(Y,V,13) D Q
...;---> But don't display text "Force Valid" ($P(Y,V,13)'=9).
...S X="*"_X
...;---> Next line would display Invalid Reason.
...;I $P(Y,V,13)'=9 S X=X_"-"_$$DOVER^BIUTL8($P(Y,V,13))_"-"
..;
..S:BIPD X="*"_X
..;---> Next line would display Immserve problem.
..;_"-INVALID--SEE IMMSERVE-"
.;
.;---> If there was a Reaction, tack it on.
.I $P(Y,V,11)]"" S X=X_" Reaction: "_$P(Y,V,11)
.;
.;---> Set this Immunization in the array:
.;---> BIAR(VisitDate,VaccineName,VisitIEN)=VaccineName (Lot#)--Problem Dose
.S BIAR($P(Y,V,12),$P(Y,V,2),$P(Y,V,4))=X
;
;---> Build Imm History lines for History Section of Form Letter.
N N S N=0
F S N=$O(BIAR(N)) Q:'N D
.N BIHXLN
.S BIHXLN=$$SLDT2^BIUTL5(N,1)_": "
.N I,M S M=0
.;---> Note: I and J below are counters for inserting ", ".
.F I=1:1 S M=$O(BIAR(N,M)) Q:M="" D
..N J,P S P=0
..F J=1:1 S P=$O(BIAR(N,M,P)) Q:'P D
...N X S X=BIAR(N,M,P)
...;---> If this line will be too long, write it and start a new line.
...I $L(BIHXLN_X)>70 D Q
....D WRITE(.BILINE," "_BIHXLN_",",BIGBL)
....S BIHXLN=" "_X
...S BIHXLN=BIHXLN_$S((I>1!(J>1)):", ",1:"")_X
.D:$O(BIAR(0)) WRITE(.BILINE," "_BIHXLN,BIGBL)
;
;---> If there are no previous immunizations and this call is NOT for
;---> Skin Tests ONLY, then store next line.
I '$O(BIAR(0)),$G(BINOSK)'=2 D
.D WRITE(.BILINE," No previous immunizations recorded.",BIGBL)
;
;---> Quit if NOT including Skin Tests.
Q:($G(BINOSK))=1
;
;---> SKIN TESTS
;---> PC DATA
;---> -- ----
;---> 1 = Visit Type: "I"=Immunization, "S"=Skin Test.
;---> 4 = V Skin Test File IEN.
;---> 5 = Location (or Outside Location) where Imm was given.
;---> 8 = Skin Test Result.
;---> 9 = Skin Test Reading.
;---> 10 = Skin Test Name.
;---> 12 = Date of Visit Fileman format (YYYMMDD).
;
;---> List Skin Test History by Date.
;---> Loop through "^"-pieces of Imm History, getting data.
K BIAR
F I=1:1 S Y=$P(BIHX,U,I) Q:Y="" D
.;---> Quit if this is not a Skin Test.
.Q:$P(Y,V)'="S"
.;---> Set display line for this Skin Test Name and Date.
.S X=$P(Y,V,10),X=$$PAD^BIUTL5(X,12)
.;
.D
..I $P(Y,V,8)]"" S X=X_$P(Y,V,8) Q
..I $P(Y,V,9) S X=X_$P(Y,V,9)_" mm" Q
..S X=X_"Not recorded"
.;
.;---> Set this Skin Test in the array:
.;---> BIAR(VisitDate,SkinTestName,VisitIEN)=Skin Test display line.
.S BIAR($P(Y,V,12),$P(Y,V,10),$P(Y,V,4))=X
;
;********** PATCH 10, v8.5, MAY 30,2015, IHS/CMI/MWR
;---> If no skin tests on record, display that explicitly.
;Q:'$D(BIAR)
I '$D(BIAR) D Q
.D WRITE(.BILINE)
.S X=" Skin Tests/PPD: None on record" D WRITE(.BILINE,X)
;**********
;
;---> Skin Test Header.
D:$G(BINOSK)'=2 WRITE(.BILINE,,BIGBL)
D:'$G(BIHDRS)
.;S X=" Skin Tests:"
.S X=" Recent Skin Tests:"
.D WRITE(.BILINE,X,BIGBL)
.S X=" -----------------------"
.D WRITE(.BILINE,X,BIGBL)
;
;---> Build Skin Test History lines for History Section of Form Letter.
;
;********** PATCH 10, v8.5, MAY 30,2015, IHS/CMI/MWR
;---> Display only the most recent three dates of Skin Tests.
;
N BIZTEMP
;
N N S N=0
F S N=$O(BIAR(N)) Q:'N D
.N BIDT
.S BIDT=$$SLDT2^BIUTL5(N,1)
.N I,M S M=0
.F I=1:1 S M=$O(BIAR(N,M)) Q:M="" D
..N P S P=0
..F S P=$O(BIAR(N,M,P)) Q:'P D
...N X S X=BIAR(N,M,P)
...S X=" "_$S(I=1:BIDT_": ",1:" ")_X
...;
...S BIZTEMP(N,M)=X
...;D WRITE(.BILINE,X,BIGBL)
;
N N S N=9999999
F I=1:1:4 S N=+$O(BIZTEMP(N),-1) Q:'N
F S N=$O(BIZTEMP(N)) Q:'N D
.N M S M=""
.F S M=$O(BIZTEMP(N,M)) Q:(M="") D
..D WRITE(.BILINE,BIZTEMP(N,M),BIGBL)
;**********
;
Q
;
;
;----------
CONTRAS(BILINE,BIDFN,BIGBL) ;EP
;---> Retrieve and store Contraindications in WP ^TMP global.
;---> Parameters:
; 1 - BILINE (ret) Last line written into ^TMP array.
; 2 - BIDFN (req) Patient's IEN in VA PATIENT File #2.
; 3 - BIGBL (opt) ^TMP global node to write to (def="BILET").
;
S:$G(BIGBL)="" BIGBL="BILET"
N BIRETVAL,BIRETERR,I S BIRETVAL=""
;
;---> RPC to retrieve Contraindications.
D CONTRAS^BIRPC5(.BIRETVAL,BIDFN)
;
;---> If BIRETERR has a value, display it and quit.
S BIRETERR=$P(BIRETVAL,BI31,2)
I BIRETERR]"" D Q
.D WRITE(.BILINE," "_BIRETERR,BIGBL)
.D WRITE(.BILINE,,BIGBL)
;
;---> Set BICONT=to a string of Contraindications for this patient.
N BICONT S BICONT=$P(BIRETVAL,BI31,1)
Q:BICONT=""
;
;---> Build Listmanager array from BICONT string.
;
N J S J=1
F I=1:1 S Y=$P(BICONT,U,I) Q:Y="" D
.;---> Build display line for this Contraindication.
.N V S V="|",X=" "
.S:J X=X_"* Contraindications:",J=0 S X=$$PAD^BIUTL5(X,28)
.;
.;---> Display "Vaccine: Date Reason"
.;---> Quit if Reason is a "Refusal." Also, if it's the first line of Contras
.;---> reset J so that "Contraindications:" header displays on the next one.
.I Y["Refusal" D Q
..I I=1 S J=1
.S X=X_$P(Y,V,2)_":",X=$$PAD^BIUTL5(X,40)_$P(Y,V,4)
.S X=$$PAD^BIUTL5(X,53)_$P(Y,V,3)
.;---> Set formatted Contraindication line and index in ^TMP.
.D WRITE(.BILINE,X,BIGBL)
Q
;
;
;----------
FORECAST(BILET,BILINE,BIFORCST,BIFDT) ;EP
;---> Calculate and store Forecast in WP ^TMP global.
;---> Parameters:
; 1 - BILET (req) IEN of Letter in BI LETTER File.
; 2 - BILINE (ret) Last line written into ^TMP array.
; 3 - BIFORCST (req) Raw forecast string back from call to IMMFORC^BIRPC.
; 4 - BIFDT (opt) Forecast Date.
;
;---> Quit if this Form Letter does not included a Forecast.
Q:'$P(^BILET(BILET,0),U,3)
;
;---> If Forecast Date not provided, set it equal to today.
S:'$G(BIFDT) BIFDT=DT
;
;---> RPC to gather Immunization History.
; BIFORCST - Return value of valid data from RPC.
; BIRETERR - Return value (text string) of error from RPC.
;
N BIRETERR S BIRETVAL=""
;
;---> If BIRETERR has a value, store it and quit.
S BIRETERR=$P(BIFORCST,BI31,2)
I BIRETERR]"" D Q
.D WRITE(.BILINE),WRITE(.BILINE," "_BIRETERR),WRITE(.BILINE)
;
;---> Set BIFORC=to the Immunization Forecast for this patient.
N BIFORC,I,V S V="|",BIFORC=$P(BIFORCST,BI31,1)
;
D WRITE(.BILINE)
;
;---> If Forecast Date is not Today, display Forecast Date in letter.
D:BIFDT'=DT
.;---> Set Forecast Date external form for letter text.
.N BIFDT1 S BIFDT1=$$TXDT1^BIUTL5(BIFDT)
.D WRITE(.BILINE," For "_BIFDT1_":")
;
;---> Loop through "^"-pieces of Imm Forecast, getting data.
F I=1:1 S Y=$P(BIFORC,U,I) Q:Y="" D
.;
.S Y=$P(Y,V) I +Y&($E(Y,2)="-") S Y=$E(Y,3,99)
.;
.;********** PATCH 14, v8.5, AUG 01,2017, IHS/CMI/MWR
.;---> Remove "NOS" from forecasted vaccines.
.I Y[",NOS" S Y=$P(Y,",NOS")_$P(Y,",NOS",2)
.;**********
.;
.D WRITE(.BILINE," "_$$STRIP^BIUTL5(.Y))
D WRITE(.BILINE)
Q
;
;
;----------
DATELOC(BILET,BILINE,BIDLOC) ;EP
D DATELOC^BILETPR2(BILET,.BILINE,BIDLOC)
Q
;
;
;----------
WRITE(BILINE,BIVAL,BIGBL) ;EP
D WRITE^BILETPR3(.BILINE,$G(BIVAL),$G(BIGBL))
Q
BILETPR1 ;IHS/CMI/MWR - PRINT PATIENT LETTERS.; DEC 15, 2011
+1 ;;8.5;IMMUNIZATION;**14**;AUG 01,2017
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; BUILD ^TMP WP ARRAY FOR PRINTING LETTERS.
+4 ;; PATCH 10: If no skin tests on record, display explicitly. HISTORY1+190
+5 ;; Display only the most recent three dates of Skin Tests. HISTORY1+209
+6 ;; PATCH 14: Remove "NOS" from forecasted vaccines in letters. FORECAST+41
+7 ;
+8 ;
+9 ;----------
BUILD(BIDFN,BILET,BIDLOC,BIFDT) ;EP
+1 ;---> Build temporary global of populated letter in ^TMP("BILET",$J).
+2 ;---> Parameters:
+3 ; 1 - BIDFN (req) Patient's IEN in VA PATIENT File #2.
+4 ; 2 - BILET (req) IEN of Letter in BI LETTER File.
+5 ; 3 - BIDLOC (opt) Text of Date/Location line.
+6 ; 4 - BIFDT (opt) Forecast Date.
+7 ;
+8 KILL ^TMP("BILET",$JOB)
+9 NEW BILINE,BI31
SET BILINE=0
SET BI31=$CHAR(31)_$CHAR(31)
+10 ;
+11 ;---> Error check.
+12 NEW BIERR
SET BIERR=""
+13 Begin DoDot:1
+14 IF '$GET(BIDFN)
DO ERRCD^BIUTL2(201,.BIERR)
QUIT
+15 IF '$DATA(^DPT(BIDFN,0))
DO ERRCD^BIUTL2(203,.BIERR)
QUIT
+16 IF '$GET(BILET)
DO ERRCD^BIUTL2(609,.BIERR)
QUIT
+17 IF '$DATA(^BILET(BILET,0))
DO ERRCD^BIUTL2(610,.BIERR)
QUIT
+18 IF '$GET(BIFDT)
SET BIFDT=DT
End DoDot:1
IF BIERR]""
DO WRITE(.BILINE,BIERR)
QUIT
+19 ;
+20 ;---> Get forecast string (BIFORCST) and problem dose string (BIPDSS).
+21 ;---> Pass BIPDSS to HISTORY to mark problem doses with asterisks.
+22 ;---> Pass BIFORCST to FORECAST for display.
+23 NEW BIFORCST,BIPDSS
SET BIPDSS=""
+24 DO IMMFORC^BIRPC(.BIFORCST,BIDFN,BIFDT,,$GET(BIDUZ2),.BIPDSS)
+25 ;---> If Forecast comes first, set BIFF=1
+26 NEW BIFF
SET BIFF=$PIECE(^BILET(BILET,0),U,6)
+27 ;
+28 ;---> Retrieve and store sections of letter in WP ^TMP global.
+29 DO SECTION(BILET,.BILINE,1)
+30 Begin DoDot:1
+31 IF BIFF
DO FORECAST(BILET,.BILINE,BIFORCST,BIFDT)
QUIT
+32 DO HISTORY(BILET,.BILINE,BIDFN,BIPDSS)
End DoDot:1
+33 DO SECTION(BILET,.BILINE,2)
+34 Begin DoDot:1
+35 IF BIFF
DO HISTORY(BILET,.BILINE,BIDFN,BIPDSS)
QUIT
+36 DO FORECAST(BILET,.BILINE,BIFORCST,BIFDT)
End DoDot:1
+37 DO SECTION(BILET,.BILINE,3)
+38 DO DATELOC(BILET,.BILINE,BIDLOC)
+39 DO SECTION(BILET,.BILINE,4)
+40 QUIT
+41 ;
+42 ;
+43 ;----------
SECTION(BILET,BILINE,BISEC) ;EP
+1 ;---> Store Section of letter in ^TMP("BILET",$J).
+2 ;---> Parameters:
+3 ; 1 - BILET (req) IEN of Letter in BI LETTER File.
+4 ; 2 - BILINE (ret) Last line written into ^TMP array.
+5 ; 3 - BISEC (req) Section of Form Letter to retrieve.
+6 ;
+7 NEW N
SET N=0
+8 FOR
SET N=$ORDER(^BILET(BILET,BISEC,N))
IF 'N
QUIT
Begin DoDot:1
+9 DO WRITE(.BILINE,^BILET(BILET,BISEC,N,0))
End DoDot:1
+10 QUIT
+11 ;
+12 ;
+13 ;----------
HISTORY(BILET,BILINE,BIDFN,BIPDSS) ;EP
+1 ;---> Retrieve and store Imm History in WP ^TMP global.
+2 ;---> Parameters:
+3 ; 1 - BILET (req) IEN of Letter in BI LETTER File.
+4 ; 2 - BILINE (ret) Last line written into ^TMP array.
+5 ; 3 - BIDFN (req) Patient's IEN in VA PATIENT File #2.
+6 ; 4 - BIPDSS (opt) Returned string of Visit IEN's that are Problem Doses,
+7 ;
+8 ;---> Quit if this Form Letter does not included Imm History.
+9 NEW BIFORM
SET BIFORM=$PIECE(^BILET(BILET,0),U,2)
+10 NEW BINVAL
SET BINVAL=+$PIECE(^BILET(BILET,0),U,5)
+11 IF 'BIFORM
QUIT
+12 ;
+13 ;---> If History should be listed by Date, BIFORM=1 or 2;
+14 ;---> If History should be listed by Vaccine, BIFORM=3 or 4.
+15 DO WRITE(.BILINE)
+16 DO HISTORY1(.BILINE,BIDFN,BIFORM,BINVAL,"BILET",BIPDSS)
+17 DO WRITE(.BILINE)
+18 DO CONTRAS(.BILINE,BIDFN,"BILET")
+19 DO WRITE(.BILINE)
+20 QUIT
+21 ;
+22 ;
+23 ;----------
HISTORY1(BILINE,BIDFN,BIFORM,BINVAL,BIGBL,BIPDSS,BIHDRS,BINOSK,BILOC,BIMMRF,BIMMLF) ;EP
+1 ;---> Retrieve and store Imm History in WP ^TMP global.
+2 ;---> Parameters:
+3 ; 1 - BILINE (ret) Last line written into ^TMP array.
+4 ; 2 - BIDFN (req) Patient's IEN in VA PATIENT File #2.
+5 ; 3 - BIFORM (opt) 1=List by Date (default), 2=by Date w/Lot#,
+6 ; 3=List by Vaccine, 4=by Vaccine w/Lot#,
+7 ; 5=by Date w/VFC, 6=by Vaccine w/VFC
+8 ; 7=by Date w/Lot & VFC, 8=by Vaccine w/Lot & VFC.
+9 ; 4 - BINVAL (opt) 0=Include Invalid Doses, 1=Exclude Invalid Doses.
+10 ; 5 - BIGBL (opt) ^TMP global node to write to (def="BILET").
+11 ; 6 - BIPDSS (opt) Returned string of Visit IEN's that are
+12 ; Problem Doses, according to ImmServe.
+13 ; 7 - BIHDRS (opt) 0=Print Imm and Skin Subheaders; 1=No Subeaders.
+14 ; 8 - BINOSK (opt) 0=Include Skin Tests, 1=Do not include Skin Tests
+15 ; 2=Include Skin Tests ONLY (NO Immunizations).
+16 ; 9 - BILOC (opt) 1=Add Location in the form: [4-char] for BIFORM 1&2.
+17 ; 10 - BIMMRF (opt) Imms Received Filter array (subscript=CVX's included).
+18 ; 11 - BIMMLF (opt) Lot Number Filter array (subscript=lot number text).
+19 ;
+20 IF $GET(BIGBL)=""
SET BIGBL="BILET"
+21 IF $GET(BIFORM)=""
SET BIFORM=1
IF $GET(BINVAL)=""
SET BINVAL=0
+22 ;
+23 ;---> RPC to gather Imm Hx.
+24 ; BIRETVAL - Return value of valid data from RPC.
+25 ; BIRETERR - Return value (text string) of error from RPC.
+26 ;
+27 NEW BIDE,BIRETVAL,BIRETERR,I
SET BIRETVAL=""
+28 ;
+29 ;---> Set BIDE local array for Data Elements to be returned.
+30 ;---> The following are IEN's in ^BIEXPDD(.
+31 ;---> IEN PC DATA
+32 ;---> --- -- ----
+33 ;---> 1 = Visit Type: "I"=Immunization, "S"=Skin Test.
+34 ;---> 4 2 = Vaccine Name, Short.
+35 ;---> 8 3 = Vaccine Components. ;v8.0
+36 ;---> 24 4 = IEN, V File Visit.
+37 ;---> 26 5 = Location (or Outside Location) where Imm was given.
+38 ;---> 27 6 = Vaccine Group.
+39 ;---> 33 7 = Vaccine Lot#, Text.
+40 ;---> 38 8 = Skin Test Result.
+41 ;---> 39 9 = Skin Test Reading.
+42 ;---> 41 10 = Skin Test Name.
+43 ;---> 44 11 = Reaction to Imm, text.
+44 ;---> 56 12 = Date of Visit Fileman format (YYYMMDD).
+45 ;---> 65 13 = Dose Override.
+46 ;---> 69 14 = Vaccine Component CVX Code.
+47 ;---> 77 15 = VFC for this immunization.
+48 ;
+49 ;
+50 FOR I=4,8,24,26,27,33,38,39,41,44,56,65,69,77
SET BIDE(I)=""
+51 DO IMMHX^BIRPC(.BIRETVAL,BIDFN,.BIDE,1,0)
+52 ;
+53 ;---> If BIRETERR has a value, store it and quit.
+54 SET BIRETERR=$PIECE(BIRETVAL,BI31,2)
+55 IF BIRETERR]""
Begin DoDot:1
+56 DO WRITE(.BILINE," "_BIRETERR,BIGBL)
+57 DO WRITE(.BILINE,,BIGBL)
End DoDot:1
QUIT
+58 ;
+59 ;---> Set BIHX=to a valid Imm Hx for this patient.
+60 NEW BIHX
SET BIHX=$PIECE(BIRETVAL,BI31,1)
+61 ;
+62 ;---> Build Listmanager array from BIHX string.
+63 ;
+64 ;---> List Immunization (and Skin Test) History by Vaccine, and quit.
+65 IF (BIFORM=3)!(BIFORM=4)
DO HISTORY2^BILETPR3(.BILINE,BIHX,BIDFN,BIFORM,BINVAL,BIPDSS)
QUIT
+66 ;
+67 IF $GET(BINOSK)'=2
DO WRITE(.BILINE,,BIGBL)
+68 ;
+69 NEW BIAR,I,V,Y
SET V="|"
+70 ;
+71 ;---> List Imm Hx by Date (if call is not for Skin Test ONLY).
+72 ;---> Loop through "^"-pieces of Imm History, getting data.
+73 IF $GET(BINOSK)'=2
FOR I=1:1
SET Y=$PIECE(BIHX,U,I)
IF Y=""
QUIT
Begin DoDot:1
+74 ;---> Quit if this is not an Immunization.
+75 IF $PIECE(Y,V)'="I"
QUIT
+76 ;
+77 ;---> Set BIPD=1 if Immserve has a problem with this dose.
+78 NEW BIPD
SET BIPD=$$PDSS^BIUTL8($PIECE(Y,V,4),$PIECE(Y,V,14),$GET(BIPDSS))
+79 ;
+80 ;---> Quit if not displaying Invalid Doses (but will display a Forced Valid).
+81 ;Q:((BINVAL=1)&(($P(Y,V,13)&($P(Y,V,13)'=9))!BIPD))
+82 ;
+83 ;---> Do not display if this vaccine is not in the display filter array.
+84 IF $DATA(BIMMRF)
IF ('$DATA(BIMMRF(+$PIECE(Y,V,14))))
QUIT
+85 ;
+86 ;---> Do not display if this lot number is not in the display filter array.
+87 IF $DATA(BIMMLF)
IF ('$DATA(BIMMLF(+$PIECE(Y,V,7))))
QUIT
+88 ;
+89 ;---> Set Vaccine Name.
+90 NEW X
SET X=$PIECE(Y,V,2)
+91 ;
+92 ;---> Tack on Lot# if specified.
+93 NEW BILOT
SET BILOT=$PIECE(Y,V,7)
+94 IF ((BIFORM=2)&(BILOT]""))
SET X=X_" (#"_BILOT_")"
+95 ;
+96 ;---> Tack on VFC if specified.
+97 NEW BIVFC
SET BIVFC=$PIECE(Y,V,15)
+98 IF ((BIFORM=5)&(BIVFC>1))
SET X=X_" (VFC+)"
+99 ;
+100 ;---> Tack on Lot# & VFC if specified.
+101 IF BIFORM=7
Begin DoDot:2
+102 IF (BILOT="")&(BIVFC<2)
QUIT
+103 SET X=X_" ("
+104 IF BILOT]""
SET X=X_"#"_BILOT
+105 IF (BILOT]"")&(BIVFC>1)
SET X=X_", "
+106 IF BIVFC>1
SET X=X_"VFC+"
+107 SET X=X_")"
End DoDot:2
+108 ;
+109 ;---> Tack on Location if specified.
+110 IF $GET(BILOC)
SET X=X_" ["_$EXTRACT($PIECE(Y,V,5),1,4)_"]"
+111 ;
+112 ;---> If this Dose has a User Override or is an ImmServe Problem Dose,
+113 ;---> prepend an asterisk and tack the reason on the end.
+114 Begin DoDot:2
+115 IF $PIECE(Y,V,13)
Begin DoDot:3
+116 ;---> But don't display text "Force Valid" ($P(Y,V,13)'=9).
+117 SET X="*"_X
+118 ;---> Next line would display Invalid Reason.
+119 ;I $P(Y,V,13)'=9 S X=X_"-"_$$DOVER^BIUTL8($P(Y,V,13))_"-"
End DoDot:3
QUIT
+120 ;
+121 IF BIPD
SET X="*"_X
+122 ;---> Next line would display Immserve problem.
+123 ;_"-INVALID--SEE IMMSERVE-"
End DoDot:2
+124 ;
+125 ;---> If there was a Reaction, tack it on.
+126 IF $PIECE(Y,V,11)]""
SET X=X_" Reaction: "_$PIECE(Y,V,11)
+127 ;
+128 ;---> Set this Immunization in the array:
+129 ;---> BIAR(VisitDate,VaccineName,VisitIEN)=VaccineName (Lot#)--Problem Dose
+130 SET BIAR($PIECE(Y,V,12),$PIECE(Y,V,2),$PIECE(Y,V,4))=X
End DoDot:1
+131 ;
+132 ;---> Build Imm History lines for History Section of Form Letter.
+133 NEW N
SET N=0
+134 FOR
SET N=$ORDER(BIAR(N))
IF 'N
QUIT
Begin DoDot:1
+135 NEW BIHXLN
+136 SET BIHXLN=$$SLDT2^BIUTL5(N,1)_": "
+137 NEW I,M
SET M=0
+138 ;---> Note: I and J below are counters for inserting ", ".
+139 FOR I=1:1
SET M=$ORDER(BIAR(N,M))
IF M=""
QUIT
Begin DoDot:2
+140 NEW J,P
SET P=0
+141 FOR J=1:1
SET P=$ORDER(BIAR(N,M,P))
IF 'P
QUIT
Begin DoDot:3
+142 NEW X
SET X=BIAR(N,M,P)
+143 ;---> If this line will be too long, write it and start a new line.
+144 IF $LENGTH(BIHXLN_X)>70
Begin DoDot:4
+145 DO WRITE(.BILINE," "_BIHXLN_",",BIGBL)
+146 SET BIHXLN=" "_X
End DoDot:4
QUIT
+147 SET BIHXLN=BIHXLN_$SELECT((I>1!(J>1)):", ",1:"")_X
End DoDot:3
End DoDot:2
+148 IF $ORDER(BIAR(0))
DO WRITE(.BILINE," "_BIHXLN,BIGBL)
End DoDot:1
+149 ;
+150 ;---> If there are no previous immunizations and this call is NOT for
+151 ;---> Skin Tests ONLY, then store next line.
+152 IF '$ORDER(BIAR(0))
IF $GET(BINOSK)'=2
Begin DoDot:1
+153 DO WRITE(.BILINE," No previous immunizations recorded.",BIGBL)
End DoDot:1
+154 ;
+155 ;---> Quit if NOT including Skin Tests.
+156 IF ($GET(BINOSK))=1
QUIT
+157 ;
+158 ;---> SKIN TESTS
+159 ;---> PC DATA
+160 ;---> -- ----
+161 ;---> 1 = Visit Type: "I"=Immunization, "S"=Skin Test.
+162 ;---> 4 = V Skin Test File IEN.
+163 ;---> 5 = Location (or Outside Location) where Imm was given.
+164 ;---> 8 = Skin Test Result.
+165 ;---> 9 = Skin Test Reading.
+166 ;---> 10 = Skin Test Name.
+167 ;---> 12 = Date of Visit Fileman format (YYYMMDD).
+168 ;
+169 ;---> List Skin Test History by Date.
+170 ;---> Loop through "^"-pieces of Imm History, getting data.
+171 KILL BIAR
+172 FOR I=1:1
SET Y=$PIECE(BIHX,U,I)
IF Y=""
QUIT
Begin DoDot:1
+173 ;---> Quit if this is not a Skin Test.
+174 IF $PIECE(Y,V)'="S"
QUIT
+175 ;---> Set display line for this Skin Test Name and Date.
+176 SET X=$PIECE(Y,V,10)
SET X=$$PAD^BIUTL5(X,12)
+177 ;
+178 Begin DoDot:2
+179 IF $PIECE(Y,V,8)]""
SET X=X_$PIECE(Y,V,8)
QUIT
+180 IF $PIECE(Y,V,9)
SET X=X_$PIECE(Y,V,9)_" mm"
QUIT
+181 SET X=X_"Not recorded"
End DoDot:2
+182 ;
+183 ;---> Set this Skin Test in the array:
+184 ;---> BIAR(VisitDate,SkinTestName,VisitIEN)=Skin Test display line.
+185 SET BIAR($PIECE(Y,V,12),$PIECE(Y,V,10),$PIECE(Y,V,4))=X
End DoDot:1
+186 ;
+187 ;********** PATCH 10, v8.5, MAY 30,2015, IHS/CMI/MWR
+188 ;---> If no skin tests on record, display that explicitly.
+189 ;Q:'$D(BIAR)
+190 IF '$DATA(BIAR)
Begin DoDot:1
+191 DO WRITE(.BILINE)
+192 SET X=" Skin Tests/PPD: None on record"
DO WRITE(.BILINE,X)
End DoDot:1
QUIT
+193 ;**********
+194 ;
+195 ;---> Skin Test Header.
+196 IF $GET(BINOSK)'=2
DO WRITE(.BILINE,,BIGBL)
+197 IF '$GET(BIHDRS)
Begin DoDot:1
+198 ;S X=" Skin Tests:"
+199 SET X=" Recent Skin Tests:"
+200 DO WRITE(.BILINE,X,BIGBL)
+201 SET X=" -----------------------"
+202 DO WRITE(.BILINE,X,BIGBL)
End DoDot:1
+203 ;
+204 ;---> Build Skin Test History lines for History Section of Form Letter.
+205 ;
+206 ;********** PATCH 10, v8.5, MAY 30,2015, IHS/CMI/MWR
+207 ;---> Display only the most recent three dates of Skin Tests.
+208 ;
+209 NEW BIZTEMP
+210 ;
+211 NEW N
SET N=0
+212 FOR
SET N=$ORDER(BIAR(N))
IF 'N
QUIT
Begin DoDot:1
+213 NEW BIDT
+214 SET BIDT=$$SLDT2^BIUTL5(N,1)
+215 NEW I,M
SET M=0
+216 FOR I=1:1
SET M=$ORDER(BIAR(N,M))
IF M=""
QUIT
Begin DoDot:2
+217 NEW P
SET P=0
+218 FOR
SET P=$ORDER(BIAR(N,M,P))
IF 'P
QUIT
Begin DoDot:3
+219 NEW X
SET X=BIAR(N,M,P)
+220 SET X=" "_$SELECT(I=1:BIDT_": ",1:" ")_X
+221 ;
+222 SET BIZTEMP(N,M)=X
+223 ;D WRITE(.BILINE,X,BIGBL)
End DoDot:3
End DoDot:2
End DoDot:1
+224 ;
+225 NEW N
SET N=9999999
+226 FOR I=1:1:4
SET N=+$ORDER(BIZTEMP(N),-1)
IF 'N
QUIT
+227 FOR
SET N=$ORDER(BIZTEMP(N))
IF 'N
QUIT
Begin DoDot:1
+228 NEW M
SET M=""
+229 FOR
SET M=$ORDER(BIZTEMP(N,M))
IF (M="")
QUIT
Begin DoDot:2
+230 DO WRITE(.BILINE,BIZTEMP(N,M),BIGBL)
End DoDot:2
End DoDot:1
+231 ;**********
+232 ;
+233 QUIT
+234 ;
+235 ;
+236 ;----------
CONTRAS(BILINE,BIDFN,BIGBL) ;EP
+1 ;---> Retrieve and store Contraindications in WP ^TMP global.
+2 ;---> Parameters:
+3 ; 1 - BILINE (ret) Last line written into ^TMP array.
+4 ; 2 - BIDFN (req) Patient's IEN in VA PATIENT File #2.
+5 ; 3 - BIGBL (opt) ^TMP global node to write to (def="BILET").
+6 ;
+7 IF $GET(BIGBL)=""
SET BIGBL="BILET"
+8 NEW BIRETVAL,BIRETERR,I
SET BIRETVAL=""
+9 ;
+10 ;---> RPC to retrieve Contraindications.
+11 DO CONTRAS^BIRPC5(.BIRETVAL,BIDFN)
+12 ;
+13 ;---> If BIRETERR has a value, display it and quit.
+14 SET BIRETERR=$PIECE(BIRETVAL,BI31,2)
+15 IF BIRETERR]""
Begin DoDot:1
+16 DO WRITE(.BILINE," "_BIRETERR,BIGBL)
+17 DO WRITE(.BILINE,,BIGBL)
End DoDot:1
QUIT
+18 ;
+19 ;---> Set BICONT=to a string of Contraindications for this patient.
+20 NEW BICONT
SET BICONT=$PIECE(BIRETVAL,BI31,1)
+21 IF BICONT=""
QUIT
+22 ;
+23 ;---> Build Listmanager array from BICONT string.
+24 ;
+25 NEW J
SET J=1
+26 FOR I=1:1
SET Y=$PIECE(BICONT,U,I)
IF Y=""
QUIT
Begin DoDot:1
+27 ;---> Build display line for this Contraindication.
+28 NEW V
SET V="|"
SET X=" "
+29 IF J
SET X=X_"* Contraindications:"
SET J=0
SET X=$$PAD^BIUTL5(X,28)
+30 ;
+31 ;---> Display "Vaccine: Date Reason"
+32 ;---> Quit if Reason is a "Refusal." Also, if it's the first line of Contras
+33 ;---> reset J so that "Contraindications:" header displays on the next one.
+34 IF Y["Refusal"
Begin DoDot:2
+35 IF I=1
SET J=1
End DoDot:2
QUIT
+36 SET X=X_$PIECE(Y,V,2)_":"
SET X=$$PAD^BIUTL5(X,40)_$PIECE(Y,V,4)
+37 SET X=$$PAD^BIUTL5(X,53)_$PIECE(Y,V,3)
+38 ;---> Set formatted Contraindication line and index in ^TMP.
+39 DO WRITE(.BILINE,X,BIGBL)
End DoDot:1
+40 QUIT
+41 ;
+42 ;
+43 ;----------
FORECAST(BILET,BILINE,BIFORCST,BIFDT) ;EP
+1 ;---> Calculate and store Forecast in WP ^TMP global.
+2 ;---> Parameters:
+3 ; 1 - BILET (req) IEN of Letter in BI LETTER File.
+4 ; 2 - BILINE (ret) Last line written into ^TMP array.
+5 ; 3 - BIFORCST (req) Raw forecast string back from call to IMMFORC^BIRPC.
+6 ; 4 - BIFDT (opt) Forecast Date.
+7 ;
+8 ;---> Quit if this Form Letter does not included a Forecast.
+9 IF '$PIECE(^BILET(BILET,0),U,3)
QUIT
+10 ;
+11 ;---> If Forecast Date not provided, set it equal to today.
+12 IF '$GET(BIFDT)
SET BIFDT=DT
+13 ;
+14 ;---> RPC to gather Immunization History.
+15 ; BIFORCST - Return value of valid data from RPC.
+16 ; BIRETERR - Return value (text string) of error from RPC.
+17 ;
+18 NEW BIRETERR
SET BIRETVAL=""
+19 ;
+20 ;---> If BIRETERR has a value, store it and quit.
+21 SET BIRETERR=$PIECE(BIFORCST,BI31,2)
+22 IF BIRETERR]""
Begin DoDot:1
+23 DO WRITE(.BILINE)
DO WRITE(.BILINE," "_BIRETERR)
DO WRITE(.BILINE)
End DoDot:1
QUIT
+24 ;
+25 ;---> Set BIFORC=to the Immunization Forecast for this patient.
+26 NEW BIFORC,I,V
SET V="|"
SET BIFORC=$PIECE(BIFORCST,BI31,1)
+27 ;
+28 DO WRITE(.BILINE)
+29 ;
+30 ;---> If Forecast Date is not Today, display Forecast Date in letter.
+31 IF BIFDT'=DT
Begin DoDot:1
+32 ;---> Set Forecast Date external form for letter text.
+33 NEW BIFDT1
SET BIFDT1=$$TXDT1^BIUTL5(BIFDT)
+34 DO WRITE(.BILINE," For "_BIFDT1_":")
End DoDot:1
+35 ;
+36 ;---> Loop through "^"-pieces of Imm Forecast, getting data.
+37 FOR I=1:1
SET Y=$PIECE(BIFORC,U,I)
IF Y=""
QUIT
Begin DoDot:1
+38 ;
+39 SET Y=$PIECE(Y,V)
IF +Y&($EXTRACT(Y,2)="-")
SET Y=$EXTRACT(Y,3,99)
+40 ;
+41 ;********** PATCH 14, v8.5, AUG 01,2017, IHS/CMI/MWR
+42 ;---> Remove "NOS" from forecasted vaccines.
+43 IF Y[",NOS"
SET Y=$PIECE(Y,",NOS")_$PIECE(Y,",NOS",2)
+44 ;**********
+45 ;
+46 DO WRITE(.BILINE," "_$$STRIP^BIUTL5(.Y))
End DoDot:1
+47 DO WRITE(.BILINE)
+48 QUIT
+49 ;
+50 ;
+51 ;----------
DATELOC(BILET,BILINE,BIDLOC) ;EP
+1 DO DATELOC^BILETPR2(BILET,.BILINE,BIDLOC)
+2 QUIT
+3 ;
+4 ;
+5 ;----------
WRITE(BILINE,BIVAL,BIGBL) ;EP
+1 DO WRITE^BILETPR3(.BILINE,$GET(BIVAL),$GET(BIGBL))
+2 QUIT
