BILETPR ;IHS/CMI/MWR - PRINT PATIENT LETTERS.; MAY 10, 2010
;;8.5;IMMUNIZATION;**5**;JUL 01,2013
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; PRINT PATIENT LETTERS.
;; PATCH 5: Add call to log Notification by iCARE API. PRINT+65
;
;
;----------
START ; EP
;---> Print letters for individual patients (loop).
;---> Allows selection of patient and letter.
;
D SETVARS^BIUTL5 S (BIPOP1,BIPOP)=0
N BILET,BITITLE
F S BIPOP=0 D Q:BIPOP1
.D PATIENT(.BIDFN,.BIPOP1) Q:BIPOP1
.D ASKLET(.BILET,.BIDLOC,.BIPOP) Q:BIPOP
.D DEVICE Q:BIPOP
.D PRINT(BIDFN,BILET,$G(BIDLOC),ION)
D ^%ZISC
D EXIT
Q
;
;
;----------
PATIENT(BIDFN,BIPOP) ;EP
;---> Select Patient.
;---> Parameters:
; 1 - BIDFN (ret) Patient's IEN in VA PATIENT File #2.
; 2 - BIPOP (ret) BIPOP=1 if selection failed.
;
S BIPOP=0
D TITLE^BIUTL5("PRINT INDIVIDUAL LETTERS")
D PATLKUP^BIUTL8(.BIDFN)
S:BIDFN<1 BIPOP=1
Q
;
;
;----------
ASKLET(BILET,BIDLOC,BIPOP,BIDFLT) ;EP
;---> Select Form Letter.
;---> Parameters:
; 1 - BILET (ret) IEN of Form Letter.
; 2 - BIDLOC (ret) Text of Date/Location line.
; 3 - BIPOP (ret) BIPOP=1 if selection failed.
; 3 - BIDFLT (opt) IEN of default letter.
;
N X,Y S BIPOP=0
;
D
.I $G(BIDFLT) I $D(^BILET(BIDFLT,0)) S BIDFLT=$P(^(0),U) Q
.S BIDFLT=""
;
;---> Select Form Letter.
W !!?3,"Please select the Form Letter you wish to use."
W !?3,"Type ""?"" (no quotes) to see a list of available letters.",!!
D DIC^BIFMAN(9002084.4,"QEMA",.Y," Select Form Letter: ",BIDFLT)
I Y<1 S BIPOP=1 Q
S BILET=+Y
;
;---> If this letter prints a Date/Location line, prompt for it.
D ASKDLOC(BILET,.BIDLOC,.BIPOP)
Q
;
;
;----------
ASKDLOC(BILET,BIDLOC,BIPOP) ;EP
;---> Ask for Date/Location line (up to 70 characters).
;---> Parameters:
; 1 - BILET (req) IEN of Form Letter.
; 2 - BIDLOC (ret) Text of Date/Location line.
; 3 - BIPOP (ret) BIPOP=1 if selection failed.
;
Q:'$G(BILET) Q:'$D(^BILET(BILET,0))
;---> Quit if this letter does not print a Date/Location line.
Q:'$P(^BILET(BILET,0),U,4)
D TITLE^BIUTL5("DATE/LOCATION LINE"),TEXT1
N DIR,DIRUT S BIPOP=0
S DIR("?")=" Enter the text of the Date/Location Line (up to 70 "
S DIR("?")=DIR("?")_"characters long)"
S DIR(0)="FA^1:70",DIR("A")=" "
S:$D(^BIDLOC(DUZ,0)) DIR("B")=$P(^(0),U,2)
D ^DIR
I $D(DIRUT) S BIPOP=1 Q
S BIDLOC=Y
;
;---> Now store user's Date-Loc Line.
Q:BIDLOC=""
Q:DUZ=0
;---> Clear any previous Date-Loc Line for this user.
K ^BIDLOC(DUZ),^BIDLOC("B",DUZ)
;---> Store this Date-Loc Line for this user.
S ^BIDLOC(DUZ,0)=DUZ_U_BIDLOC,^BIDLOC("B",DUZ,DUZ)=""
Q
;
;
;----------
PRINT(BIDFN,BILET,BIDLOC,IOP,BIFDT,BIPOP) ;EP
;---> Print a letter for a patient.
;---> 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 - IOP (req) Output Device Name. (Will inhibit ^DIWF from
; prompting for Device. Should be equal to ION.)
; 5 - BIFDT (opt) Forecast Date (=Today if not given).
; 6 - BIPOP (ret) If BIPOP=1, output was to screen and user
; entered "^".
;
;---> CodeChange for v7.1 - IHS/CMI/MWR 12/01/2000:
;---> Next line, if IOP not passed, set to ION.
;S:'$D(IOP) IOP="HOME"
S:'$D(IOP) IOP=$G(ION) S:IOP="" IOP="HOME"
S BIPOP=0
;
;---> If this is not a printer, set BICRT=1
N BICRT
S BICRT=$S(($E(IOST)="C")!(IOST["BROWSER"):1,1:0)
;
U IO
N BIERR
I '$G(BIDFN) D ERRCD^BIUTL2(201,,1) Q
I '$D(^DPT(BIDFN,0)) D ERRCD^BIUTL2(203,,1) Q
I '$G(BILET) D ERRCD^BIUTL2(609,,1) Q
I '$D(^BILET(BILET,0)) D ERRCD^BIUTL2(610,,1) Q
S:'$G(BIFDT) BIFDT=DT
;
;
;---> Quit if Patient is locked.
L +^BIP(BIDFN):1 I '$T U IO D Q
.W !!?5,"The selected Patient is being edited by another user."
.W !?5,"Please try printing this letter later."
.W:'BICRT @IOF D:BICRT DIRZ^BIUTL3()
;
;---> If patient is deceased, don't print letter; print explanation.
I $$DECEASED^BIUTL1(BIDFN) D Q
.D DECEASED(BIDFN,BICRT),UNLOCK^BIPATUP(BIDFN)
;
;---> Build temporary global of populated letter in ^TMP("BILET",$J).
D BUILD^BILETPR1(BIDFN,BILET,$G(BIDLOC),$G(BIFDT))
;
;---> Now print.
;---> Call homegrown letter printer.
D PRINT^BILETPR4(BIDFN,IO,IOST,.BIERR)
;
;---> If error printing, display/write and quit.
I $G(BIERR) D Q
.D ERRCD^BIUTL2(BIERR,,1),UNLOCK^BIPATUP(BIDFN),^%ZISC
;
;---> If this was to the screen, don't store "DATE OF LAST LETTER".
D:BICRT
.W !!?3,"NOTE: Because this letter was only displayed on a screen and"
.W !?9,"not printed on a printer, it will NOT yet be logged by the"
.W !?9,"program as having been printed and sent to the patient.",!
.D DIRZ^BIUTL3(.BIPOP)
;
;---> Close Device.
D ^%ZISC
;
;---> Store the date of this letter in the DATE OF LAST LETTER
;---> field of the BI PATIENT File.
;
;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
;---> Add call to log Notification by iCARE API.
;I 'BICRT,$D(^BIP(BIDFN,0)) D DIE^BIFMAN(9002084,".14////"_DT,BIDFN)
I 'BICRT,$D(^BIP(BIDFN,0)) D
.D DIE^BIFMAN(9002084,".14////"_DT,BIDFN)
.I $T(LOG^BQINOTR)]"" D LOG^BQINOTR(BIDFN,"LETTER","",BILET,"","IMMUNIZATIONS","")
;**********
;
D UNLOCK^BIPATUP(BIDFN)
Q
;
;
;----------
DEVICE ;EP
;---> Get Device and possibly queue to Taskman.
K %ZIS,IOP
S ZTRTN="PRINT^BILETPR(BIDFN,BILET,$G(BIDLOC),,$G(BIFDT))"
D ZSAVES^BIUTL3
D ZIS^BIUTL2(.BIPOP,1)
Q
;
;
;----------
DECEASED(BIDFN,BICRT) ;EP
;---> If the patient is deceased, display message.
;---> Parameters:
; 1 - BIDFN (req) Patient's IEN in VA PATIENT File #2.
; 2 - BICRT (req) BICRT=1 if output is to screen or Browser.
;
W !!?3,"NOTE: Because this patient"
I $G(BIDFN) I $D(^DPT(BIDFN,0)) D
.W ", ",$$NAME^BIUTL1(BIDFN)," #",$$HRCN^BIUTL1(BIDFN),","
W " is now"
W !?9,"registered as deceased, the letter will NOT be printed."
W !?9,"This patient should be inactivated in the Immunization "
W "Register."
D:BICRT DIRZ^BIUTL3() W:'BICRT @IOF
Q
;
;
;----------
EXIT ;EP
D KILLALL^BIUTL8(1)
Q
;
;
;----------
TEXT1 ;EP
;;The letter you have selected prints a Date/Location line between
;;between the Bottom Section and the Closing Section of the letter.
;;An example would be:
;;
;; 5-May-1998 at the Children's Clinic, Alaska Native Medical Center
;;
;;This line may be up to 70 characters long.
;;Please enter/edit the Date/Location line now.
;;
;;Line:
;;
D PRINTX("TEXT1",5)
Q
;
;
;----------
PRINTX(BILINL,BITAB) ;EP
N BITEXT,I,T,X S T="" F I=1:1:BITAB S T=T_" "
F I=1:1 S X=$T(@BILINL+I) Q:X'[";;" S BITEXT(I)=T_$P(X,";;",2)
D EN^DDIOL(.BITEXT)
Q
BILETPR ;IHS/CMI/MWR - PRINT PATIENT LETTERS.; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;**5**;JUL 01,2013
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; PRINT PATIENT LETTERS.
+4 ;; PATCH 5: Add call to log Notification by iCARE API. PRINT+65
+5 ;
+6 ;
+7 ;----------
START ; EP
+1 ;---> Print letters for individual patients (loop).
+2 ;---> Allows selection of patient and letter.
+3 ;
+4 DO SETVARS^BIUTL5
SET (BIPOP1,BIPOP)=0
+5 NEW BILET,BITITLE
+6 FOR
SET BIPOP=0
Begin DoDot:1
+7 DO PATIENT(.BIDFN,.BIPOP1)
IF BIPOP1
QUIT
+8 DO ASKLET(.BILET,.BIDLOC,.BIPOP)
IF BIPOP
QUIT
+9 DO DEVICE
IF BIPOP
QUIT
+10 DO PRINT(BIDFN,BILET,$GET(BIDLOC),ION)
End DoDot:1
IF BIPOP1
QUIT
+11 DO ^%ZISC
+12 DO EXIT
+13 QUIT
+14 ;
+15 ;
+16 ;----------
PATIENT(BIDFN,BIPOP) ;EP
+1 ;---> Select Patient.
+2 ;---> Parameters:
+3 ; 1 - BIDFN (ret) Patient's IEN in VA PATIENT File #2.
+4 ; 2 - BIPOP (ret) BIPOP=1 if selection failed.
+5 ;
+6 SET BIPOP=0
+7 DO TITLE^BIUTL5("PRINT INDIVIDUAL LETTERS")
+8 DO PATLKUP^BIUTL8(.BIDFN)
+9 IF BIDFN<1
SET BIPOP=1
+10 QUIT
+11 ;
+12 ;
+13 ;----------
ASKLET(BILET,BIDLOC,BIPOP,BIDFLT) ;EP
+1 ;---> Select Form Letter.
+2 ;---> Parameters:
+3 ; 1 - BILET (ret) IEN of Form Letter.
+4 ; 2 - BIDLOC (ret) Text of Date/Location line.
+5 ; 3 - BIPOP (ret) BIPOP=1 if selection failed.
+6 ; 3 - BIDFLT (opt) IEN of default letter.
+7 ;
+8 NEW X,Y
SET BIPOP=0
+9 ;
+10 Begin DoDot:1
+11 IF $GET(BIDFLT)
IF $DATA(^BILET(BIDFLT,0))
SET BIDFLT=$PIECE(^(0),U)
QUIT
+12 SET BIDFLT=""
End DoDot:1
+13 ;
+14 ;---> Select Form Letter.
+15 WRITE !!?3,"Please select the Form Letter you wish to use."
+16 WRITE !?3,"Type ""?"" (no quotes) to see a list of available letters.",!!
+17 DO DIC^BIFMAN(9002084.4,"QEMA",.Y," Select Form Letter: ",BIDFLT)
+18 IF Y<1
SET BIPOP=1
QUIT
+19 SET BILET=+Y
+20 ;
+21 ;---> If this letter prints a Date/Location line, prompt for it.
+22 DO ASKDLOC(BILET,.BIDLOC,.BIPOP)
+23 QUIT
+24 ;
+25 ;
+26 ;----------
ASKDLOC(BILET,BIDLOC,BIPOP) ;EP
+1 ;---> Ask for Date/Location line (up to 70 characters).
+2 ;---> Parameters:
+3 ; 1 - BILET (req) IEN of Form Letter.
+4 ; 2 - BIDLOC (ret) Text of Date/Location line.
+5 ; 3 - BIPOP (ret) BIPOP=1 if selection failed.
+6 ;
+7 IF '$GET(BILET)
QUIT
IF '$DATA(^BILET(BILET,0))
QUIT
+8 ;---> Quit if this letter does not print a Date/Location line.
+9 IF '$PIECE(^BILET(BILET,0),U,4)
QUIT
+10 DO TITLE^BIUTL5("DATE/LOCATION LINE")
DO TEXT1
+11 NEW DIR,DIRUT
SET BIPOP=0
+12 SET DIR("?")=" Enter the text of the Date/Location Line (up to 70 "
+13 SET DIR("?")=DIR("?")_"characters long)"
+14 SET DIR(0)="FA^1:70"
SET DIR("A")=" "
+15 IF $DATA(^BIDLOC(DUZ,0))
SET DIR("B")=$PIECE(^(0),U,2)
+16 DO ^DIR
+17 IF $DATA(DIRUT)
SET BIPOP=1
QUIT
+18 SET BIDLOC=Y
+19 ;
+20 ;---> Now store user's Date-Loc Line.
+21 IF BIDLOC=""
QUIT
+22 IF DUZ=0
QUIT
+23 ;---> Clear any previous Date-Loc Line for this user.
+24 KILL ^BIDLOC(DUZ),^BIDLOC("B",DUZ)
+25 ;---> Store this Date-Loc Line for this user.
+26 SET ^BIDLOC(DUZ,0)=DUZ_U_BIDLOC
SET ^BIDLOC("B",DUZ,DUZ)=""
+27 QUIT
+28 ;
+29 ;
+30 ;----------
PRINT(BIDFN,BILET,BIDLOC,IOP,BIFDT,BIPOP) ;EP
+1 ;---> Print a letter for a patient.
+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 - IOP (req) Output Device Name. (Will inhibit ^DIWF from
+7 ; prompting for Device. Should be equal to ION.)
+8 ; 5 - BIFDT (opt) Forecast Date (=Today if not given).
+9 ; 6 - BIPOP (ret) If BIPOP=1, output was to screen and user
+10 ; entered "^".
+11 ;
+12 ;---> CodeChange for v7.1 - IHS/CMI/MWR 12/01/2000:
+13 ;---> Next line, if IOP not passed, set to ION.
+14 ;S:'$D(IOP) IOP="HOME"
+15 IF '$DATA(IOP)
SET IOP=$GET(ION)
IF IOP=""
SET IOP="HOME"
+16 SET BIPOP=0
+17 ;
+18 ;---> If this is not a printer, set BICRT=1
+19 NEW BICRT
+20 SET BICRT=$SELECT(($EXTRACT(IOST)="C")!(IOST["BROWSER"):1,1:0)
+21 ;
+22 USE IO
+23 NEW BIERR
+24 IF '$GET(BIDFN)
DO ERRCD^BIUTL2(201,,1)
QUIT
+25 IF '$DATA(^DPT(BIDFN,0))
DO ERRCD^BIUTL2(203,,1)
QUIT
+26 IF '$GET(BILET)
DO ERRCD^BIUTL2(609,,1)
QUIT
+27 IF '$DATA(^BILET(BILET,0))
DO ERRCD^BIUTL2(610,,1)
QUIT
+28 IF '$GET(BIFDT)
SET BIFDT=DT
+29 ;
+30 ;
+31 ;---> Quit if Patient is locked.
+32 LOCK +^BIP(BIDFN):1
IF '$TEST
USE IO
Begin DoDot:1
+33 WRITE !!?5,"The selected Patient is being edited by another user."
+34 WRITE !?5,"Please try printing this letter later."
+35 IF 'BICRT
WRITE @IOF
IF BICRT
DO DIRZ^BIUTL3()
End DoDot:1
QUIT
+36 ;
+37 ;---> If patient is deceased, don't print letter; print explanation.
+38 IF $$DECEASED^BIUTL1(BIDFN)
Begin DoDot:1
+39 DO DECEASED(BIDFN,BICRT)
DO UNLOCK^BIPATUP(BIDFN)
End DoDot:1
QUIT
+40 ;
+41 ;---> Build temporary global of populated letter in ^TMP("BILET",$J).
+42 DO BUILD^BILETPR1(BIDFN,BILET,$GET(BIDLOC),$GET(BIFDT))
+43 ;
+44 ;---> Now print.
+45 ;---> Call homegrown letter printer.
+46 DO PRINT^BILETPR4(BIDFN,IO,IOST,.BIERR)
+47 ;
+48 ;---> If error printing, display/write and quit.
+49 IF $GET(BIERR)
Begin DoDot:1
+50 DO ERRCD^BIUTL2(BIERR,,1)
DO UNLOCK^BIPATUP(BIDFN)
DO ^%ZISC
End DoDot:1
QUIT
+51 ;
+52 ;---> If this was to the screen, don't store "DATE OF LAST LETTER".
+53 IF BICRT
Begin DoDot:1
+54 WRITE !!?3,"NOTE: Because this letter was only displayed on a screen and"
+55 WRITE !?9,"not printed on a printer, it will NOT yet be logged by the"
+56 WRITE !?9,"program as having been printed and sent to the patient.",!
+57 DO DIRZ^BIUTL3(.BIPOP)
End DoDot:1
+58 ;
+59 ;---> Close Device.
+60 DO ^%ZISC
+61 ;
+62 ;---> Store the date of this letter in the DATE OF LAST LETTER
+63 ;---> field of the BI PATIENT File.
+64 ;
+65 ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
+66 ;---> Add call to log Notification by iCARE API.
+67 ;I 'BICRT,$D(^BIP(BIDFN,0)) D DIE^BIFMAN(9002084,".14////"_DT,BIDFN)
+68 IF 'BICRT
IF $DATA(^BIP(BIDFN,0))
Begin DoDot:1
+69 DO DIE^BIFMAN(9002084,".14////"_DT,BIDFN)
+70 IF $TEXT(LOG^BQINOTR)]""
DO LOG^BQINOTR(BIDFN,"LETTER","",BILET,"","IMMUNIZATIONS","")
End DoDot:1
+71 ;**********
+72 ;
+73 DO UNLOCK^BIPATUP(BIDFN)
+74 QUIT
+75 ;
+76 ;
+77 ;----------
DEVICE ;EP
+1 ;---> Get Device and possibly queue to Taskman.
+2 KILL %ZIS,IOP
+3 SET ZTRTN="PRINT^BILETPR(BIDFN,BILET,$G(BIDLOC),,$G(BIFDT))"
+4 DO ZSAVES^BIUTL3
+5 DO ZIS^BIUTL2(.BIPOP,1)
+6 QUIT
+7 ;
+8 ;
+9 ;----------
DECEASED(BIDFN,BICRT) ;EP
+1 ;---> If the patient is deceased, display message.
+2 ;---> Parameters:
+3 ; 1 - BIDFN (req) Patient's IEN in VA PATIENT File #2.
+4 ; 2 - BICRT (req) BICRT=1 if output is to screen or Browser.
+5 ;
+6 WRITE !!?3,"NOTE: Because this patient"
+7 IF $GET(BIDFN)
IF $DATA(^DPT(BIDFN,0))
Begin DoDot:1
+8 WRITE ", ",$$NAME^BIUTL1(BIDFN)," #",$$HRCN^BIUTL1(BIDFN),","
End DoDot:1
+9 WRITE " is now"
+10 WRITE !?9,"registered as deceased, the letter will NOT be printed."
+11 WRITE !?9,"This patient should be inactivated in the Immunization "
+12 WRITE "Register."
+13 IF BICRT
DO DIRZ^BIUTL3()
IF 'BICRT
WRITE @IOF
+14 QUIT
+15 ;
+16 ;
+17 ;----------
EXIT ;EP
+1 DO KILLALL^BIUTL8(1)
+2 QUIT
+3 ;
+4 ;
+5 ;----------
TEXT1 ;EP
+1 ;;The letter you have selected prints a Date/Location line between
+2 ;;between the Bottom Section and the Closing Section of the letter.
+3 ;;An example would be:
+4 ;;
+5 ;; 5-May-1998 at the Children's Clinic, Alaska Native Medical Center
+6 ;;
+7 ;;This line may be up to 70 characters long.
+8 ;;Please enter/edit the Date/Location line now.
+9 ;;
+10 ;;Line:
+11 ;;
+12 DO PRINTX("TEXT1",5)
+13 QUIT
+14 ;
+15 ;
+16 ;----------
PRINTX(BILINL,BITAB) ;EP
+1 NEW BITEXT,I,T,X
SET T=""
FOR I=1:1:BITAB
SET T=T_" "
+2 FOR I=1:1
SET X=$TEXT(@BILINL+I)
IF X'[";;"
QUIT
SET BITEXT(I)=T_$PIECE(X,";;",2)
+3 DO EN^DDIOL(.BITEXT)
+4 QUIT
