BIAPCHS ;IHS/CMI/MWR - PRODUCE IMMUNIZATION PATIENT RECORD FOR HEALTH SUMMARY.; MAY 10, 2010
;;8.5;IMMUNIZATION;**3**;SEP 10,2012
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; BUILD TEMP ARRAY TO PASS BACK TO APCHS2.
;; PATCH 3: Use Date of Event if it exists for Imm Hx. HISTORY+33,+81
;
;---> Call from IMMBI8^APCHS2: D IMMBI^BIAPCHS(APCHSPAT,.APCHSARR)
;
;----------
IMMBI(BIDFN,BIARRAY) ;EP
;---> Get patient's Immunization Data and write lines for display in
;---> Health Summary. Pass formatted lines back in BIARRAY.
;---> Called by APCHS2.
;---> Parameters:
; 1 - BIDFN (req) Patient's IEN in VA PATIENT File #2.
; 2 - BIARRAY (ret) Local array of formatted lines for Health Summary.
;
N BI31 S BI31=$C(31)_$C(31)
K ^TMP("BIHS",$J)
D GATHER($G(BIDFN))
D PASSARR(.BIARRAY)
K ^TMP("BIHS",$J)
Q
;
;
;----------
GATHER(BIDFN) ;EP
;---> Get patient's Immunization Data and write lines for display in
;---> Health Summary. Store lines in ^TMP("BIHS",$J...).
;---> Called by APCHS2.
;---> Parameters:
; 1 - BIDFN (req) Patient's IEN in VA PATIENT File #2.
;
N BILINE S BILINE=0
;
;---> Error check.
N BIERR,BIPDSS 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
.S:'$G(BIFDT) BIFDT=DT
;
;---> Retrieve and store sections of letter in WP ^TMP global.
D FORECAST(BIDFN,.BILINE,.BIPDSS)
D CONTRAS(BIDFN,.BILINE)
D HISTORY(BIDFN,.BILINE,BIPDSS)
Q
;
;
;----------
PASSARR(BIARRAY) ;EP
;---> Get patient's Immunization Health Summary formatted display lines from
;---> ^TMP("BIHS",$J) and populate BIARRAY to pass back to APCHS2.
;---> Parameters:
; 1 - BIARRAY (req) Local array receiving copy of HS formatted lines
; from ^TMP("BIHS",$J...)
N N S N=0
F S N=$O(^TMP("BIHS",$J,N)) Q:'N S BIARRAY(N,0)=^(N,0)
;
Q
;
;
;----------
FORECAST(BIDFN,BILINE,BIPDSS) ;EP
;---> Calculate and store Forecast in WP ^TMP global.
;---> Parameters:
; 1 - BIDFN (req) Patient's IEN in VA PATIENT File #2.
; 2 - BILINE (ret) Last line written into ^TMP array.
; 3 - BIPDSS (ret) Returned string of Visit IEN's that are
; Problem Doses, according to ImmServe.
;
;
N BIFORCST,BIERR S BIFORCST="",BIPDSS=""
;
;---> 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.
D IMMFORC^BIRPC(.BIFORCST,BIDFN,,,,.BIPDSS)
D WRITE(.BILINE," IMMUNIZATION FORECAST:",1)
;
;---> Check for error in 2nd piece of return value.
S BIERR=$P(BIFORCST,BI31,2)
;---> If there's an error, display it and quit.
I BIERR]"" D WRITE(.BILINE," *"_BIERR) Q
;
;---> No error, so take 1st piece of return value and process it.
S BIFORCST=$P(BIFORCST,BI31,1)
N I,X
F I=1:1 S X=$P(BIFORCST,U,I) Q:X="" D
.N Y S Y=" "_$$PAD($P(X,"|"),20)
.S Y=Y_$$PAD($P(X,"|",2),36)_$P(X,"|",3)
.D WRITE(.BILINE,Y)
D WRITE(.BILINE)
Q
;
;
;----------
CONTRAS(BIDFN,BILINE) ;EP
;---> Store Contraindications in ^TMP global.
;---> Parameters:
; 1 - BIDFN (req) Patient's IEN in VA PATIENT File #2.
; 2 - BILINE (ret) Last line written into ^TMP array.
;
N BIRETVAL S BIRETVAL=""
;---> RPC to retrieve Contraindications.
D CONTRAS^BIRPC5(.BIRETVAL,BIDFN)
;
;---> If BIERR has a value, display it and quit.
S BIERR=$P(BIRETVAL,BI31,2)
I BIERR]"" D WRITE(.BILINE," *"_BIERR) Q
;
;---> Set BIC=to a string of Contraindications for this patient.
N BIC S BIC=$P(BIRETVAL,BI31,1)
Q:BIC=""
;---> Build Health Summary array from BIC string.
N I,X
F I=1:1 S X=$P(BIC,U,I) Q:X="" D
.;---> Build display line for this Contraindication.
.N V,Y S V="|",Y=" "
.S:I=1 Y=Y_"* Contraindications:" S Y=$$PAD(Y,28)
.;
.;---> Display "Vaccine: Date Reason"
.S Y=Y_$P(X,V,2)_":",Y=$$PAD(Y,40)_$P(X,V,4)
.S Y=$$PAD(Y,53)_$P(X,V,3)
.;---> Set formatted Contraindication line and index in ^TMP.
.D WRITE(.BILINE,Y)
D WRITE(.BILINE)
Q
;
;
HISTORY(BIDFN,BILINE,BIPDSS) ;EP
;---> Retrieve Patient's Imm History and store in WP ^TMP global.
;---> Parameters:
; 1 - BIDFN (req) Patient's IEN in VA PATIENT File #2.
; 2 - BILINE (ret) Last line written into ^TMP array.
; 3 - BIPDSS (ret) Returned string of Visit IEN's that are
; Problem Doses, according to ImmServe.
;
;---> Next line: Change Data Elements called. ;Cimarron/Mike Remillard 7/30/03
;---> Use Date Element IEN 4 instead of 8. DE 8 used to contain Dose#-Short Name;
;---> now it contains vaccine components.
;---> Also add DE 24 V File IEN, and DE 65 is Dose Override.
;NEW BIDE,I F I=8,26,27,60,33,44,57 S BIDE(I)=""
;
;
;
;---> If BIDE local array (Data Elements to be returned) is not
;---> passed, then set the following default Data Elements.
;---> 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 (Series Type) for grouping of vaccines.
;---> 33 7 = Vaccine Lot#, Text.
;---> 44 8 = Reaction to Immunization, text.
;---> 57 9 = Age at Visit.
;---> 65 10 = Dose Override.
;---> 66 11 = Date of Visit (MM/DD/YY).
;---> 69 12 = Vaccine Component CVX Code.
;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR
;---> Add Date of Event to Hx string.
;---> 86 13 = Date of Event (1201 field of V File) in YYYMMDD
;
;
;N BIDE,I F I=4,8,24,26,27,33,44,57,65,66,69 S BIDE(I)=""
N BIDE,I F I=4,8,24,26,27,33,44,57,65,66,69,86 S BIDE(I)=""
;**********
;
;call to get imm hx
N BIERR,BIFORCST,BIRETVAL S BIRETVAL=""
D IMMHX^BIRPC(.BIRETVAL,BIDFN,.BIDE,1,0)
D WRITE(.BILINE," IMMUNIZATION HISTORY:")
;
;---> If there is an Invalid Dose or Reaction, append extra line feed.
;---> Use BILF as a line feed flag. ***NOT USED for now. CIM/MWR 8/4/03
N BILF S BILF=0
;
S BIERR=$P(BIRETVAL,BI31,2)
I BIERR]"" D WRITE(.BILINE," *"_BIERR) Q
;
S BIFORCST=$P(BIRETVAL,BI31,1)
N I,V,BIX,BIZ S BIZ="",V="|"
;
F I=1:1 S BIX=$P(BIFORCST,U,I) Q:BIX="" D
.Q:$P(BIX,V)'="I"
.;
.;---> Check if new vaccine group; if so, insert line feed.
.I $P(BIX,V,6)'=BIZ D
..S BIZ=$P(BIX,V,6)
..;---> If extra line feed was just sent due to Invalid/Reaction, don't here.
..D:'$G(BILF) WRITE(.BILINE)
.;---> Reset line feed flag to zero.
.S BILF=0
.;
.;---> Set flag for ImmServe Problem Dose, flag for asterisk.
.N BIAST,BIIMMS S BIAST=0,BIIMMS=0
.;---> Next line: Insert asterisk if Problem Dose ;Cimarron/Mike Remillard 7/30/03
.D
..;---> If there is a Dose Override, set asterisk flag (BIAST)=1.
..I $P(BIX,V,10) S BIAST=1 Q
..;---> If ImmServe considers this dose to be Invalid, insert asterisk.
..;---> Use BIPDSS (ImmServe problem dose string) from Forecast above.
..I $$PDSS^BIUTL8($P(BIX,V,4),$P(BIX,V,12),BIPDSS) S BIAST=1,BIIMMS=1
.;
.N Y S Y=""
.S Y=" "_$S($G(BIAST):"*",1:" ")_$P(BIX,V,2)
.;
.;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR
.;---> Display Date of Event if different from Date of Visit.
.;---> Also display Age at time of Event if different.
.;S Y=$$PAD(Y,27)_$P(BIX,V,11)
.;S Y=$$PAD(Y,37)_$P(BIX,V,9)
.N BIDT S BIDT=$P(BIX,V,13)
.S Y=$$PAD(Y,27)_$$SLDT2^BIUTL5(BIDT,1)
.S Y=$$PAD(Y,37)_$$AGEF^BIUTL1(BIDFN,BIDT)
.;**********
.;
.S Y=$$PAD(Y,45)_$E($P(BIX,V,5),1,20)
.S Y=$$PAD(Y,66)_$P(BIX,V,7)
.D WRITE(.BILINE,Y)
.;
.;---> If there was a Dose Override, display it here.
.D:$P(BIX,V,10)
..S Y=$$PAD(" ",27)_"-"_$$DOVER^BIUTL8($P(BIX,V,10))_"-"
..D WRITE(.BILINE,Y) ;S BILF=1
.;
.;---> If ImmServe considers this dose to be Invalid, display it here.
.;---> Use BIPDSS (ImmServe problem dose string) from Forecast above.
.D:$G(BIIMMS)
..S Y=$$PAD(" ",27)_"-INVALID--SEE IMMSERVE-"
..D WRITE(.BILINE,Y) ;S BILF=1
.;
.;---> If there was a Reaction, display it here.
.D:$P(BIX,V,8)]""
..S Y=$$PAD(" ",27)_"Reaction: "_$P(BIX,V,8)
..D WRITE(.BILINE,Y) ;S BILF=1
;
Q
;
;
;----------
PAD(D,L,C) ;EP
;---> Pad the length of data to a total of L characters
;---> by adding spaces to the end of the data.
; Example: S X=$$PAD("MIKE",7) X="MIKE " (Added 3 spaces.)
;---> Parameters:
; 1 - D (req) Data to be padded.
; 2 - L (req) Total length of resulting data.
; 3 - C (opt) Character to pad with (default=space).
;
Q:'$D(D) ""
S:'$G(L) L=$L(D)
S:$G(C)="" C=" "
Q $E(D_$$REPEAT^XLFSTR(C,L),1,L)
;
;
;----------
WRITE(BILINE,BIVAL,BIBLNK) ;EP
;---> Write lines to ^TMP (see documentation in ^BIW).
;---> Parameters:
; 1 - BILINE (ret) Last line# written.
; 2 - BIVAL (opt) Value/text of line (Null=blank line).
; 3 - BIBLNK (opt) Number of blank lines to add after line sent.
;
Q:'$D(BILINE)
D WL^BIW(.BILINE,"BIHS",$G(BIVAL),$G(BIBLNK))
Q
BIAPCHS ;IHS/CMI/MWR - PRODUCE IMMUNIZATION PATIENT RECORD FOR HEALTH SUMMARY.; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;**3**;SEP 10,2012
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; BUILD TEMP ARRAY TO PASS BACK TO APCHS2.
+4 ;; PATCH 3: Use Date of Event if it exists for Imm Hx. HISTORY+33,+81
+5 ;
+6 ;---> Call from IMMBI8^APCHS2: D IMMBI^BIAPCHS(APCHSPAT,.APCHSARR)
+7 ;
+8 ;----------
IMMBI(BIDFN,BIARRAY) ;EP
+1 ;---> Get patient's Immunization Data and write lines for display in
+2 ;---> Health Summary. Pass formatted lines back in BIARRAY.
+3 ;---> Called by APCHS2.
+4 ;---> Parameters:
+5 ; 1 - BIDFN (req) Patient's IEN in VA PATIENT File #2.
+6 ; 2 - BIARRAY (ret) Local array of formatted lines for Health Summary.
+7 ;
+8 NEW BI31
SET BI31=$CHAR(31)_$CHAR(31)
+9 KILL ^TMP("BIHS",$JOB)
+10 DO GATHER($GET(BIDFN))
+11 DO PASSARR(.BIARRAY)
+12 KILL ^TMP("BIHS",$JOB)
+13 QUIT
+14 ;
+15 ;
+16 ;----------
GATHER(BIDFN) ;EP
+1 ;---> Get patient's Immunization Data and write lines for display in
+2 ;---> Health Summary. Store lines in ^TMP("BIHS",$J...).
+3 ;---> Called by APCHS2.
+4 ;---> Parameters:
+5 ; 1 - BIDFN (req) Patient's IEN in VA PATIENT File #2.
+6 ;
+7 NEW BILINE
SET BILINE=0
+8 ;
+9 ;---> Error check.
+10 NEW BIERR,BIPDSS
SET BIERR=""
+11 Begin DoDot:1
+12 IF '$GET(BIDFN)
DO ERRCD^BIUTL2(201,.BIERR)
QUIT
+13 IF '$DATA(^DPT(BIDFN,0))
DO ERRCD^BIUTL2(203,.BIERR)
QUIT
+14 IF '$GET(BIFDT)
SET BIFDT=DT
End DoDot:1
IF BIERR]""
DO WRITE(.BILINE,BIERR)
QUIT
+15 ;
+16 ;---> Retrieve and store sections of letter in WP ^TMP global.
+17 DO FORECAST(BIDFN,.BILINE,.BIPDSS)
+18 DO CONTRAS(BIDFN,.BILINE)
+19 DO HISTORY(BIDFN,.BILINE,BIPDSS)
+20 QUIT
+21 ;
+22 ;
+23 ;----------
PASSARR(BIARRAY) ;EP
+1 ;---> Get patient's Immunization Health Summary formatted display lines from
+2 ;---> ^TMP("BIHS",$J) and populate BIARRAY to pass back to APCHS2.
+3 ;---> Parameters:
+4 ; 1 - BIARRAY (req) Local array receiving copy of HS formatted lines
+5 ; from ^TMP("BIHS",$J...)
+6 NEW N
SET N=0
+7 FOR
SET N=$ORDER(^TMP("BIHS",$JOB,N))
IF 'N
QUIT
SET BIARRAY(N,0)=^(N,0)
+8 ;
+9 QUIT
+10 ;
+11 ;
+12 ;----------
FORECAST(BIDFN,BILINE,BIPDSS) ;EP
+1 ;---> Calculate and store Forecast in WP ^TMP global.
+2 ;---> Parameters:
+3 ; 1 - BIDFN (req) Patient's IEN in VA PATIENT File #2.
+4 ; 2 - BILINE (ret) Last line written into ^TMP array.
+5 ; 3 - BIPDSS (ret) Returned string of Visit IEN's that are
+6 ; Problem Doses, according to ImmServe.
+7 ;
+8 ;
+9 NEW BIFORCST,BIERR
SET BIFORCST=""
SET BIPDSS=""
+10 ;
+11 ;---> Get forecast string (BIFORCST) and problem dose string (BIPDSS).
+12 ;---> Pass BIPDSS to HISTORY to mark problem doses with asterisks.
+13 ;---> Pass BIFORCST to FORECAST for display.
+14 DO IMMFORC^BIRPC(.BIFORCST,BIDFN,,,,.BIPDSS)
+15 DO WRITE(.BILINE," IMMUNIZATION FORECAST:",1)
+16 ;
+17 ;---> Check for error in 2nd piece of return value.
+18 SET BIERR=$PIECE(BIFORCST,BI31,2)
+19 ;---> If there's an error, display it and quit.
+20 IF BIERR]""
DO WRITE(.BILINE," *"_BIERR)
QUIT
+21 ;
+22 ;---> No error, so take 1st piece of return value and process it.
+23 SET BIFORCST=$PIECE(BIFORCST,BI31,1)
+24 NEW I,X
+25 FOR I=1:1
SET X=$PIECE(BIFORCST,U,I)
IF X=""
QUIT
Begin DoDot:1
+26 NEW Y
SET Y=" "_$$PAD($PIECE(X,"|"),20)
+27 SET Y=Y_$$PAD($PIECE(X,"|",2),36)_$PIECE(X,"|",3)
+28 DO WRITE(.BILINE,Y)
End DoDot:1
+29 DO WRITE(.BILINE)
+30 QUIT
+31 ;
+32 ;
+33 ;----------
CONTRAS(BIDFN,BILINE) ;EP
+1 ;---> Store Contraindications in ^TMP global.
+2 ;---> Parameters:
+3 ; 1 - BIDFN (req) Patient's IEN in VA PATIENT File #2.
+4 ; 2 - BILINE (ret) Last line written into ^TMP array.
+5 ;
+6 NEW BIRETVAL
SET BIRETVAL=""
+7 ;---> RPC to retrieve Contraindications.
+8 DO CONTRAS^BIRPC5(.BIRETVAL,BIDFN)
+9 ;
+10 ;---> If BIERR has a value, display it and quit.
+11 SET BIERR=$PIECE(BIRETVAL,BI31,2)
+12 IF BIERR]""
DO WRITE(.BILINE," *"_BIERR)
QUIT
+13 ;
+14 ;---> Set BIC=to a string of Contraindications for this patient.
+15 NEW BIC
SET BIC=$PIECE(BIRETVAL,BI31,1)
+16 IF BIC=""
QUIT
+17 ;---> Build Health Summary array from BIC string.
+18 NEW I,X
+19 FOR I=1:1
SET X=$PIECE(BIC,U,I)
IF X=""
QUIT
Begin DoDot:1
+20 ;---> Build display line for this Contraindication.
+21 NEW V,Y
SET V="|"
SET Y=" "
+22 IF I=1
SET Y=Y_"* Contraindications:"
SET Y=$$PAD(Y,28)
+23 ;
+24 ;---> Display "Vaccine: Date Reason"
+25 SET Y=Y_$PIECE(X,V,2)_":"
SET Y=$$PAD(Y,40)_$PIECE(X,V,4)
+26 SET Y=$$PAD(Y,53)_$PIECE(X,V,3)
+27 ;---> Set formatted Contraindication line and index in ^TMP.
+28 DO WRITE(.BILINE,Y)
End DoDot:1
+29 DO WRITE(.BILINE)
+30 QUIT
+31 ;
+32 ;
HISTORY(BIDFN,BILINE,BIPDSS) ;EP
+1 ;---> Retrieve Patient's Imm History and store in WP ^TMP global.
+2 ;---> Parameters:
+3 ; 1 - BIDFN (req) Patient's IEN in VA PATIENT File #2.
+4 ; 2 - BILINE (ret) Last line written into ^TMP array.
+5 ; 3 - BIPDSS (ret) Returned string of Visit IEN's that are
+6 ; Problem Doses, according to ImmServe.
+7 ;
+8 ;---> Next line: Change Data Elements called. ;Cimarron/Mike Remillard 7/30/03
+9 ;---> Use Date Element IEN 4 instead of 8. DE 8 used to contain Dose#-Short Name;
+10 ;---> now it contains vaccine components.
+11 ;---> Also add DE 24 V File IEN, and DE 65 is Dose Override.
+12 ;NEW BIDE,I F I=8,26,27,60,33,44,57 S BIDE(I)=""
+13 ;
+14 ;
+15 ;
+16 ;---> If BIDE local array (Data Elements to be returned) is not
+17 ;---> passed, then set the following default Data Elements.
+18 ;---> The following are IEN's in ^BIEXPDD(.
+19 ;---> IEN PC DATA
+20 ;---> --- -- ----
+21 ;---> 1 = Visit Type: "I"=Immunization, "S"=Skin Test.
+22 ;---> 4 2 = Vaccine Name, Short.
+23 ;---> 8 3 = Vaccine Components. ;v8.0
+24 ;---> 24 4 = IEN, V File Visit.
+25 ;---> 26 5 = Location (or Outside Location) where Imm was given.
+26 ;---> 27 6 = Vaccine Group (Series Type) for grouping of vaccines.
+27 ;---> 33 7 = Vaccine Lot#, Text.
+28 ;---> 44 8 = Reaction to Immunization, text.
+29 ;---> 57 9 = Age at Visit.
+30 ;---> 65 10 = Dose Override.
+31 ;---> 66 11 = Date of Visit (MM/DD/YY).
+32 ;---> 69 12 = Vaccine Component CVX Code.
+33 ;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR
+34 ;---> Add Date of Event to Hx string.
+35 ;---> 86 13 = Date of Event (1201 field of V File) in YYYMMDD
+36 ;
+37 ;
+38 ;N BIDE,I F I=4,8,24,26,27,33,44,57,65,66,69 S BIDE(I)=""
+39 NEW BIDE,I
FOR I=4,8,24,26,27,33,44,57,65,66,69,86
SET BIDE(I)=""
+40 ;**********
+41 ;
+42 ;call to get imm hx
+43 NEW BIERR,BIFORCST,BIRETVAL
SET BIRETVAL=""
+44 DO IMMHX^BIRPC(.BIRETVAL,BIDFN,.BIDE,1,0)
+45 DO WRITE(.BILINE," IMMUNIZATION HISTORY:")
+46 ;
+47 ;---> If there is an Invalid Dose or Reaction, append extra line feed.
+48 ;---> Use BILF as a line feed flag. ***NOT USED for now. CIM/MWR 8/4/03
+49 NEW BILF
SET BILF=0
+50 ;
+51 SET BIERR=$PIECE(BIRETVAL,BI31,2)
+52 IF BIERR]""
DO WRITE(.BILINE," *"_BIERR)
QUIT
+53 ;
+54 SET BIFORCST=$PIECE(BIRETVAL,BI31,1)
+55 NEW I,V,BIX,BIZ
SET BIZ=""
SET V="|"
+56 ;
+57 FOR I=1:1
SET BIX=$PIECE(BIFORCST,U,I)
IF BIX=""
QUIT
Begin DoDot:1
+58 IF $PIECE(BIX,V)'="I"
QUIT
+59 ;
+60 ;---> Check if new vaccine group; if so, insert line feed.
+61 IF $PIECE(BIX,V,6)'=BIZ
Begin DoDot:2
+62 SET BIZ=$PIECE(BIX,V,6)
+63 ;---> If extra line feed was just sent due to Invalid/Reaction, don't here.
+64 IF '$GET(BILF)
DO WRITE(.BILINE)
End DoDot:2
+65 ;---> Reset line feed flag to zero.
+66 SET BILF=0
+67 ;
+68 ;---> Set flag for ImmServe Problem Dose, flag for asterisk.
+69 NEW BIAST,BIIMMS
SET BIAST=0
SET BIIMMS=0
+70 ;---> Next line: Insert asterisk if Problem Dose ;Cimarron/Mike Remillard 7/30/03
+71 Begin DoDot:2
+72 ;---> If there is a Dose Override, set asterisk flag (BIAST)=1.
+73 IF $PIECE(BIX,V,10)
SET BIAST=1
QUIT
+74 ;---> If ImmServe considers this dose to be Invalid, insert asterisk.
+75 ;---> Use BIPDSS (ImmServe problem dose string) from Forecast above.
+76 IF $$PDSS^BIUTL8($PIECE(BIX,V,4),$PIECE(BIX,V,12),BIPDSS)
SET BIAST=1
SET BIIMMS=1
End DoDot:2
+77 ;
+78 NEW Y
SET Y=""
+79 SET Y=" "_$SELECT($GET(BIAST):"*",1:" ")_$PIECE(BIX,V,2)
+80 ;
+81 ;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR
+82 ;---> Display Date of Event if different from Date of Visit.
+83 ;---> Also display Age at time of Event if different.
+84 ;S Y=$$PAD(Y,27)_$P(BIX,V,11)
+85 ;S Y=$$PAD(Y,37)_$P(BIX,V,9)
+86 NEW BIDT
SET BIDT=$PIECE(BIX,V,13)
+87 SET Y=$$PAD(Y,27)_$$SLDT2^BIUTL5(BIDT,1)
+88 SET Y=$$PAD(Y,37)_$$AGEF^BIUTL1(BIDFN,BIDT)
+89 ;**********
+90 ;
+91 SET Y=$$PAD(Y,45)_$EXTRACT($PIECE(BIX,V,5),1,20)
+92 SET Y=$$PAD(Y,66)_$PIECE(BIX,V,7)
+93 DO WRITE(.BILINE,Y)
+94 ;
+95 ;---> If there was a Dose Override, display it here.
+96 IF $PIECE(BIX,V,10)
Begin DoDot:2
+97 SET Y=$$PAD(" ",27)_"-"_$$DOVER^BIUTL8($PIECE(BIX,V,10))_"-"
+98 ;S BILF=1
DO WRITE(.BILINE,Y)
End DoDot:2
+99 ;
+100 ;---> If ImmServe considers this dose to be Invalid, display it here.
+101 ;---> Use BIPDSS (ImmServe problem dose string) from Forecast above.
+102 IF $GET(BIIMMS)
Begin DoDot:2
+103 SET Y=$$PAD(" ",27)_"-INVALID--SEE IMMSERVE-"
+104 ;S BILF=1
DO WRITE(.BILINE,Y)
End DoDot:2
+105 ;
+106 ;---> If there was a Reaction, display it here.
+107 IF $PIECE(BIX,V,8)]""
Begin DoDot:2
+108 SET Y=$$PAD(" ",27)_"Reaction: "_$PIECE(BIX,V,8)
+109 ;S BILF=1
DO WRITE(.BILINE,Y)
End DoDot:2
End DoDot:1
+110 ;
+111 QUIT
+112 ;
+113 ;
+114 ;----------
PAD(D,L,C) ;EP
+1 ;---> Pad the length of data to a total of L characters
+2 ;---> by adding spaces to the end of the data.
+3 ; Example: S X=$$PAD("MIKE",7) X="MIKE " (Added 3 spaces.)
+4 ;---> Parameters:
+5 ; 1 - D (req) Data to be padded.
+6 ; 2 - L (req) Total length of resulting data.
+7 ; 3 - C (opt) Character to pad with (default=space).
+8 ;
+9 IF '$DATA(D)
QUIT ""
+10 IF '$GET(L)
SET L=$LENGTH(D)
+11 IF $GET(C)=""
SET C=" "
+12 QUIT $EXTRACT(D_$$REPEAT^XLFSTR(C,L),1,L)
+13 ;
+14 ;
+15 ;----------
WRITE(BILINE,BIVAL,BIBLNK) ;EP
+1 ;---> Write lines to ^TMP (see documentation in ^BIW).
+2 ;---> Parameters:
+3 ; 1 - BILINE (ret) Last line# written.
+4 ; 2 - BIVAL (opt) Value/text of line (Null=blank line).
+5 ; 3 - BIBLNK (opt) Number of blank lines to add after line sent.
+6 ;
+7 IF '$DATA(BILINE)
QUIT
+8 DO WL^BIW(.BILINE,"BIHS",$GET(BIVAL),$GET(BIBLNK))
+9 QUIT
