BIPATVW1 ;IHS/CMI/MWR - BUILD LIST ARRAY OF IMM DATA; MAY 10, 2010
;;8.5;IMMUNIZATION;**8**;MAR 15,2014
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; BUILD LISTMANAGER ARRAY FOR DISPLAY AND EDIT OF
;; PATIENT'S IMMUNIZATION DATA.
;; PATCH 8: Changes for Invalid Doese from TCH Forecaster HISTORY+55,+81
;
;
;----------
MAIN(BIPRT) ;EP
;---> Build LM array for Patient Data Screen.
;---> Parameters:
; 1 - BIPRT (opt) If BIPRT=1 array is for print: skip INIT.
;
;---> Check for BIDFN.
Q:$$DFNCHECK^BIUTL2()
Q:$$DUZCHECK^BIUTL2()
;
N BI31,BIENT,BIFORCST,BILINE,BIPDSS,BIRETVAL,BIRETERR,BILMAX,BIRMAX
S BIENT=0,BILMAX=0,BIRMAX=0,BI31=$C(31)_$C(31)
S:'$G(BIFDT) BIFDT=$G(DT)
;
D:'$G(BIPRT) INIT
;---> 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,BIFDT,,$G(BIDUZ2),.BIPDSS)
D HISTORY(BIDFN,$G(BIPDSS),.BILMAX,.BIENT)
D FORECAST(BIFORCST,.BIRMAX)
D LASTLET^BIPATVW3(BIDFN,.BIRMAX,.BIENT)
D CONTRAS^BIPATVW3(BIDFN,.BILMAX,.BIRMAX,.BIENT)
;
N BILINE S BILINE=$S(BIRMAX>BILMAX:BIRMAX,1:BILMAX)
D ADDINFO^BIPATVW3(BIDFN,.BILINE,.BIENT,$G(BIDUZ2),BIFDT)
;
D:$G(BIPRT)
.N X S X="Printed: "_$$NOW^BIUTL5() D CENTERT^BIUTL5(.X)
.D WRITE(.BILINE,X)
;
;---> Finish up Listmanager List Count.
S VALMCNT=BILINE
I VALMCNT>12 D
.S VALMSG="Scroll down to view more. Type ?? or Q to QUIT."
Q
;
;
;----------
INIT ;EP
;---> Initialize variables and list array.
;
S VALMSG="Type ?? for more actions or Q to Quit."
;
;---> Set default date for Screenman (if not already set, today).
S:'$D(BIDEFDT) BIDEFDT=$G(DT)
;
;---> If no Forecast Date passed, set it equal to today.
S:'$G(BIFDT) BIFDT=DT
;
;---> Show Forecast Date on Imms Due column header.
D:$G(BIFDT)
.N X S X="Immunizations DUE on "_$$SLDT2^BIUTL5(BIFDT)
.D CHGCAP^VALM("IMMUNIZATIONS DUE",X)
Q
;
;
;----------
HISTORY(BIDFN,BIPDSS,BILMAX,BIENT) ;EP
;---> Gather Immunization History and set in Listman display array.
;---> Parameters:
; 1 - BIDFN (req) Patient's IEN in VA PATIENT File #2.
; 2 - BIPDSS (opt) Returned string of Visit IEN's that are
; Problem Doses, according to ImmServe.
; 3 - BILMAX (ret) Maximum Left column line number.
; 4 - BIENT (ret) Entry Number for LM selection in VALMY
;
;---> Check for BIDFN.
Q:$$DFNCHECK^BIUTL2()
;
;---> Call RPC to gather Immunization History.
; BIRETVAL - Return value of valid data from RPC.
; BIRETERR - Return value (text string) of error from RPC.
;
N BIRETVAL,BIRETERR S BIRETVAL=""
D IMMHX^BIRPC(.BIRETVAL,BIDFN,,1,0)
;
;---> If BIRETERR has a value, display it and quit.
S BIRETERR=$P(BIRETVAL,BI31,2)
I BIRETERR]"" D EN^DDIOL("* "_BIRETERR,"","!!?5"),DIRZ^BIUTL3() Q
;
;---> Set BIHX(BIDFN)=to a valid Immunization History for this patient.
;---> * NOTE! BIHX(BIDFN) is not newed; it is used to edit and delete
; Immunizations for this patient (sub BIDFN for insurance).
;
S BIHX(BIDFN)=$P(BIRETVAL,BI31,1)
;X ^O
;
;---> Build Listmanager array from BIHX(BIDFN) string.
K ^TMP("BILMVW",$J)
N BILINE,BISK,I,V,X,Y,Z
S BILINE=0,V="|",Z=""
;
;---> Loop through "^"-pieces of Imm History, displaying.
F I=1:1 S Y=$P(BIHX(BIDFN),U,I) Q:Y="" D
.;
.;---> IMMUNIZATIONS
.;---> If this is an Immunization, display as follows and quit.
.I $P(Y,V)="I" D Q
..;
..;---> If not the same Vaccine Group, insert a blank line.
..I $P(Y,V,6)'=Z D:I>1 RTCOL(.BILINE,,BIENT) S Z=$P(Y,V,6)
..;
..S BIENT=BIENT+1
..;---> Set display line for this immunization.
..S X=$S(BIENT>9:" ",1:" ")_BIENT_" "_$P(Y,V,17)
..;
..;---> Next line: Prepend asterisk if this Dose has a User Override
..;---> or is an ImmServe Problem Dose (flag stored in BIPDSSA).
..;---> (Override=pc 16, ImmServe string of prob doses=pc 4.)
..N A,BIPDSSA S A=" ",BIPDSSA=0
..D
...I $P(Y,V,16) S A=" *" Q
...;
...;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR
...;---> For now just flag invalid by V Imm IEN (not by component CVX).
...;W !!,Y,!!,$P(Y,V,18),!,BIPDSS,! R ZZZ
...I $$PDSS^BIUTL8($P(Y,V,4),$P(Y,V,18),BIPDSS) S A=" *",BIPDSSA=1
..S X=X_A_$P(Y,V,2)
..;
..;---> Pad with spaces to line up in columns.
..S X=$$PAD^BIUTL5(X,37)
..;---> Pre-pend "+" if this immunization was imported from an outside registry.
..S X=X_$S($P(Y,V,20):"+",1:" ")
..;---> Display first 4 characters of Location of Visit.
..S X=X_$E($P(Y,V,5),1,4)
..S X=$$PAD^BIUTL5(X,43)_"|"
..;
..;---> Set formatted line and index in ^TMP.
..D WRITE(.BILINE,X,,BIENT)
..;
..;---> If this is a Dose Override by user, set another line to display it.
..D:$P(Y,V,16)
...S X=" -"_$$DOVER^BIUTL8($P(Y,V,16))_"-"
...;---> Pad Result with trailing spaces to justify columns.
...D WRITE(.BILINE,$$PAD^BIUTL5(X,43)_"|",,BIENT)
..;
..;---> If this is a Problem Dose by ImmServe, set another line to display it.
..D:$G(BIPDSSA)
...;
...;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR
...;---> Change text.
...;S X=" -INVALID--SEE IMMSERVE-"
...S X=" -INVALID--SEE REPORT-"
...;**********
...;---> Pad Result with trailing spaces to justify columns.
...D WRITE(.BILINE,$$PAD^BIUTL5(X,43)_"|",,BIENT)
..;
..;
..;---> If there was a Reaction, set another line to display it.
..D:$P(Y,V,13)]""
...S X=" ("_$P(Y,V,13)_")"
...;---> Pad Result with trailing spaces to justify columns.
...D WRITE(.BILINE,$$PAD^BIUTL5(X,43)_"|",,BIENT)
..;
..;
..;---> If this was created by a CPT Coded Visit, set a line to display it.
..D:$P(Y,V,19)
...S X=" (CPT-Coded visit)"
...;---> Pad Result with trailing spaces to justify columns.
...D WRITE(.BILINE,$$PAD^BIUTL5(X,43)_"|",,BIENT)
..;
.;
.;
.;---> SKIN TESTS
.;---> If this is a Skin Test, display as follows and quit.
.I $P(Y,V)="S" D Q
..;
..;---> Insert a blank line to set apart Skin Tests.
..I I>1 I '$D(BISK) S BISK="" D RTCOL(.BILINE,,BIENT)
..;
..S BIENT=BIENT+1
..;---> Set display line for this Skin Test.
..;S X=$S(BIENT>9:" ",1:" ")_BIENT_" "_$P($P(Y,V,7)," @") v8.0
..S X=$S(BIENT>9:" ",1:" ")_BIENT_" "_$P(Y,V,17)
..S X=X_" "_$P(Y,V,11)
..D
...;---> Pad with spaces to line up columns.
...S X=$$PAD^BIUTL5(X,38)_$E($P(Y,V,5),1,4)
...S X=$$PAD^BIUTL5(X,43)_"|"
..;
..;---> Set formatted line and index in ^TMP.
..D WRITE(.BILINE,X,,BIENT)
..;
..;---> Now set second line (results) of Skin Test.
..S X=" ("_$P(Y,V,8)
..D
...I $P(Y,V,8)="" I $P(Y,V,9)="" D Q
....S X=X_"No result",X=$$PAD^BIUTL5(X,25)
...;---> Pad out to reading column.
...S X=$$PAD^BIUTL5(X,24)
..D
...;---> Justify Reading column.
...N Z S Z=$P(Y,V,9)
...Q:Z=""
...S:Z<10 Z=" "_Z
...S X=X_" "_Z_"mm"
..D
...;---> Justify Read Date column.
...N Z S Z=$P(Y,V,10)
...Q:'Z
...S X=X_" on "_Z
..S X=X_")",X=$$PAD^BIUTL5(X,43)_"|"
..;
..D WRITE(.BILINE,X,,BIENT)
;
;---> Save maximum left column line number.
S BILMAX=BILINE
Q
;
;
;----------
FORECAST(BIFORCST,BIRMAX) ;EP
;---> Now retrieve ImmServe Forecast and append to right half
;---> of screen.
;---> Parameters:
; 1 - BIFORCST (req) Raw forecast string back from call to IMMFORC^BIRPC.
; 2 - BIRMAX (ret) Maximum Right column line number.
;
N BII,BILINE,BIRETERR
;
;---> If BIRETERR has a value, this is a FATAL ERROR in Forecasting;
;---> Display the error, and set its text in the forecast box.
S BILINE=0,BIRETERR=$P(BIFORCST,BI31,2)
I BIRETERR]"" D S BIRMAX=BILINE Q
.;---> Display error, require <return> to go on.
.D EN^DDIOL("* "_BIRETERR,"","!!?5"),DIRZ^BIUTL3()
.D PARSE(.BILINE,BIRETERR," ERROR:",BIENT)
;
;---> If there is NO fatal error, then process forecast string.
;---> Set BIFORC=to an Immunization Forecast for this patient.
N BIFORC,BIPC S BIFORC=$P(BIFORCST,BI31,1)
;
;---> Sample code to insert forecaster version in to Patient View screen.
;S BIFORC=BIFORC_"| TCH v3.7.1^"
;
;---> Build Listmanager array from BIFORC string.
;---> For each piece of the Forecast, format and set in Listman.
F BII=1:1 S BIPC=$P(BIFORC,U,BII) Q:BIPC="" D
.;
.;---> If forecast contains a minor error, write it and quit.
.I BIPC["ERROR:" D PARSE(.BILINE,BIPC,,BIENT) Q
.;
.;---> Set display line for this forecast immunization.
.;---> Pad Date with trailing spaces to line up in a columns.
.N V S V="|"
.D
..N Z S Z=$P(BIPC,V)
..;---> If "No Immunizations Due", write this instead of other data.
..;---> ("No immunizations due." text is set in ^BIRPC.)
..I Z="No immunizations due." S X=" "_Z Q
..S X=" "_Z,X=$$PAD^BIUTL5(X,16)_$P(BIPC,V,2)_$P(BIPC,V,3)
.;
.;---> Set formatted Imm Due line and index in ^TMP.
.D RTCOL(.BILINE,X,BIENT)
;
;---> Save maximum right column line number.
S BIRMAX=BILINE
Q
;
;
;----------
RTCOL(BILINE,BIVAL,BIENT) ;EP
;---> Set right column entries in ^TMP.
;---> Parameters:
; 1 - BILINE (ret) Last line# written.
; 2 - BIVAL (opt) Value/text of line (Null=blank line).
; (Null=blank line.)
; 3 - BIENT (opt) Entry Number for LM selection in VALMY
;
;---> If an Imm History line already exists, append to it.
N Z S Z=$G(^TMP("BILMVW",$J,BILINE+1,0))
I Z]"" S BIVAL=Z_$G(BIVAL) D WRITE(.BILINE,BIVAL) Q
;
;---> If this is a new line, set line count and index.
D WRITE(.BILINE,$$SP^BIUTL5(43)_"|"_$G(BIVAL),,$G(BIENT))
Q
;
;
;----------
WRITE(BILINE,BIVAL,BIBLNK,BIENT) ;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.
; 4 - BIENT (opt) Entry Number for LM selection in VALMY
;
Q:'$D(BILINE)
D WL^BIW(.BILINE,"BILMVW",$G(BIVAL),$G(BIBLNK),$G(BIENT))
Q
;
;
;----------
PARSE(BILINE,BISTR,BIFLN,BIENT) ;EP
;---> Parse Right Column lines to fit in proper length.
;---> Parameters:
; 1 - BILINE (req) Line Number, Right Column.
; 2 - BISTR (req) String of text to be parsed out.
; 3 - BIFLN (opt) First line (if null, blank line inserted).
; 4 - BIENT (ret) Entry Number for LM selection in VALMY
;
Q:'$D(BILINE) Q:$G(BISTR)=""
N A,Y,Z
D RTCOL(.BILINE,$G(BIFLN),$G(BIENT))
S A=1
F D Q:Y=""
.S Z=A+31,Y=$E(BISTR,A,Z)
.D:$L(Y)=32
..F Q:$E(BISTR,Z)=" " S Z=Z-1 Q:Z<10
..S Y=$E(BISTR,A,Z)
.;---> Set formatted Error line and index in ^TMP.
.D:Y]"" RTCOL(.BILINE," "_Y,$G(BIENT))
.S A=Z+1
Q
BIPATVW1 ;IHS/CMI/MWR - BUILD LIST ARRAY OF IMM DATA; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;**8**;MAR 15,2014
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; BUILD LISTMANAGER ARRAY FOR DISPLAY AND EDIT OF
+4 ;; PATIENT'S IMMUNIZATION DATA.
+5 ;; PATCH 8: Changes for Invalid Doese from TCH Forecaster HISTORY+55,+81
+6 ;
+7 ;
+8 ;----------
MAIN(BIPRT) ;EP
+1 ;---> Build LM array for Patient Data Screen.
+2 ;---> Parameters:
+3 ; 1 - BIPRT (opt) If BIPRT=1 array is for print: skip INIT.
+4 ;
+5 ;---> Check for BIDFN.
+6 IF $$DFNCHECK^BIUTL2()
QUIT
+7 IF $$DUZCHECK^BIUTL2()
QUIT
+8 ;
+9 NEW BI31,BIENT,BIFORCST,BILINE,BIPDSS,BIRETVAL,BIRETERR,BILMAX,BIRMAX
+10 SET BIENT=0
SET BILMAX=0
SET BIRMAX=0
SET BI31=$CHAR(31)_$CHAR(31)
+11 IF '$GET(BIFDT)
SET BIFDT=$GET(DT)
+12 ;
+13 IF '$GET(BIPRT)
DO INIT
+14 ;---> Get forecast string (BIFORCST) and problem dose string (BIPDSS).
+15 ;---> Pass BIPDSS to HISTORY to mark problem doses with asterisks.
+16 ;---> Pass BIFORCST to FORECAST for display.
+17 DO IMMFORC^BIRPC(.BIFORCST,BIDFN,BIFDT,,$GET(BIDUZ2),.BIPDSS)
+18 DO HISTORY(BIDFN,$GET(BIPDSS),.BILMAX,.BIENT)
+19 DO FORECAST(BIFORCST,.BIRMAX)
+20 DO LASTLET^BIPATVW3(BIDFN,.BIRMAX,.BIENT)
+21 DO CONTRAS^BIPATVW3(BIDFN,.BILMAX,.BIRMAX,.BIENT)
+22 ;
+23 NEW BILINE
SET BILINE=$SELECT(BIRMAX>BILMAX:BIRMAX,1:BILMAX)
+24 DO ADDINFO^BIPATVW3(BIDFN,.BILINE,.BIENT,$GET(BIDUZ2),BIFDT)
+25 ;
+26 IF $GET(BIPRT)
Begin DoDot:1
+27 NEW X
SET X="Printed: "_$$NOW^BIUTL5()
DO CENTERT^BIUTL5(.X)
+28 DO WRITE(.BILINE,X)
End DoDot:1
+29 ;
+30 ;---> Finish up Listmanager List Count.
+31 SET VALMCNT=BILINE
+32 IF VALMCNT>12
Begin DoDot:1
+33 SET VALMSG="Scroll down to view more. Type ?? or Q to QUIT."
End DoDot:1
+34 QUIT
+35 ;
+36 ;
+37 ;----------
INIT ;EP
+1 ;---> Initialize variables and list array.
+2 ;
+3 SET VALMSG="Type ?? for more actions or Q to Quit."
+4 ;
+5 ;---> Set default date for Screenman (if not already set, today).
+6 IF '$DATA(BIDEFDT)
SET BIDEFDT=$GET(DT)
+7 ;
+8 ;---> If no Forecast Date passed, set it equal to today.
+9 IF '$GET(BIFDT)
SET BIFDT=DT
+10 ;
+11 ;---> Show Forecast Date on Imms Due column header.
+12 IF $GET(BIFDT)
Begin DoDot:1
+13 NEW X
SET X="Immunizations DUE on "_$$SLDT2^BIUTL5(BIFDT)
+14 DO CHGCAP^VALM("IMMUNIZATIONS DUE",X)
End DoDot:1
+15 QUIT
+16 ;
+17 ;
+18 ;----------
HISTORY(BIDFN,BIPDSS,BILMAX,BIENT) ;EP
+1 ;---> Gather Immunization History and set in Listman display array.
+2 ;---> Parameters:
+3 ; 1 - BIDFN (req) Patient's IEN in VA PATIENT File #2.
+4 ; 2 - BIPDSS (opt) Returned string of Visit IEN's that are
+5 ; Problem Doses, according to ImmServe.
+6 ; 3 - BILMAX (ret) Maximum Left column line number.
+7 ; 4 - BIENT (ret) Entry Number for LM selection in VALMY
+8 ;
+9 ;---> Check for BIDFN.
+10 IF $$DFNCHECK^BIUTL2()
QUIT
+11 ;
+12 ;---> Call RPC to gather Immunization History.
+13 ; BIRETVAL - Return value of valid data from RPC.
+14 ; BIRETERR - Return value (text string) of error from RPC.
+15 ;
+16 NEW BIRETVAL,BIRETERR
SET BIRETVAL=""
+17 DO IMMHX^BIRPC(.BIRETVAL,BIDFN,,1,0)
+18 ;
+19 ;---> If BIRETERR has a value, display it and quit.
+20 SET BIRETERR=$PIECE(BIRETVAL,BI31,2)
+21 IF BIRETERR]""
DO EN^DDIOL("* "_BIRETERR,"","!!?5")
DO DIRZ^BIUTL3()
QUIT
+22 ;
+23 ;---> Set BIHX(BIDFN)=to a valid Immunization History for this patient.
+24 ;---> * NOTE! BIHX(BIDFN) is not newed; it is used to edit and delete
+25 ; Immunizations for this patient (sub BIDFN for insurance).
+26 ;
+27 SET BIHX(BIDFN)=$PIECE(BIRETVAL,BI31,1)
+28 ;X ^O
+29 ;
+30 ;---> Build Listmanager array from BIHX(BIDFN) string.
+31 KILL ^TMP("BILMVW",$JOB)
+32 NEW BILINE,BISK,I,V,X,Y,Z
+33 SET BILINE=0
SET V="|"
SET Z=""
+34 ;
+35 ;---> Loop through "^"-pieces of Imm History, displaying.
+36 FOR I=1:1
SET Y=$PIECE(BIHX(BIDFN),U,I)
IF Y=""
QUIT
Begin DoDot:1
+37 ;
+38 ;---> IMMUNIZATIONS
+39 ;---> If this is an Immunization, display as follows and quit.
+40 IF $PIECE(Y,V)="I"
Begin DoDot:2
+41 ;
+42 ;---> If not the same Vaccine Group, insert a blank line.
+43 IF $PIECE(Y,V,6)'=Z
IF I>1
DO RTCOL(.BILINE,,BIENT)
SET Z=$PIECE(Y,V,6)
+44 ;
+45 SET BIENT=BIENT+1
+46 ;---> Set display line for this immunization.
+47 SET X=$SELECT(BIENT>9:" ",1:" ")_BIENT_" "_$PIECE(Y,V,17)
+48 ;
+49 ;---> Next line: Prepend asterisk if this Dose has a User Override
+50 ;---> or is an ImmServe Problem Dose (flag stored in BIPDSSA).
+51 ;---> (Override=pc 16, ImmServe string of prob doses=pc 4.)
+52 NEW A,BIPDSSA
SET A=" "
SET BIPDSSA=0
+53 Begin DoDot:3
+54 IF $PIECE(Y,V,16)
SET A=" *"
QUIT
+55 ;
+56 ;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR
+57 ;---> For now just flag invalid by V Imm IEN (not by component CVX).
+58 ;W !!,Y,!!,$P(Y,V,18),!,BIPDSS,! R ZZZ
+59 IF $$PDSS^BIUTL8($PIECE(Y,V,4),$PIECE(Y,V,18),BIPDSS)
SET A=" *"
SET BIPDSSA=1
End DoDot:3
+60 SET X=X_A_$PIECE(Y,V,2)
+61 ;
+62 ;---> Pad with spaces to line up in columns.
+63 SET X=$$PAD^BIUTL5(X,37)
+64 ;---> Pre-pend "+" if this immunization was imported from an outside registry.
+65 SET X=X_$SELECT($PIECE(Y,V,20):"+",1:" ")
+66 ;---> Display first 4 characters of Location of Visit.
+67 SET X=X_$EXTRACT($PIECE(Y,V,5),1,4)
+68 SET X=$$PAD^BIUTL5(X,43)_"|"
+69 ;
+70 ;---> Set formatted line and index in ^TMP.
+71 DO WRITE(.BILINE,X,,BIENT)
+72 ;
+73 ;---> If this is a Dose Override by user, set another line to display it.
+74 IF $PIECE(Y,V,16)
Begin DoDot:3
+75 SET X=" -"_$$DOVER^BIUTL8($PIECE(Y,V,16))_"-"
+76 ;---> Pad Result with trailing spaces to justify columns.
+77 DO WRITE(.BILINE,$$PAD^BIUTL5(X,43)_"|",,BIENT)
End DoDot:3
+78 ;
+79 ;---> If this is a Problem Dose by ImmServe, set another line to display it.
+80 IF $GET(BIPDSSA)
Begin DoDot:3
+81 ;
+82 ;********** PATCH 8, v8.5, MAR 15,2014, IHS/CMI/MWR
+83 ;---> Change text.
+84 ;S X=" -INVALID--SEE IMMSERVE-"
+85 SET X=" -INVALID--SEE REPORT-"
+86 ;**********
+87 ;---> Pad Result with trailing spaces to justify columns.
+88 DO WRITE(.BILINE,$$PAD^BIUTL5(X,43)_"|",,BIENT)
End DoDot:3
+89 ;
+90 ;
+91 ;---> If there was a Reaction, set another line to display it.
+92 IF $PIECE(Y,V,13)]""
Begin DoDot:3
+93 SET X=" ("_$PIECE(Y,V,13)_")"
+94 ;---> Pad Result with trailing spaces to justify columns.
+95 DO WRITE(.BILINE,$$PAD^BIUTL5(X,43)_"|",,BIENT)
End DoDot:3
+96 ;
+97 ;
+98 ;---> If this was created by a CPT Coded Visit, set a line to display it.
+99 IF $PIECE(Y,V,19)
Begin DoDot:3
+100 SET X=" (CPT-Coded visit)"
+101 ;---> Pad Result with trailing spaces to justify columns.
+102 DO WRITE(.BILINE,$$PAD^BIUTL5(X,43)_"|",,BIENT)
End DoDot:3
+103 ;
End DoDot:2
QUIT
+104 ;
+105 ;
+106 ;---> SKIN TESTS
+107 ;---> If this is a Skin Test, display as follows and quit.
+108 IF $PIECE(Y,V)="S"
Begin DoDot:2
+109 ;
+110 ;---> Insert a blank line to set apart Skin Tests.
+111 IF I>1
IF '$DATA(BISK)
SET BISK=""
DO RTCOL(.BILINE,,BIENT)
+112 ;
+113 SET BIENT=BIENT+1
+114 ;---> Set display line for this Skin Test.
+115 ;S X=$S(BIENT>9:" ",1:" ")_BIENT_" "_$P($P(Y,V,7)," @") v8.0
+116 SET X=$SELECT(BIENT>9:" ",1:" ")_BIENT_" "_$PIECE(Y,V,17)
+117 SET X=X_" "_$PIECE(Y,V,11)
+118 Begin DoDot:3
+119 ;---> Pad with spaces to line up columns.
+120 SET X=$$PAD^BIUTL5(X,38)_$EXTRACT($PIECE(Y,V,5),1,4)
+121 SET X=$$PAD^BIUTL5(X,43)_"|"
End DoDot:3
+122 ;
+123 ;---> Set formatted line and index in ^TMP.
+124 DO WRITE(.BILINE,X,,BIENT)
+125 ;
+126 ;---> Now set second line (results) of Skin Test.
+127 SET X=" ("_$PIECE(Y,V,8)
+128 Begin DoDot:3
+129 IF $PIECE(Y,V,8)=""
IF $PIECE(Y,V,9)=""
Begin DoDot:4
+130 SET X=X_"No result"
SET X=$$PAD^BIUTL5(X,25)
End DoDot:4
QUIT
+131 ;---> Pad out to reading column.
+132 SET X=$$PAD^BIUTL5(X,24)
End DoDot:3
+133 Begin DoDot:3
+134 ;---> Justify Reading column.
+135 NEW Z
SET Z=$PIECE(Y,V,9)
+136 IF Z=""
QUIT
+137 IF Z<10
SET Z=" "_Z
+138 SET X=X_" "_Z_"mm"
End DoDot:3
+139 Begin DoDot:3
+140 ;---> Justify Read Date column.
+141 NEW Z
SET Z=$PIECE(Y,V,10)
+142 IF 'Z
QUIT
+143 SET X=X_" on "_Z
End DoDot:3
+144 SET X=X_")"
SET X=$$PAD^BIUTL5(X,43)_"|"
+145 ;
+146 DO WRITE(.BILINE,X,,BIENT)
End DoDot:2
QUIT
End DoDot:1
+147 ;
+148 ;---> Save maximum left column line number.
+149 SET BILMAX=BILINE
+150 QUIT
+151 ;
+152 ;
+153 ;----------
FORECAST(BIFORCST,BIRMAX) ;EP
+1 ;---> Now retrieve ImmServe Forecast and append to right half
+2 ;---> of screen.
+3 ;---> Parameters:
+4 ; 1 - BIFORCST (req) Raw forecast string back from call to IMMFORC^BIRPC.
+5 ; 2 - BIRMAX (ret) Maximum Right column line number.
+6 ;
+7 NEW BII,BILINE,BIRETERR
+8 ;
+9 ;---> If BIRETERR has a value, this is a FATAL ERROR in Forecasting;
+10 ;---> Display the error, and set its text in the forecast box.
+11 SET BILINE=0
SET BIRETERR=$PIECE(BIFORCST,BI31,2)
+12 IF BIRETERR]""
Begin DoDot:1
+13 ;---> Display error, require <return> to go on.
+14 DO EN^DDIOL("* "_BIRETERR,"","!!?5")
DO DIRZ^BIUTL3()
+15 DO PARSE(.BILINE,BIRETERR," ERROR:",BIENT)
End DoDot:1
SET BIRMAX=BILINE
QUIT
+16 ;
+17 ;---> If there is NO fatal error, then process forecast string.
+18 ;---> Set BIFORC=to an Immunization Forecast for this patient.
+19 NEW BIFORC,BIPC
SET BIFORC=$PIECE(BIFORCST,BI31,1)
+20 ;
+21 ;---> Sample code to insert forecaster version in to Patient View screen.
+22 ;S BIFORC=BIFORC_"| TCH v3.7.1^"
+23 ;
+24 ;---> Build Listmanager array from BIFORC string.
+25 ;---> For each piece of the Forecast, format and set in Listman.
+26 FOR BII=1:1
SET BIPC=$PIECE(BIFORC,U,BII)
IF BIPC=""
QUIT
Begin DoDot:1
+27 ;
+28 ;---> If forecast contains a minor error, write it and quit.
+29 IF BIPC["ERROR:"
DO PARSE(.BILINE,BIPC,,BIENT)
QUIT
+30 ;
+31 ;---> Set display line for this forecast immunization.
+32 ;---> Pad Date with trailing spaces to line up in a columns.
+33 NEW V
SET V="|"
+34 Begin DoDot:2
+35 NEW Z
SET Z=$PIECE(BIPC,V)
+36 ;---> If "No Immunizations Due", write this instead of other data.
+37 ;---> ("No immunizations due." text is set in ^BIRPC.)
+38 IF Z="No immunizations due."
SET X=" "_Z
QUIT
+39 SET X=" "_Z
SET X=$$PAD^BIUTL5(X,16)_$PIECE(BIPC,V,2)_$PIECE(BIPC,V,3)
End DoDot:2
+40 ;
+41 ;---> Set formatted Imm Due line and index in ^TMP.
+42 DO RTCOL(.BILINE,X,BIENT)
End DoDot:1
+43 ;
+44 ;---> Save maximum right column line number.
+45 SET BIRMAX=BILINE
+46 QUIT
+47 ;
+48 ;
+49 ;----------
RTCOL(BILINE,BIVAL,BIENT) ;EP
+1 ;---> Set right column entries in ^TMP.
+2 ;---> Parameters:
+3 ; 1 - BILINE (ret) Last line# written.
+4 ; 2 - BIVAL (opt) Value/text of line (Null=blank line).
+5 ; (Null=blank line.)
+6 ; 3 - BIENT (opt) Entry Number for LM selection in VALMY
+7 ;
+8 ;---> If an Imm History line already exists, append to it.
+9 NEW Z
SET Z=$GET(^TMP("BILMVW",$JOB,BILINE+1,0))
+10 IF Z]""
SET BIVAL=Z_$GET(BIVAL)
DO WRITE(.BILINE,BIVAL)
QUIT
+11 ;
+12 ;---> If this is a new line, set line count and index.
+13 DO WRITE(.BILINE,$$SP^BIUTL5(43)_"|"_$GET(BIVAL),,$GET(BIENT))
+14 QUIT
+15 ;
+16 ;
+17 ;----------
WRITE(BILINE,BIVAL,BIBLNK,BIENT) ;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 ; 4 - BIENT (opt) Entry Number for LM selection in VALMY
+7 ;
+8 IF '$DATA(BILINE)
QUIT
+9 DO WL^BIW(.BILINE,"BILMVW",$GET(BIVAL),$GET(BIBLNK),$GET(BIENT))
+10 QUIT
+11 ;
+12 ;
+13 ;----------
PARSE(BILINE,BISTR,BIFLN,BIENT) ;EP
+1 ;---> Parse Right Column lines to fit in proper length.
+2 ;---> Parameters:
+3 ; 1 - BILINE (req) Line Number, Right Column.
+4 ; 2 - BISTR (req) String of text to be parsed out.
+5 ; 3 - BIFLN (opt) First line (if null, blank line inserted).
+6 ; 4 - BIENT (ret) Entry Number for LM selection in VALMY
+7 ;
+8 IF '$DATA(BILINE)
QUIT
IF $GET(BISTR)=""
QUIT
+9 NEW A,Y,Z
+10 DO RTCOL(.BILINE,$GET(BIFLN),$GET(BIENT))
+11 SET A=1
+12 FOR
Begin DoDot:1
+13 SET Z=A+31
SET Y=$EXTRACT(BISTR,A,Z)
+14 IF $LENGTH(Y)=32
Begin DoDot:2
+15 FOR
IF $EXTRACT(BISTR,Z)=" "
QUIT
SET Z=Z-1
IF Z<10
QUIT
+16 SET Y=$EXTRACT(BISTR,A,Z)
End DoDot:2
+17 ;---> Set formatted Error line and index in ^TMP.
+18 IF Y]""
DO RTCOL(.BILINE," "_Y,$GET(BIENT))
+19 SET A=Z+1
End DoDot:1
IF Y=""
QUIT
+20 QUIT
