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

BWPURP.m

Go to the documentation of this file. 
  1. BWPURP ;IHS/ANMC/MWR - NOTIFICATION TABLES MAINTENANC;15-Feb-2003 22:08;PLS
  1.  ;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996
  1.  ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
  1.  ;;  ADD/EDIT/PRINT NOTIFICATION PURPOSE FILE ENTRIES, EDIT PCD DAYS,
  1.  ;;  EDIT NOTIFICATION TYPE SYNONYMS, ADD/EDIT NOTIFICATION OUTCOMES.
  1.  ;;
  1.  ;
  1. PRINTPUR ;EP
  1.  ;---> CALLED BY OPTION "BW PRINT NOTIF PURPOSE&LETTER".
  1.  S DIC="^BWNOTP("
  1.  S FLDS="[BW PRINT NOTIF PURPOSE&LETTER]"
  1.  S BY=.01,FR="",TO="",DHD="@"
  1.  S DIOBEG="S BWPAGE=0"
  1.  D EN1^DIP
  1.  D KILLALL^BWUTL8
  1.  Q
  1.  ;
  1.  ;
  1. EDITPUR ;EP
  1.  ;---> CALLED BY OPTION "BW EDIT NOTIF PURPOSE&LETTER".
  1.  D SETVARS^BWUTL5
  1.  ;---> DISPLAY MENU TITLE FROM BW MENU OPTIONS.
  1.  F  D  Q:$G(Y)<0
  1.  .D TITLE^BWUTL5("EDIT NOTIFICATION PURPOSE & LETTER FILE")
  1.  .D DIC^BWFMAN(9002086.404,"QEMAL",.Y)
  1.  .Q:Y<0
  1.  .S DA=+Y
  1.  .D:$P(Y,U,3) ADDLET
  1.  .D:'$P(Y,U,3) REPLACE
  1.  .Q:BWPOP
  1.  .;---> EDIT WITH SCREENMAN.
  1.  .S DR="[BW NOTIFPURPOSE-FORM-1]"
  1.  .D DDS^BWFMAN(9002086.404,DR,DA,"","",.BWPOP)
  1.  D KILLALL^BWUTL8
  1.  Q
  1.  ;
  1.  ;
  1. ADDLET ;EP
  1.  ;---> CALLED BY OPTION "BW ADD NOTIF PURPOSE&LETTER".
  1.  K ^BWNOTP(DA,1)
  1.  N N S N=0
  1.  F  S N=$O(^BWLET(1,1,N)) Q:'N  D
  1.  .S ^BWNOTP(DA,1,N,0)=^BWLET(1,1,N,0)
  1.  S ^BWNOTP(DA,1,0)=^BWLET(1,1,0)
  1.  Q
  1.  ;
  1. REPLACE ;EP
  1.  ;---> REPLACE OLD LETTER FOR THIS NOTIF PURPOSE WITH GENERIC SAMPLE.
  1.  N DIR,DIRUT,Y
  1.  W !!?3,"Do you wish to delete the old letter for this Purpose of "
  1.  W "Notification",!?3,"and replace it with the generic sample letter?"
  1.  S DIR(0)="YA",DIR("B")="NO"
  1.  S DIR("A")="   Enter Yes or No: " D HELP1
  1.  D ^DIR W !
  1.  S:$D(DIRUT) BWPOP=1
  1.  I Y D ADDLET
  1.  Q
  1.  ;
  1. HELP1 ;EP
  1.  ;;Enter YES to delete the old letter for this Purpose of Notification
  1.  ;;and to begin with a fresh copy of the generic sample letter.
  1.  S BWTAB=5,BWLINL="HELP1" D HELPTX
  1.  Q
  1.  ;
  1. HELPTX ;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'[";;"  S DIR("?",I)=T_$P(X,";;",2)
  1.  S DIR("?")=DIR("?",I-1) K DIR("?",I-1)
  1.  Q
  1.  ;
  1. TYPE ;EP
  1.  ;---> EDIT SYNONYMS FOR NOTIFICATION TYPES.
  1.  D SETVARS^BWUTL5
  1.  F  D  Q:$G(Y)<0
  1.  .D TITLE^BWUTL5("EDIT SYNONYMS FOR NOTIFICATION TYPES") D TEXT1
  1.  .N A S A="   Select NOTIFICATION TYPE: "
  1.  .D DIC^BWFMAN(9002086.403,"QEMA",.Y,A)
  1.  .Q:Y<0
  1.  .D DIE^BWFMAN(9002086.403,.03,+Y,.BWPOP)
  1.  W @IOF
  1.  D KILLALL^BWUTL8
  1.  Q
  1.  ;
  1. OUTCOME ;EP
  1.  ;---> ADD/EDIT NOTIFICATION OUTCOME FILE.
  1.  D SETVARS^BWUTL5
  1.  F  D  Q:$G(Y)<0
  1.  .D TITLE^BWUTL5("ADD/EDIT NOTIFICATION OUTCOME FILE")
  1.  .D DIC^BWFMAN(9002086.405,"QEMAL",.Y,"   Select OUTCOME: ")
  1.  .Q:Y<0
  1.  .D DIE^BWFMAN(9002086.405,.02,+Y,.BWPOP)
  1.  W @IOF
  1.  D KILLALL^BWUTL8
  1.  Q
  1.  ;
  1. TEXT1 ;EP
  1.  ;;You may enter a synonym for each Notification Type.  The synonym will
  1.  ;;allow the Notification Type to be called up by typing only a few
  1.  ;;characters.  Synonyms should be unique and less than 4 characters.
  1.  ;;
  1.  ;;For example, "L1" might be used for LETTER,FIRST; "L2" for
  1.  ;;LETTER,SECOND; "L3" for LETTER,THIRD, and so on.
  1.  ;;
  1.  ;;
  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
  1.  ;
  1. GENSTUFF ;EP
  1.  ;---> STUFF THE GENERIC SAMPLE LETTER INTO ALL PURPOSES OF NOTIF.
  1.  D ^XBKVAR N DA
  1.  S DA=0
  1.  F  S DA=$O(^BWNOTP(DA)) Q:'DA  W !,DA  D ADDLET^BWPURP
  1.  Q