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