BIDUVLS2 ;IHS/CMI/MWR - VIEW DUE LIST VIEW.; MAY 10, 2010
;;8.5;IMMUNIZATION;;SEP 01,2011
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; LIST TEMPLATE CODE FOR VIEWING PATIENTS DUE, SET LINES FOR
;; INDIVIDUAL PATIENTS.
;
;
;----------
PATIENT(BILINE,BIDFN,BINFO,BIDASH,BIMMRF,BIMMLF) ;EP
;---> Set line in Listman display global.
;---> Parameters:
; 1 - BILINE (req) Line Number in display area.
; 2 - BIDFN (req) Patient DFN.
; 3 - BINFO (req) Array of Additional Info elements.
; 4 - BIDASH (opt) 1=Omit Dash line between records; 0=include it.
; 5 - BIMMRF (opt) Imms Received Filter array (subscript=CVX's included).
; 6 - BIMMLF (opt) Lot Number Filter array (subscript=lot number text).
;
Q:$G(BILINE)=""
N BIPLIN,BIPLIN1,X
;
;---> Patient demographic line.
S X=" "_$E($$NAME^BIUTL1(BIDFN),1,19)
S X=$$PAD^BIUTL5(X,22)_$$PAD^BIUTL5($$HRCN^BIUTL1(BIDFN,DUZ(2)),8)
;S X=X_" "_$$DOBF^BIUTL1(BIDFN,,,1)_" "_$$SEX^BIUTL1(BIDFN) vvv83
S X=X_" "_$$DOBF^BIUTL1(BIDFN,$G(BIFDT),,1)
S X=$$PAD^BIUTL5(X,54)_$$SEX^BIUTL1(BIDFN)
S X=$$PAD^BIUTL5(X,58)_$E($$CURCOM^BIUTL11(BIDFN,1),1,21)
D:'$G(BIDASH) WRITE(.BILINE)
D WRITE(.BILINE,X) K X
;---> Preserve line number of Patient demographic line, for record
;---> line count and for address and phone lines below.
S BIPLIN=BILINE-1,BIPLIN1=BILINE+1
;
;---> Next section: Write specifed Additional Information in BINFO.
;
;--> Check if BINFO("ALL") exists. If so, set BIALL=1 and display all Info.
N BIALL S BIALL=0
S:$D(BINFO("ALL")) BIALL=1
;
;---> First, build Data String, BINFODS, of Add Info elements (2nd piece of
;---> BI TABLE ADD INFO File #9002084.82).
N BINFODS
D
.N N S N=0
.F S N=$O(BINFO(N)) Q:'N D
..S BINFODS=$G(BINFODS)_$P($G(^BIADDIN(N,0)),U,2)_"^"
.S:'$G(BINFODS) BINFODS=0
;
;---> Forecast.
D:((BINFODS[15)!BIALL) WRITE(.BILINE),FORECAST(.BILINE,BIDFN,$G(BIFDT))
;
;---> Address.
D:((BINFODS[12)!BIALL)
.N X S X="Address..: "_$E($$STREET^BIUTL1(BIDFN),1,38)
.S BIPLIN1=BIPLIN1+1
.D APPEND(BIPLIN1,X,.BILINE)
.S X=" "_$$CTYSTZ^BIUTL1(BIDFN),BIPLIN1=BIPLIN1+1
.D APPEND(BIPLIN1,X,.BILINE)
;
;---> Phone Number.
D:((BINFODS[11)!BIALL)
.N X S X="Phone....: "_$$HPHONE^BIUTL1(BIDFN),BIPLIN1=BIPLIN1+1
.D APPEND(BIPLIN1,X,.BILINE)
;
;---> Parent/Guardian.
D:((BINFODS[17)!BIALL)
.N X S X="Parent...: "_$$PARENT^BIUTL1(BIDFN),BIPLIN1=BIPLIN1+1
.D APPEND(BIPLIN1,X,.BILINE)
;
;---> Case Manager.
D:((BINFODS[18)!BIALL)
.N X S X="Case Mgr.: "_$$CMGR^BIUTL1(BIDFN,1,1),BIPLIN1=BIPLIN1+1
.D APPEND(BIPLIN1,X,.BILINE)
;
;---> Reason Inactivated.
D:((BINFODS[19)!BIALL)
.Q:('$$INACT^BIUTL1(BIDFN))
.N X S X="Inactive.: "_$$INACTRE^BIUTL1(BIDFN),BIPLIN1=BIPLIN1+1
.D APPEND(BIPLIN1,X,.BILINE)
;
;---> Immunization History.
I (BINFODS[13)!(BINFODS[14)!(BINFODS[20)!(BINFODS[22)!(BINFODS[25)!BIALL D
.;---> Write either History or History w/Lot#'s, VFC, with or without Skin Tests.
.N X D
..I (BINFODS[14)&(BINFODS'[25) S X=2 Q
..I (BINFODS'[14)&(BINFODS[25) S X=5 Q
..I (BINFODS[14)&(BINFODS[25) S X=7 Q
..S X=1
.;
.;---> Include location where shot was given.
.N Y S Y=$S(BINFODS[22:1,1:0)
.N Z S Z=1
.D:(BINFODS[20)
..I ((BINFODS'[13)&(BINFODS'[14)&(BINFODS'[25)) S Z=2 Q
..S Z=0
.D WRITE(.BILINE),WRITE(.BILINE," History:")
.D HISTORY1^BILETPR1(.BILINE,BIDFN,X,,"BIDULV",,,Z,Y,.BIMMRF,.BIMMLF)
;
;
;---> Refusals.
D:((BINFODS[23)!BIALL)
.N A,X1,X2,X3 S (X1,X2,X3)=""
.D CONTRA^BIUTL11(BIDFN,.A,1,1)
.Q:('$D(A))
.D WRITE(.BILINE)
.S X1=" Refusals: "
.N N,M S N=0,M=0
.F S N=$O(A(N)) Q:'N D
..N X S M=M+1
..S X=$$VNAME^BIUTL2($$HL7TX^BIUTL2(N))_" ("_$$SLDT2^BIUTL5($P(A(N),U,2),1)_")"
..S:"235689"[M X=", "_X
..I M<4 S X1=X1_X Q
..I M<7 S:M=4 X2=" ",X1=X1_"," S X2=X2_X Q
..S:M=7 X3=" ",X2=X2_"," S X3=X3_X Q
.I X1]"" D WRITE(.BILINE,X1)
.I X2]"" D WRITE(.BILINE,X2)
.I X3]"" D WRITE(.BILINE,X3)
;
;---> Next Appointment.
D:((BINFODS[21)!BIALL)
.;---> Write either Patient's Next Appointment if there is one.
.N X S X=$$NEXTAPPT^BIUTL11(BIDFN)
.D:X]""
..S X=" Next Appointment: "_$E(X,1,57)
..D WRITE(.BILINE),WRITE(.BILINE,X)
;
;---> Directions to House.
D:((BINFODS[16)!BIALL)
.Q:'$O(^AUPNPAT(BIDFN,12,0))
.D WRITE(.BILINE)
.N X S X=" Directions to the home of "_$$NAME^BIUTL1(BIDFN,1)_":"
.D WRITE(.BILINE,X)
.N N S N=0
.F S N=$O(^AUPNPAT(BIDFN,12,N)) Q:'N D
..S X=$G(^AUPNPAT(BIDFN,12,N,0))
..D WRITE(.BILINE," "_X)
;
D:'$G(BIDASH) WRITE(.BILINE," "_$$SP^BIUTL5(73,"-"))
;---> Mark the top line of this record with the total lines in it.
D MARK^BIW(BIPLIN,BILINE-BIPLIN,"BIDULV")
Q
;
;
;----------
FORECAST(BILINE,BIDFN,BIFDT) ;EP
;---> Retrieve and store Imm Forecast in WP ^TMP global.
;---> Parameters:
; 2 - BILINE (ret) Last line written into ^TMP array.
; 3 - BIDFN (req) Patient's IEN in VA PATIENT File #2.
; 4 - BIFDT (opt) Forecast Date.
;
Q:'$D(BILINE) Q:'$G(BIDFN)
;
;---> If Patient is deceased, display date instead of forecast.
N X S X=$$DECEASED^BIUTL1(BIDFN,1)
I X D WRITE(.BILINE),WRITE(.BILINE," DECEASED: "_$$TXDT^BIUTL5(X)) Q
;
;---> If Forecast Date not provided, set it equal to today.
S:'$G(BIFDT) BIFDT=DT
;
;---> 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=""
;---> Next line: 4th param=1 to not call Immserve because forecast
;---> just got updated in retrieving patients: +225^BIDUR.
D IMMFORC^BIRPC(.BIRETVAL,BIDFN,BIFDT,1)
;
;---> If BIRETERR has a value, store it and quit.
S BIRETERR=$P(BIRETVAL,BI31,2)
I BIRETERR]"" D Q
.D WRITE(.BILINE),WRITE(.BILINE," "_BIRETERR),WRITE(.BILINE)
;
;---> Set BIFDTORC=to the Immunization Forecast for this patient.
N BIFDTORC,I,V S V="|",BIFDTORC=$P(BIRETVAL,BI31,1)
;
;---> Loop through "^"-pieces of Imm Forecast, getting data.
F I=1:1 S Y=$P(BIFDTORC,U,I) Q:Y="" D
.N X,Z S X=$S(I=1:" Needs: ",1:" ")
.;---> If the forecast for this vaccine contains an error,
.;---> write Vaccine Group Name Error, such as, $P("DTP ERROR:",":").
.S Z=$P(Y,V),Z=X_$P(Z,":")
.D WRITE(.BILINE,Z)
Q
;
;
;----------
WRITE(BILINE,BIVAL) ;EP
;---> Write a line to the ^TMP global for WP or Listman.
;---> Parameters:
; 1 - BILINE (ret) Last line# in the WP ^TMP global.
; 2 - BIVAL (opt) Value/text of line (Null=blank line).
;
Q:'$D(BILINE)
S:$G(BIVAL)="" BIVAL=" "
S BILINE=BILINE+1,^TMP("BIDULV",$J,BILINE,0)=BIVAL
Q
;
;
;----------
APPEND(BIPLIN1,BIVAL,BILINE) ;EP
;---> Append BIVAL to existing line or create new line.
;---> Parameters:
; 1 - BIPLIN1 (ret) Line down from demog line to be added to.
; 2 - BIVAL (opt) Value/text of line (Null=blank line).
; 3 - BILINE (ret) Last line# in the WP ^TMP global.
;
Q:'$D(BILINE)
Q:$G(BIVAL)=""
;
;---> If line already exists, append to it.
N X
I $D(^TMP("BIDULV",$J,BIPLIN1,0)) S X=^(0) D Q
.S X=$$PAD^BIUTL5(X,32)_BIVAL
.S ^TMP("BIDULV",$J,BIPLIN1,0)=X
;
;---> If line doesn't exist, create it.
D WRITE(.BILINE,$$SP^BIUTL5(32)_BIVAL)
Q
BIDUVLS2 ;IHS/CMI/MWR - VIEW DUE LIST VIEW.; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;;SEP 01,2011
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; LIST TEMPLATE CODE FOR VIEWING PATIENTS DUE, SET LINES FOR
+4 ;; INDIVIDUAL PATIENTS.
+5 ;
+6 ;
+7 ;----------
PATIENT(BILINE,BIDFN,BINFO,BIDASH,BIMMRF,BIMMLF) ;EP
+1 ;---> Set line in Listman display global.
+2 ;---> Parameters:
+3 ; 1 - BILINE (req) Line Number in display area.
+4 ; 2 - BIDFN (req) Patient DFN.
+5 ; 3 - BINFO (req) Array of Additional Info elements.
+6 ; 4 - BIDASH (opt) 1=Omit Dash line between records; 0=include it.
+7 ; 5 - BIMMRF (opt) Imms Received Filter array (subscript=CVX's included).
+8 ; 6 - BIMMLF (opt) Lot Number Filter array (subscript=lot number text).
+9 ;
+10 IF $GET(BILINE)=""
QUIT
+11 NEW BIPLIN,BIPLIN1,X
+12 ;
+13 ;---> Patient demographic line.
+14 SET X=" "_$EXTRACT($$NAME^BIUTL1(BIDFN),1,19)
+15 SET X=$$PAD^BIUTL5(X,22)_$$PAD^BIUTL5($$HRCN^BIUTL1(BIDFN,DUZ(2)),8)
+16 ;S X=X_" "_$$DOBF^BIUTL1(BIDFN,,,1)_" "_$$SEX^BIUTL1(BIDFN) vvv83
+17 SET X=X_" "_$$DOBF^BIUTL1(BIDFN,$GET(BIFDT),,1)
+18 SET X=$$PAD^BIUTL5(X,54)_$$SEX^BIUTL1(BIDFN)
+19 SET X=$$PAD^BIUTL5(X,58)_$EXTRACT($$CURCOM^BIUTL11(BIDFN,1),1,21)
+20 IF '$GET(BIDASH)
DO WRITE(.BILINE)
+21 DO WRITE(.BILINE,X)
KILL X
+22 ;---> Preserve line number of Patient demographic line, for record
+23 ;---> line count and for address and phone lines below.
+24 SET BIPLIN=BILINE-1
SET BIPLIN1=BILINE+1
+25 ;
+26 ;---> Next section: Write specifed Additional Information in BINFO.
+27 ;
+28 ;--> Check if BINFO("ALL") exists. If so, set BIALL=1 and display all Info.
+29 NEW BIALL
SET BIALL=0
+30 IF $DATA(BINFO("ALL"))
SET BIALL=1
+31 ;
+32 ;---> First, build Data String, BINFODS, of Add Info elements (2nd piece of
+33 ;---> BI TABLE ADD INFO File #9002084.82).
+34 NEW BINFODS
+35 Begin DoDot:1
+36 NEW N
SET N=0
+37 FOR
SET N=$ORDER(BINFO(N))
IF 'N
QUIT
Begin DoDot:2
+38 SET BINFODS=$GET(BINFODS)_$PIECE($GET(^BIADDIN(N,0)),U,2)_"^"
End DoDot:2
+39 IF '$GET(BINFODS)
SET BINFODS=0
End DoDot:1
+40 ;
+41 ;---> Forecast.
+42 IF ((BINFODS[15)!BIALL)
DO WRITE(.BILINE)
DO FORECAST(.BILINE,BIDFN,$GET(BIFDT))
+43 ;
+44 ;---> Address.
+45 IF ((BINFODS[12)!BIALL)
Begin DoDot:1
+46 NEW X
SET X="Address..: "_$EXTRACT($$STREET^BIUTL1(BIDFN),1,38)
+47 SET BIPLIN1=BIPLIN1+1
+48 DO APPEND(BIPLIN1,X,.BILINE)
+49 SET X=" "_$$CTYSTZ^BIUTL1(BIDFN)
SET BIPLIN1=BIPLIN1+1
+50 DO APPEND(BIPLIN1,X,.BILINE)
End DoDot:1
+51 ;
+52 ;---> Phone Number.
+53 IF ((BINFODS[11)!BIALL)
Begin DoDot:1
+54 NEW X
SET X="Phone....: "_$$HPHONE^BIUTL1(BIDFN)
SET BIPLIN1=BIPLIN1+1
+55 DO APPEND(BIPLIN1,X,.BILINE)
End DoDot:1
+56 ;
+57 ;---> Parent/Guardian.
+58 IF ((BINFODS[17)!BIALL)
Begin DoDot:1
+59 NEW X
SET X="Parent...: "_$$PARENT^BIUTL1(BIDFN)
SET BIPLIN1=BIPLIN1+1
+60 DO APPEND(BIPLIN1,X,.BILINE)
End DoDot:1
+61 ;
+62 ;---> Case Manager.
+63 IF ((BINFODS[18)!BIALL)
Begin DoDot:1
+64 NEW X
SET X="Case Mgr.: "_$$CMGR^BIUTL1(BIDFN,1,1)
SET BIPLIN1=BIPLIN1+1
+65 DO APPEND(BIPLIN1,X,.BILINE)
End DoDot:1
+66 ;
+67 ;---> Reason Inactivated.
+68 IF ((BINFODS[19)!BIALL)
Begin DoDot:1
+69 IF ('$$INACT^BIUTL1(BIDFN))
QUIT
+70 NEW X
SET X="Inactive.: "_$$INACTRE^BIUTL1(BIDFN)
SET BIPLIN1=BIPLIN1+1
+71 DO APPEND(BIPLIN1,X,.BILINE)
End DoDot:1
+72 ;
+73 ;---> Immunization History.
+74 IF (BINFODS[13)!(BINFODS[14)!(BINFODS[20)!(BINFODS[22)!(BINFODS[25)!BIALL
Begin DoDot:1
+75 ;---> Write either History or History w/Lot#'s, VFC, with or without Skin Tests.
+76 NEW X
Begin DoDot:2
+77 IF (BINFODS[14)&(BINFODS'[25)
SET X=2
QUIT
+78 IF (BINFODS'[14)&(BINFODS[25)
SET X=5
QUIT
+79 IF (BINFODS[14)&(BINFODS[25)
SET X=7
QUIT
+80 SET X=1
End DoDot:2
+81 ;
+82 ;---> Include location where shot was given.
+83 NEW Y
SET Y=$SELECT(BINFODS[22:1,1:0)
+84 NEW Z
SET Z=1
+85 IF (BINFODS[20)
Begin DoDot:2
+86 IF ((BINFODS'[13)&(BINFODS'[14)&(BINFODS'[25))
SET Z=2
QUIT
+87 SET Z=0
End DoDot:2
+88 DO WRITE(.BILINE)
DO WRITE(.BILINE," History:")
+89 DO HISTORY1^BILETPR1(.BILINE,BIDFN,X,,"BIDULV",,,Z,Y,.BIMMRF,.BIMMLF)
End DoDot:1
+90 ;
+91 ;
+92 ;---> Refusals.
+93 IF ((BINFODS[23)!BIALL)
Begin DoDot:1
+94 NEW A,X1,X2,X3
SET (X1,X2,X3)=""
+95 DO CONTRA^BIUTL11(BIDFN,.A,1,1)
+96 IF ('$DATA(A))
QUIT
+97 DO WRITE(.BILINE)
+98 SET X1=" Refusals: "
+99 NEW N,M
SET N=0
SET M=0
+100 FOR
SET N=$ORDER(A(N))
IF 'N
QUIT
Begin DoDot:2
+101 NEW X
SET M=M+1
+102 SET X=$$VNAME^BIUTL2($$HL7TX^BIUTL2(N))_" ("_$$SLDT2^BIUTL5($PIECE(A(N),U,2),1)_")"
+103 IF "235689"[M
SET X=", "_X
+104 IF M<4
SET X1=X1_X
QUIT
+105 IF M<7
IF M=4
SET X2=" "
SET X1=X1_","
SET X2=X2_X
QUIT
+106 IF M=7
SET X3=" "
SET X2=X2_","
SET X3=X3_X
QUIT
End DoDot:2
+107 IF X1]""
DO WRITE(.BILINE,X1)
+108 IF X2]""
DO WRITE(.BILINE,X2)
+109 IF X3]""
DO WRITE(.BILINE,X3)
End DoDot:1
+110 ;
+111 ;---> Next Appointment.
+112 IF ((BINFODS[21)!BIALL)
Begin DoDot:1
+113 ;---> Write either Patient's Next Appointment if there is one.
+114 NEW X
SET X=$$NEXTAPPT^BIUTL11(BIDFN)
+115 IF X]""
Begin DoDot:2
+116 SET X=" Next Appointment: "_$EXTRACT(X,1,57)
+117 DO WRITE(.BILINE)
DO WRITE(.BILINE,X)
End DoDot:2
End DoDot:1
+118 ;
+119 ;---> Directions to House.
+120 IF ((BINFODS[16)!BIALL)
Begin DoDot:1
+121 IF '$ORDER(^AUPNPAT(BIDFN,12,0))
QUIT
+122 DO WRITE(.BILINE)
+123 NEW X
SET X=" Directions to the home of "_$$NAME^BIUTL1(BIDFN,1)_":"
+124 DO WRITE(.BILINE,X)
+125 NEW N
SET N=0
+126 FOR
SET N=$ORDER(^AUPNPAT(BIDFN,12,N))
IF 'N
QUIT
Begin DoDot:2
+127 SET X=$GET(^AUPNPAT(BIDFN,12,N,0))
+128 DO WRITE(.BILINE," "_X)
End DoDot:2
End DoDot:1
+129 ;
+130 IF '$GET(BIDASH)
DO WRITE(.BILINE," "_$$SP^BIUTL5(73,"-"))
+131 ;---> Mark the top line of this record with the total lines in it.
+132 DO MARK^BIW(BIPLIN,BILINE-BIPLIN,"BIDULV")
+133 QUIT
+134 ;
+135 ;
+136 ;----------
FORECAST(BILINE,BIDFN,BIFDT) ;EP
+1 ;---> Retrieve and store Imm Forecast in WP ^TMP global.
+2 ;---> Parameters:
+3 ; 2 - BILINE (ret) Last line written into ^TMP array.
+4 ; 3 - BIDFN (req) Patient's IEN in VA PATIENT File #2.
+5 ; 4 - BIFDT (opt) Forecast Date.
+6 ;
+7 IF '$DATA(BILINE)
QUIT
IF '$GET(BIDFN)
QUIT
+8 ;
+9 ;---> If Patient is deceased, display date instead of forecast.
+10 NEW X
SET X=$$DECEASED^BIUTL1(BIDFN,1)
+11 IF X
DO WRITE(.BILINE)
DO WRITE(.BILINE," DECEASED: "_$$TXDT^BIUTL5(X))
QUIT
+12 ;
+13 ;---> If Forecast Date not provided, set it equal to today.
+14 IF '$GET(BIFDT)
SET BIFDT=DT
+15 ;
+16 ;---> RPC to gather Immunization History.
+17 ; BIRETVAL - Return value of valid data from RPC.
+18 ; BIRETERR - Return value (text string) of error from RPC.
+19 ;
+20 NEW BIRETVAL,BIRETERR
SET BIRETVAL=""
+21 ;---> Next line: 4th param=1 to not call Immserve because forecast
+22 ;---> just got updated in retrieving patients: +225^BIDUR.
+23 DO IMMFORC^BIRPC(.BIRETVAL,BIDFN,BIFDT,1)
+24 ;
+25 ;---> If BIRETERR has a value, store it and quit.
+26 SET BIRETERR=$PIECE(BIRETVAL,BI31,2)
+27 IF BIRETERR]""
Begin DoDot:1
+28 DO WRITE(.BILINE)
DO WRITE(.BILINE," "_BIRETERR)
DO WRITE(.BILINE)
End DoDot:1
QUIT
+29 ;
+30 ;---> Set BIFDTORC=to the Immunization Forecast for this patient.
+31 NEW BIFDTORC,I,V
SET V="|"
SET BIFDTORC=$PIECE(BIRETVAL,BI31,1)
+32 ;
+33 ;---> Loop through "^"-pieces of Imm Forecast, getting data.
+34 FOR I=1:1
SET Y=$PIECE(BIFDTORC,U,I)
IF Y=""
QUIT
Begin DoDot:1
+35 NEW X,Z
SET X=$SELECT(I=1:" Needs: ",1:" ")
+36 ;---> If the forecast for this vaccine contains an error,
+37 ;---> write Vaccine Group Name Error, such as, $P("DTP ERROR:",":").
+38 SET Z=$PIECE(Y,V)
SET Z=X_$PIECE(Z,":")
+39 DO WRITE(.BILINE,Z)
End DoDot:1
+40 QUIT
+41 ;
+42 ;
+43 ;----------
WRITE(BILINE,BIVAL) ;EP
+1 ;---> Write a line to the ^TMP global for WP or Listman.
+2 ;---> Parameters:
+3 ; 1 - BILINE (ret) Last line# in the WP ^TMP global.
+4 ; 2 - BIVAL (opt) Value/text of line (Null=blank line).
+5 ;
+6 IF '$DATA(BILINE)
QUIT
+7 IF $GET(BIVAL)=""
SET BIVAL=" "
+8 SET BILINE=BILINE+1
SET ^TMP("BIDULV",$JOB,BILINE,0)=BIVAL
+9 QUIT
+10 ;
+11 ;
+12 ;----------
APPEND(BIPLIN1,BIVAL,BILINE) ;EP
+1 ;---> Append BIVAL to existing line or create new line.
+2 ;---> Parameters:
+3 ; 1 - BIPLIN1 (ret) Line down from demog line to be added to.
+4 ; 2 - BIVAL (opt) Value/text of line (Null=blank line).
+5 ; 3 - BILINE (ret) Last line# in the WP ^TMP global.
+6 ;
+7 IF '$DATA(BILINE)
QUIT
+8 IF $GET(BIVAL)=""
QUIT
+9 ;
+10 ;---> If line already exists, append to it.
+11 NEW X
+12 IF $DATA(^TMP("BIDULV",$JOB,BIPLIN1,0))
SET X=^(0)
Begin DoDot:1
+13 SET X=$$PAD^BIUTL5(X,32)_BIVAL
+14 SET ^TMP("BIDULV",$JOB,BIPLIN1,0)=X
End DoDot:1
QUIT
+15 ;
+16 ;---> If line doesn't exist, create it.
+17 DO WRITE(.BILINE,$$SP^BIUTL5(32)_BIVAL)
+18 QUIT
