BILETPR4 ;IHS/CMI/MWR - PRINT PATIENT LETTER; MAY 10, 2010
;;8.5;IMMUNIZATION;;SEP 01,2011
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; PRINT INDIVIDUAL PATIENT LETTERS.
;; PATCH 1: Add ability to print a second street address line. PRINT+23
;
;
;----------
PRINT(BIDFN,IO,IOST,BIERR) ;EP
;---> Print patient letter.
;---> Parameters:
; 1 - BIDFN (req) Patient's IEN (DFN).
; 2 - IO (req) Output Device $I.
; 3 - IOST (req) Subtype Name.
; 4 - BIERR (ret) Error Code, if any.
;
;---> CodeChange for v7.1 - IHS/CMI/MWR 12/01/2000:
;---> To eliminate control chars from printouts.
;D FULL^VALM1
N BICRT S BICRT=$S(($E(IOST)="C")!(IOST["BROWSER"):1,1:0)
;
I '$G(BIDFN) S BIERR=201 Q
I '$D(^DPT(BIDFN,0)) S BIERR=203 Q
I '$D(^TMP("BILET",$J)) S BIERR=637 Q
;
;
U IO
;---> To eliminate control chars from printouts.
I BICRT D FULL^VALM1 W @IOF
;
;********** PATCH 1, SEP 21,2006, IHS/CMI/MWR
;---> Several line changes follow to allow printing of second street
;---> address line, if it is on the form letter and if the patient
;---> has data. Otherwise, skip printing that line (do not print blank).
;
;---> Loop through ^TMP("BILET",$J, writing lines of letter.
N N S N=0
F S N=$O(^TMP("BILET",$J,N)) Q:'N D Q:BIPOP
.;
.;---> Set BILINE=text of a line in the letter.
.N BILINE S BILINE=^TMP("BILET",$J,N,0)
.N BIBLNKL,BISTRT2 S BISTRT2=0,BIBLNKL=$$PAD^BIUTL5(" ",80," ")
.;
.;---> Won't fit on the bottom of this page, do formfeed.
.I N>1 I $Y+5>IOSL D Q:BIPOP W @IOF
..D:BICRT DIRZ^BIUTL3(.BIPOP)
.;
.;---> If line contains Functions, process them.
.D:BILINE["|"
..;---> BIPCS=number of "|"-pieces in this line.
..S BIPCS=$L(BILINE,"|")
..N BILINE1 S BILINE1=""
..F I=1:1:BIPCS D
...N X S X=$P(BILINE,"|",I)
...;
...;---> If this is an even piece, it should contain a function.
...D:'(I#2)
....Q:X=""
....I X="BI MAILING ADD-STREET-2" S BISTRT2=1
....;---> Look up function by name.
....N Z S Z=$O(^DD("FUNC","B",X,0))
....Q:'Z
....S X=$G(^DD("FUNC",Z,1))
....Q:X=""
....X X
....;---> If "Street-2" is blank, pad it in case more follows on that line.
....I X=""&$G(BISTRT2) S X=" "
...S BILINE1=BILINE1_X
..;
..;---> Reset line with functions processed.
..S BILINE=BILINE1
.;
.;---> If this is a "Street-2" line but it's entirely blank, don't print it.
.I ($G(BISTRT2))&(BIBLNKL[BILINE) Q
.;---> Okay, print.
.W !,BILINE
;
W:'BICRT @IOF D:(BICRT&('BIPOP)) DIRZ^BIUTL3()
Q
BILETPR4 ;IHS/CMI/MWR - PRINT PATIENT LETTER; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;;SEP 01,2011
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; PRINT INDIVIDUAL PATIENT LETTERS.
+4 ;; PATCH 1: Add ability to print a second street address line. PRINT+23
+5 ;
+6 ;
+7 ;----------
PRINT(BIDFN,IO,IOST,BIERR) ;EP
+1 ;---> Print patient letter.
+2 ;---> Parameters:
+3 ; 1 - BIDFN (req) Patient's IEN (DFN).
+4 ; 2 - IO (req) Output Device $I.
+5 ; 3 - IOST (req) Subtype Name.
+6 ; 4 - BIERR (ret) Error Code, if any.
+7 ;
+8 ;---> CodeChange for v7.1 - IHS/CMI/MWR 12/01/2000:
+9 ;---> To eliminate control chars from printouts.
+10 ;D FULL^VALM1
+11 NEW BICRT
SET BICRT=$SELECT(($EXTRACT(IOST)="C")!(IOST["BROWSER"):1,1:0)
+12 ;
+13 IF '$GET(BIDFN)
SET BIERR=201
QUIT
+14 IF '$DATA(^DPT(BIDFN,0))
SET BIERR=203
QUIT
+15 IF '$DATA(^TMP("BILET",$JOB))
SET BIERR=637
QUIT
+16 ;
+17 ;
+18 USE IO
+19 ;---> To eliminate control chars from printouts.
+20 IF BICRT
DO FULL^VALM1
WRITE @IOF
+21 ;
+22 ;********** PATCH 1, SEP 21,2006, IHS/CMI/MWR
+23 ;---> Several line changes follow to allow printing of second street
+24 ;---> address line, if it is on the form letter and if the patient
+25 ;---> has data. Otherwise, skip printing that line (do not print blank).
+26 ;
+27 ;---> Loop through ^TMP("BILET",$J, writing lines of letter.
+28 NEW N
SET N=0
+29 FOR
SET N=$ORDER(^TMP("BILET",$JOB,N))
IF 'N
QUIT
Begin DoDot:1
+30 ;
+31 ;---> Set BILINE=text of a line in the letter.
+32 NEW BILINE
SET BILINE=^TMP("BILET",$JOB,N,0)
+33 NEW BIBLNKL,BISTRT2
SET BISTRT2=0
SET BIBLNKL=$$PAD^BIUTL5(" ",80," ")
+34 ;
+35 ;---> Won't fit on the bottom of this page, do formfeed.
+36 IF N>1
IF $Y+5>IOSL
Begin DoDot:2
+37 IF BICRT
DO DIRZ^BIUTL3(.BIPOP)
End DoDot:2
IF BIPOP
QUIT
WRITE @IOF
+38 ;
+39 ;---> If line contains Functions, process them.
+40 IF BILINE["|"
Begin DoDot:2
+41 ;---> BIPCS=number of "|"-pieces in this line.
+42 SET BIPCS=$LENGTH(BILINE,"|")
+43 NEW BILINE1
SET BILINE1=""
+44 FOR I=1:1:BIPCS
Begin DoDot:3
+45 NEW X
SET X=$PIECE(BILINE,"|",I)
+46 ;
+47 ;---> If this is an even piece, it should contain a function.
+48 IF '(I#2)
Begin DoDot:4
+49 IF X=""
QUIT
+50 IF X="BI MAILING ADD-STREET-2"
SET BISTRT2=1
+51 ;---> Look up function by name.
+52 NEW Z
SET Z=$ORDER(^DD("FUNC","B",X,0))
+53 IF 'Z
QUIT
+54 SET X=$GET(^DD("FUNC",Z,1))
+55 IF X=""
QUIT
+56 XECUTE X
+57 ;---> If "Street-2" is blank, pad it in case more follows on that line.
+58 IF X=""&$GET(BISTRT2)
SET X=" "
End DoDot:4
+59 SET BILINE1=BILINE1_X
End DoDot:3
+60 ;
+61 ;---> Reset line with functions processed.
+62 SET BILINE=BILINE1
End DoDot:2
+63 ;
+64 ;---> If this is a "Street-2" line but it's entirely blank, don't print it.
+65 IF ($GET(BISTRT2))&(BIBLNKL[BILINE)
QUIT
+66 ;---> Okay, print.
+67 WRITE !,BILINE
End DoDot:1
IF BIPOP
QUIT
+68 ;
+69 IF 'BICRT
WRITE @IOF
IF (BICRT&('BIPOP))
DO DIRZ^BIUTL3()
+70 QUIT
