source: FOIAVistA/tag/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSV88B.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 2.4 KB
Line 
1ABSV88B ;VAMC ALTOONA/CTB - MANAGE TT88 TRANSMISSION LISTS ;7/29/93 3:07 PM
2V ;;4.0;VOLUNTARY TIMEKEEPING;;JULY 6, 1994
3ADD ;ADD VOLUNTEER TO LIST OF TT88'S TO BE TRANSMITTED TO AUSTIN
4 NEW %,%W,%Y,C,D0,DA,DI,DIC,DIE,DQ,DR,DUOUT,DTOUT,DIRUT,DIROUT,I,N,X
5 D ^ABSVSITE Q:'%
6A1 D GETVOL G OUT:'$D(ABSVX("VOLDA"))
7 S DA(1)=ABSVX("VOLDA")
8 I $P($G(^ABS(503330,DA(1),4,ABSV("INST"),0)),"^",13)=1 S X="Volunteer IS currently marked for transmission for station "_ABSV("SITE")_". NO ACTION TAKEN.*" D MSG^ABSVQ,OUT G A1
9 S DIE="^ABS(503330,"_DA(1)_",4,",DA=ABSV("INST"),DR="13;11////1" D ^DIE
10 I $D(Y) S DR="13///@;11///@" D ^DIE S X=" <No Action Taken>" D MSG^ABSVQ,OUT G A1
11 I $P($G(^ABS(503330,DA(1),4,ABSV("INST"),0)),"^",13)'=1 S X="ERROR HAS OCCURRED, Record has not been marked. Please try again."
12 E S X="<Record marked for transmission>*"
13 D MSG^ABSVQ,OUT G A1
14 QUIT
15 ;
16DEL ;DELETE VOLUNTEER FROM OF TT88'S TO BE TRANSMITTED TO AUSTIN
17 NEW %,%W,%Y,C,D0,DA,DI,DIC,DIE,DQ,DR,DUOUT,DTOUT,DIRUT,DIROUT,I,N,X,ZZ
18 D ^ABSVSITE Q:'%
19D1 D GETVOL I '$D(ABSVX("VOLDA")) D OUT QUIT
20 S DA(1)=ABSVX("VOLDA")
21 I $P($G(^ABS(503330,DA(1),4,ABSV("INST"),0)),"^",13)'=1,$P($G(^(0)),"^",14)'=1 S X="Volunteer IS NOT currently marked for transmission for station "_ABSV("SITE")_". NO ACTION TAKEN.*" D MSG^ABSVQ,OUT G D1
22 S ABSVXA="OK to REMOVE record from Austin Transmission List",%=1
23 D ^ABSVYN I %'=1 S ZZ=%,X="<No Action Taken>*" D MSG^ABSVQ S %=ZZ K ZZ G OUT:%<0,D1:%=2
24 S DIE="^ABS(503330,"_DA(1)_",4,",DA=ABSV("INST"),DR="11////@;12////@;13////0" D ^DIE
25 I $P($G(^ABS(503330,DA(1),4,ABSV("INST"),0)),"^",13)=1!($P($G(^(0)),"^",14)=1) S X="ERROR HAS OCCURRED, Record has not been UNMARKED. Please try again."
26 E S X="<Record Removed from List>*"
27 D MSG^ABSVQ,OUT G D1
28OUT QUIT
29GETVOL ;GET SINGLE VOLUNTEER RECORD
30 NEW DA,DIC,DLAYGO,Y
31 K ABSVX("VOLDA") S DIC=503330,DIC(0)="AEMQ",DIC("A")="Select VOLUNTEER: ",DIC("S")="I $D(^ABS(503330,+Y,4,ABSV(""INST""),0))"
32 D MDIV^ABSVSITE,^DIC K DIC Q:+Y<0 S ABSVX("VOLDA")=+Y,DA=+Y
33 QUIT
34VIEW ;VIEW/PRINT LIST OF PENDING TT88'S
35 D ^ABSVSITE G:'% OUT
36 S L=0,DIC=503330,BY="[ABSV TT88 VIEW SORT]"
37 I ABSV("SITE")=+ABSV("SITE") S FR=ABSV("SITE")-.0001,TO=ABSV("SITE")+.0001
38 E S (FR,TO)=ABSV("SITE")
39 S DIS(0)="I (+$P($G(^ABS(503330,D0,4,ABSV(""INST""),0)),U,13)!(+$P($G(^(0)),U,14)))"
40 S FLDS="[ABSV TT88 LIST]",DHD="PENDING TT88'S FOR STATION "_ABSV("SITE") D EN1^DIP
41 K %X,B,DIJ,DIPASS,DP,P QUIT
Note: See TracBrowser for help on using the repository browser.