Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BILETPR

BILETPR.m

Go to the documentation of this file. 
  1. BILETPR ;IHS/CMI/MWR - PRINT PATIENT LETTERS.; MAY 10, 2010
  1.  ;;8.5;IMMUNIZATION;**5**;JUL 01,2013
  1.  ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
  1.  ;;  PRINT PATIENT LETTERS.
  1.  ;;  PATCH 5: Add call to log Notification by iCARE API.  PRINT+65
  1.  ;
  1.  ;
  1.  ;----------
  1. START ; EP
  1.  ;---> Print letters for individual patients (loop).
  1.  ;---> Allows selection of patient and letter.
  1.  ;
  1.  D SETVARS^BIUTL5 S (BIPOP1,BIPOP)=0
  1.  N BILET,BITITLE
  1.  F  S BIPOP=0 D  Q:BIPOP1
  1.  .D PATIENT(.BIDFN,.BIPOP1) Q:BIPOP1
  1.  .D ASKLET(.BILET,.BIDLOC,.BIPOP) Q:BIPOP
  1.  .D DEVICE Q:BIPOP
  1.  .D PRINT(BIDFN,BILET,$G(BIDLOC),ION)
  1.  D ^%ZISC
  1.  D EXIT
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. PATIENT(BIDFN,BIPOP) ;EP
  1.  ;---> Select Patient.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN  (ret) Patient's IEN in VA PATIENT File #2.
  1.  ;     2 - BIPOP  (ret) BIPOP=1 if selection failed.
  1.  ;
  1.  S BIPOP=0
  1.  D TITLE^BIUTL5("PRINT INDIVIDUAL LETTERS")
  1.  D PATLKUP^BIUTL8(.BIDFN)
  1.  S:BIDFN<1 BIPOP=1
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. ASKLET(BILET,BIDLOC,BIPOP,BIDFLT) ;EP
  1.  ;---> Select Form Letter.
  1.  ;---> Parameters:
  1.  ;     1 - BILET  (ret) IEN of Form Letter.
  1.  ;     2 - BIDLOC (ret) Text of Date/Location line.
  1.  ;     3 - BIPOP  (ret) BIPOP=1 if selection failed.
  1.  ;     3 - BIDFLT (opt) IEN of default letter.
  1.  ;
  1.  N X,Y S BIPOP=0
  1.  ;
  1.  D
  1.  .I $G(BIDFLT) I $D(^BILET(BIDFLT,0)) S BIDFLT=$P(^(0),U) Q
  1.  .S BIDFLT=""
  1.  ;
  1.  ;---> Select Form Letter.
  1.  W !!?3,"Please select the Form Letter you wish to use."
  1.  W !?3,"Type ""?"" (no quotes) to see a list of available letters.",!!
  1.  D DIC^BIFMAN(9002084.4,"QEMA",.Y,"   Select Form Letter: ",BIDFLT)
  1.  I Y<1 S BIPOP=1 Q
  1.  S BILET=+Y
  1.  ;
  1.  ;---> If this letter prints a Date/Location line, prompt for it.
  1.  D ASKDLOC(BILET,.BIDLOC,.BIPOP)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. ASKDLOC(BILET,BIDLOC,BIPOP) ;EP
  1.  ;---> Ask for Date/Location line (up to 70 characters).
  1.  ;---> Parameters:
  1.  ;     1 - BILET  (req) IEN of Form Letter.
  1.  ;     2 - BIDLOC (ret) Text of Date/Location line.
  1.  ;     3 - BIPOP  (ret) BIPOP=1 if selection failed.
  1.  ;
  1.  Q:'$G(BILET)  Q:'$D(^BILET(BILET,0))
  1.  ;---> Quit if this letter does not print a Date/Location line.
  1.  Q:'$P(^BILET(BILET,0),U,4)
  1.  D TITLE^BIUTL5("DATE/LOCATION LINE"),TEXT1
  1.  N DIR,DIRUT S BIPOP=0
  1.  S DIR("?")="     Enter the text of the Date/Location Line (up to 70 "
  1.  S DIR("?")=DIR("?")_"characters long)"
  1.  S DIR(0)="FA^1:70",DIR("A")="        "
  1.  S:$D(^BIDLOC(DUZ,0)) DIR("B")=$P(^(0),U,2)
  1.  D ^DIR
  1.  I $D(DIRUT) S BIPOP=1 Q
  1.  S BIDLOC=Y
  1.  ;
  1.  ;---> Now store user's Date-Loc Line.
  1.  Q:BIDLOC=""
  1.  Q:DUZ=0
  1.  ;---> Clear any previous Date-Loc Line for this user.
  1.  K ^BIDLOC(DUZ),^BIDLOC("B",DUZ)
  1.  ;---> Store this Date-Loc Line for this user.
  1.  S ^BIDLOC(DUZ,0)=DUZ_U_BIDLOC,^BIDLOC("B",DUZ,DUZ)=""
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. PRINT(BIDFN,BILET,BIDLOC,IOP,BIFDT,BIPOP) ;EP
  1.  ;---> Print a letter for a  patient.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN  (req) Patient's IEN in VA PATIENT File #2.
  1.  ;     2 - BILET  (req) IEN of Letter in BI LETTER File.
  1.  ;     3 - BIDLOC (opt) Text of Date/Location line.
  1.  ;     4 - IOP    (req) Output Device Name. (Will inhibit ^DIWF from
  1.  ;                      prompting for Device. Should be equal to ION.)
  1.  ;     5 - BIFDT  (opt) Forecast Date (=Today if not given).
  1.  ;     6 - BIPOP  (ret) If BIPOP=1, output was to screen and user
  1.  ;                      entered "^".
  1.  ;
  1.  ;---> CodeChange for v7.1 - IHS/CMI/MWR 12/01/2000:
  1.  ;---> Next line, if IOP not passed, set to ION.
  1.  ;S:'$D(IOP) IOP="HOME"
  1.  S:'$D(IOP) IOP=$G(ION) S:IOP="" IOP="HOME"
  1.  S BIPOP=0
  1.  ;
  1.  ;---> If this is not a printer, set BICRT=1
  1.  N BICRT
  1.  S BICRT=$S(($E(IOST)="C")!(IOST["BROWSER"):1,1:0)
  1.  ;
  1.  U IO
  1.  N BIERR
  1.  I '$G(BIDFN) D ERRCD^BIUTL2(201,,1) Q
  1.  I '$D(^DPT(BIDFN,0)) D ERRCD^BIUTL2(203,,1) Q
  1.  I '$G(BILET) D ERRCD^BIUTL2(609,,1) Q
  1.  I '$D(^BILET(BILET,0)) D ERRCD^BIUTL2(610,,1) Q
  1.  S:'$G(BIFDT) BIFDT=DT
  1.  ;
  1.  ;
  1.  ;---> Quit if Patient is locked.
  1.  L +^BIP(BIDFN):1 I '$T U IO D  Q
  1.  .W !!?5,"The selected Patient is being edited by another user."
  1.  .W !?5,"Please try printing this letter later."
  1.  .W:'BICRT @IOF D:BICRT DIRZ^BIUTL3()
  1.  ;
  1.  ;---> If patient is deceased, don't print letter; print explanation.
  1.  I $$DECEASED^BIUTL1(BIDFN) D  Q
  1.  .D DECEASED(BIDFN,BICRT),UNLOCK^BIPATUP(BIDFN)
  1.  ;
  1.  ;---> Build temporary global of populated letter in ^TMP("BILET",$J).
  1.  D BUILD^BILETPR1(BIDFN,BILET,$G(BIDLOC),$G(BIFDT))
  1.  ;
  1.  ;---> Now print.
  1.  ;---> Call homegrown letter printer.
  1.  D PRINT^BILETPR4(BIDFN,IO,IOST,.BIERR)
  1.  ;
  1.  ;---> If error printing, display/write and quit.
  1.  I $G(BIERR) D  Q
  1.  .D ERRCD^BIUTL2(BIERR,,1),UNLOCK^BIPATUP(BIDFN),^%ZISC
  1.  ;
  1.  ;---> If this was to the screen, don't store "DATE OF LAST LETTER".
  1.  D:BICRT
  1.  .W !!?3,"NOTE: Because this letter was only displayed on a screen and"
  1.  .W !?9,"not printed on a printer, it will NOT yet be logged by the"
  1.  .W !?9,"program as having been printed and sent to the patient.",!
  1.  .D DIRZ^BIUTL3(.BIPOP)
  1.  ;
  1.  ;---> Close Device.
  1.  D ^%ZISC
  1.  ;
  1.  ;---> Store the date of this letter in the DATE OF LAST LETTER
  1.  ;---> field of the BI PATIENT File.
  1.  ;
  1.  ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
  1.  ;---> Add call to log Notification by iCARE API.
  1.  ;I 'BICRT,$D(^BIP(BIDFN,0)) D DIE^BIFMAN(9002084,".14////"_DT,BIDFN)
  1.  I 'BICRT,$D(^BIP(BIDFN,0)) D
  1.  .D DIE^BIFMAN(9002084,".14////"_DT,BIDFN)
  1.  .I $T(LOG^BQINOTR)]"" D LOG^BQINOTR(BIDFN,"LETTER","",BILET,"","IMMUNIZATIONS","")
  1.  ;**********
  1.  ;
  1.  D UNLOCK^BIPATUP(BIDFN)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. DEVICE ;EP
  1.  ;---> Get Device and possibly queue to Taskman.
  1.  K %ZIS,IOP
  1.  S ZTRTN="PRINT^BILETPR(BIDFN,BILET,$G(BIDLOC),,$G(BIFDT))"
  1.  D ZSAVES^BIUTL3
  1.  D ZIS^BIUTL2(.BIPOP,1)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. DECEASED(BIDFN,BICRT) ;EP
  1.  ;---> If the patient is deceased, display message.
  1.  ;---> Parameters:
  1.  ;     1 - BIDFN  (req) Patient's IEN in VA PATIENT File #2.
  1.  ;     2 - BICRT  (req) BICRT=1 if output is to screen or Browser.
  1.  ;
  1.  W !!?3,"NOTE: Because this patient"
  1.  I $G(BIDFN) I $D(^DPT(BIDFN,0)) D
  1.  .W ", ",$$NAME^BIUTL1(BIDFN)," #",$$HRCN^BIUTL1(BIDFN),","
  1.  W " is now"
  1.  W !?9,"registered as deceased, the letter will NOT be printed."
  1.  W !?9,"This patient should be inactivated in the Immunization "
  1.  W "Register."
  1.  D:BICRT DIRZ^BIUTL3() W:'BICRT @IOF
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. EXIT ;EP
  1.  D KILLALL^BIUTL8(1)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. TEXT1 ;EP
  1.  ;;The letter you have selected prints a Date/Location line between
  1.  ;;between the Bottom Section and the Closing Section of the letter.
  1.  ;;An example would be:
  1.  ;;
  1.  ;;   5-May-1998 at the Children's Clinic, Alaska Native Medical Center
  1.  ;;
  1.  ;;This line may be up to 70 characters long.
  1.  ;;Please enter/edit the Date/Location line now.
  1.  ;;
  1.  ;;Line:
  1.  ;;
  1.  D PRINTX("TEXT1",5)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. PRINTX(BILINL,BITAB) ;EP
  1.  N BITEXT,I,T,X S T="" F I=1:1:BITAB S T=T_" "
  1.  F I=1:1 S X=$T(@BILINL+I) Q:X'[";;"  S BITEXT(I)=T_$P(X,";;",2)
  1.  D EN^DDIOL(.BITEXT)
  1.  Q