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

BWLETPR.m

Go to the documentation of this file. 
  1. BWLETPR ;IHS/ANMC/MWR -  BW PRINT LETTERS.  [ 06/06/99  8:10 AM ];15-Feb-2003 21:56;PLS
  1.  ;;2.0;WOMEN'S HEALTH;**6,8**;MAY 16, 1996
  1.  ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
  1.  ;;  CALLED BY OPTION: "BW PRINT INDIVIDUAL LETTERS" TO PRINT A
  1.  ;;  LETTER FOR A SINGLE INDIVIDUAL (AS OPPOSED TO ALL THOSE QUEUED).
  1.  ;;IHS/CMI/LAB PATCHED AT LINE LABELS SELECT AND NONE.  PATCH 6
  1.  ;
  1.  ;/IHS/ANMC/DLG 21JUN2002  I haven't found who/what sets IOF = null,
  1.  ; but somehow it's happening and it's causing SYNTAX errors.  I slapped bandaids here & there.
  1.  D SETVARS^BWUTL5 S (BWPOP1,BWPOP)=0
  1.  N BWDA,BWTITLE
  1.  F  S BWPOP=0 D  Q:BWPOP1
  1.  .D SELECT Q:BWPOP
  1.  .D DEVICE Q:BWPOP
  1.  .S BWCRT=$S($E(IOST)="C":1,1:0)
  1.  .D PRINT
  1.  D ^%ZISC
  1.  ;
  1. EXIT ;EP
  1.  D KILLALL^BWUTL8
  1.  Q
  1.  ;
  1. SELECT ;EP
  1.  ;---> SELECT PATIENT, THEN SELECT NOTIFICATION.
  1.  ;N DIC,Y                                               ;IHS/CMI/LAB
  1.  N BWNAM,DIC,X,Y                                        ;IHS/CMI/LAB
  1.  D TITLE^BWUTL5("PRINT INDIVIDUAL PATIENT LETTERS")
  1.  D PATLKUP^BWUTL8(.Y)
  1.  I Y<0 S (BWPOP,BWPOP1)=1 Q
  1.  S BWDFN=+Y,BWNAM=$$NAME^BWUTL1(BWDFN)
  1.  ;---> On some systems DIC lookup needs to be by name   ;IHS/CMI/LAB
  1.  ;---> rather than by DFN.                              ;IHS/CMI/LAB
  1.  ;D DIC^BWFMAN(9002086.4,"EM",.Y,"","","",BWDFN,.BWPOP) ;IHS/CMI/LAB
  1.  D DIC^BWFMAN(9002086.4,"EM",.Y,"","","",BWNAM,.BWPOP)  ;IHS/CMI/LAB
  1.  I $D(DUOUT)!($D(DTOUT)) S BWPOP=1 Q
  1.  I Y<0 D NONE S BWPOP=1 Q
  1.  S BWDA=+Y
  1.  ;
  1.  ;---> IF FACILITIES OF LETTER AND USER DON'T MATCH, QUIT.
  1.  N BWFACIL S BWFACIL=$P(^BWNOT(BWDA,0),U,7)
  1.  I ((BWFACIL'=DUZ(2))&(BWFACIL)) D TEXT1,DIRZ^BWUTL3 S BWPOP=1 Q
  1.  ;
  1.  S BWPURP=$P(^BWNOT(BWDA,0),U,4)
  1.  S BWTYPE=$P(^BWNOT(BWDA,0),U,3)
  1.  ;
  1.  ;---> CHECK IF PURPOSE HAS BEEN ENTERED.
  1.  I 'BWPURP D  Q
  1.  .W !!?5,"No Purpose has been entered for this Notification."
  1.  .D DIRZ^BWUTL3 S BWPOP=1 Q
  1.  ;
  1.  ;---> CHECK IF THIS PURPOSE OF NOTIFICATION HAS A LETTER.
  1.  I '$D(^BWNOTP(BWPURP,1,0)) D  Q
  1.  .W !!!?5,"No letter has been entered for this Purpose of Notification."
  1.  .W !?5,"Programmer information: Notification=^BWNOT("_BWDA_",0)."
  1.  .W !?5,"                         Purpose IEN=",BWPURP
  1.  .W !?5,"                         Patient IEN=",BWDFN
  1.  .D DIRZ^BWUTL3 S BWPOP=1 Q
  1.  ;
  1.  ;---> CHECK IF TYPE OF NOTIFICATION FOR THIS NOTIFICATION IS PRINTABLE.
  1.  I 'BWTYPE D CANTPRT Q
  1.  I '$P(^BWNOTT(BWTYPE,0),U,2) D CANTPRT Q
  1.  Q
  1.  ;
  1. CANTPRT ;EP
  1.  ;---> CAN'T PRINT THIS NOTIFICATION.
  1.  W !!?5,"This Type of Notification"
  1.  W:BWTYPE ", ",$P(^BWNOTT(BWTYPE,0),U),"," W " is not printable."
  1.  D DIRZ^BWUTL3 S BWPOP=1
  1.  Q
  1.  ;
  1. DEVICE ;EP
  1.  ;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
  1.  K %ZIS,IOP
  1.  S ZTRTN="PRINT^BWLETPR",ZTSAVE("BWDA")=""
  1.  D ZIS^BWUTL2(.BWPOP,1)
  1.  Q
  1.  ;
  1. PRINT ;EP
  1.  ;---> REQUIRED VARIABLE: BWDA=IEN IN ^BWNOT, ION=DEVICE
  1.  ;---> NEXT LINE: IOP WILL INHIBIT ^DIWF FROM PROMPTING FOR DEVICE.
  1.  D SETVARS^BWUTL5
  1.  N BWDFN,BWPURP,IOP,BWIRAD,BWPDATE ;IHS/CMI/LAB patch 6 added 2 vars
  1.  S IOP=ION
  1.  ;---> IF FACILITIES OF LETTER AND USER DON'T MATCH, QUIT (IF NULL, OK).
  1.  N BWFACIL S BWFACIL=$P(^BWNOT(BWDA,0),U,7)
  1.  I ((BWFACIL'=DUZ(2))&(BWFACIL)) D TEXT1 H 5 S BWPOP=1 Q
  1.  ;
  1.  S BWDFN=$P(^BWNOT(BWDA,0),U)
  1.  S BWPURP=$P(^BWNOT(BWDA,0),U,4)
  1.  S BWIRAD=$P(^BWNOT(BWDA,0),U,6) I BWIRAD S BWIRAD=$P(^BWPCD(BWIRAD,0),U,35) ;IHS/CMI/LAB - patch 6
  1.  S BWPDATE=$P(^BWNOT(BWDA,0),U,6) I BWPDATE S BWPDATE=$P(^BWPCD(BWPDATE,0),U,12) I BWPDATE]"" S BWPDATE=$$FMTE^XLFDT(BWPDATE) ;IHS/CMI/LAB - patch 6
  1.  ;---> BWN=DATE OF "PRINT DATE", USE TO KILL "APRT" XREF BELOW.
  1.  S:'$D(BWKDT) BWKDT=$P(^BWNOT(BWDA,0),U,11)
  1.  ;---> IF NO PURPOSE (DELETED), KILL "APRT" XREF AND QUIT.
  1.  I 'BWPURP D  Q
  1.  .W !!?5,"No Purpose of Notification has been chosen; therefore, this"
  1.  .W !?5,"notification cannot be printed."
  1.  .D KILLXREF(BWDA,BWKDT)
  1.  ;---> IF QUEUED AND BWCRT IS NOT SET, THEN SET IT.
  1.  S:'$D(BWCRT) BWCRT=$S($E(IOST)="C":1,1:0)
  1.  S DIWF="^BWNOTP(BWPURP,1,"
  1.  S DIWF(1)=9002086
  1.  S BY="INTERNAL(#.01)="_BWDFN
  1.  ;/IHS/ANMC/DLG 21JUN2002  sometimes IOF is null.
  1.  ;S:'BWCRT DIOEND="W @IOF"
  1.  S:'BWCRT DIOEND=$S(IOF]"":"W @IOF",1:"W #")
  1.  ;/DLG
  1.  ;---> IF LOCKED, PROMPT DEVICE, QUIT AND LEAVE IN THE QUEUE.
  1.  L +^BWNOT(BWDA):0 I '$T U IO D  D PROMPT Q
  1.  .W !!?5,"The selected Notification is being edited by another user."
  1.  .W !?5,"Programmer information: Notification=^BWNOT("_BWDA_",0)."
  1.  .;/IHS/ANMC/DLG 21JUN2002  sometimes IOF is null
  1.  .;W:'BWCRT @IOF
  1.  .W:('BWCRT)&(IOF]"") @IOF W:('BWCRT)&(IOF="") #
  1.  .;/DLG
  1.  ;
  1.  ;---> IF PATIENT IS DECEASED, DON'T PRINT LETTER; PRINT EXPLANATION,
  1.  ;---> CHANGE THE STATUS OF THE NOTIFICATION TO "CLOSED", AND GIVE
  1.  ;---> THE OUTCOME OF "PATIENT DECEASED".
  1.  I $$DECEASED^BWUTL1(BWDFN) D DECEASED Q
  1.  ;
  1.  ;---> PRINT IT TO IOP, PRESERVE BWPOP.
  1.  D EN2^DIWF
  1.  D PROMPT
  1.  ;---> DON'T STUFF "DATE PRINTED" IF IT ALREADY HAS A "DATE PRINTED".
  1.  I $P(^BWNOT(BWDA,0),U,10)]"" D KILLXREF(BWDA,BWKDT) L -^BWNOT(BWDA) Q
  1.  ;
  1.  ;---> DON'T STUFF "DATE PRINTED" IF IT'S JUST TO THE SCREEN.
  1.  I BWCRT D  Q
  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"".",!
  1.  .L -^BWNOT(BWDA) D DIRZ^BWUTL3
  1.  ;
  1.  ;---> NEXT LINES KILL "APRT" XREF AND SET "DATE PRINTED"=TODAY.
  1.  ;---> ("APRT" XREF INDICATE A NOTIFICATION IS QUEUED TO BE PRINTED.)
  1.  D KILLXREF(BWDA,BWKDT)
  1.  D DIE^BWFMAN(9002086.4,".1////"_DT,BWDA)
  1.  L -^BWNOT(BWDA) Q
  1.  Q
  1.  ;
  1. KILLXREF(BWDA,BWKDT) ;EP
  1.  ;---> KILL "APRT" XREF (REMOVE LETTER FROM QUEUE).
  1.  Q:'$G(BWDA)  Q:'$G(BWKDT)
  1.  K ^BWNOT("APRT",BWKDT,BWDA)
  1.  Q
  1.  ;
  1. DECEASED ;EP
  1.  ;---> IF THE PATIENT IS DECEASED.
  1.  ;---> DON'T STUFF "DATE PRINTED" IF IT'S JUST TO THE SCREEN.
  1.  W !!?3,"NOTE: Because this patient, ",$$NAME^BWUTL1(BWDFN)," #"
  1.  W $$HRCN^BWUTL1(BWDFN),", is now"
  1.  W !?9,"registered as deceased, the letter will NOT be printed."
  1.  W !?9,"Instead, this notification will be given a status of CLOSED"
  1.  W !?9,"and an outcome of ""Patient Deceased""."
  1.  ;/IHS/ANMC/DLG 21JUN2002  sometimes IOF is null
  1.  ;D:BWCRT DIRZ^BWUTL3 W:'BWCRT @IOF
  1.  D:BWCRT DIRZ^BWUTL3 W:('BWCRT)&(IOF]"") @IOF W:('BWCRT)&(IOF="") #
  1.  ;/DLG
  1.  S DR=".14////c;.05///Patient Deceased"
  1.  D DIE^BWFMAN(9002086.4,DR,BWDA)
  1.  ;---> KILL "APRT" XREF (FLAGS NOTIFICATION AS QUEUED TO BE PRINTED).
  1.  D KILLXREF(BWDA,BWKDT)
  1.  L -^BWNOT(BWDA)
  1.  Q
  1.  ;
  1. PROMPT ;EP
  1.  ;---> PROMPT IF NECESSARY, PROMPT DEVICE.
  1.  D:BWCRT DIRZ^BWUTL3
  1.  Q
  1.  ;
  1. NONE ;EP
  1.  ;---> Patched message covers all possibilities.         ;IHS/CMI/LAB
  1.  ;S BWTITLE="* There are no letters for this patient"    ;IHS/CMI/LAB
  1.  ;S BWTITLE=BWTITLE_" waiting to be printed. *"          ;IHS/CMI/LAB
  1.  S BWTITLE="* No letters selected for printing. *"       ;IHS/CMI/LAB
  1.  D CENTERT^BWUTL5(.BWTITLE)
  1.  W !!!!,BWTITLE,!!
  1.  D DIRZ^BWUTL3
  1.  Q
  1.  ;
  1. TEXT1 ;EP
  1.  ;;
  1.  ;;* NOTE: The Facility with which this letter is associated does not
  1.  ;;        match the Facility under which you are currently logged on.
  1.  ;;        To print this Notification, you must either edit the Facility
  1.  ;;        for this Notification, or log off and log back in under the
  1.  ;;        same Facility with which the Notification is associated.
  1.  S BWTAB=5,BWLINL="TEXT1" D PRINTX
  1.  Q
  1.  ;
  1. PRINTX ;EP
  1.  N I,T,X S T="" F I=1:1:BWTAB S T=T_" "
  1.  F I=1:1 S X=$T(@BWLINL+I) Q:X'[";;"  W !,T,$P(X,";;",2)
  1.  Q