source: WorldVistAEHR/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVE2.m@ 1714

Last change on this file since 1714 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.8 KB
RevLine 
[613]1ABSVE2 ;VAMC ALTOONA/CTB - CONTINUATION OF EDIT ROUTINES ;7/7/98 1:59 PM
2V ;;4.0;VOLUNTARY TIMEKEEPING;**6,10**;JULY 6, 1994
3PCOMB ;PRINT COMBINATIONS FOR VOL (DA) AND SITE (ABSV("SITE")
4 ;USING AUSTIN COMBINATION SEQUENCE NUMBERS
5 S %=0 I $S($D(DA)'["1":1,DA="":1,'$D(ABSV("SITE")):1,ABSV("SITE")="":1,1:0) Q
6 I '$D(^ABS(503330,ABSVX("VOLDA"),1,"AD",ABSV("SITE"))) S X="No Combinations on File for Station "_ABSV("SITE")_".*" W !! D MSG^ABSVQ W !! S Y="" Q
7 W !!,"Valid Combinations for "_$P(^ABS(503330,DA,0),"^")_" at Station "_ABSV("SITE")_" are: ",! S N=0
8 K ABSVX("LIST") F I=1:1 S N=$O(^ABS(503330,DA,1,"AD",ABSV("SITE"),N)) Q:'N D
9 . S X=$O(^ABS(503330,DA,1,"AD",ABSV("SITE"),N,0)) I '$D(^ABS(503330,DA,1,+X,0)) K ^ABS(503330,DA,1,"AD",ABSV("SITE"),N,+X) Q
10 . S ABSVX("LIST",N)=X,ABSVX("LIST")=I
11 . QUIT
12 S N=0 F I=1:1 S N=$O(ABSVX("LIST",N)) Q:'N D WR
13 Q
14WR S X=ABSVX("LIST",N) W !,N,". " S X=$G(^ABS(503330,DA,1,X,0)) W $P(X,"^",5)," "
15 I $P(X,"^",2)]"",$D(^ABS(503334,$P(X,"^",2),0)) W $E($P(^(0),"^",2),1,25)
16 E W $$GET^ABSVU1("INVALID ORG",$G(PLANG)),*7 K ABSVX("LIST",N)
17 W ?54 I $P(X,"^",4)]"",$D(^ABS(503332,$P(X,"^",4),0)) W $E($P(^(0),"^",2),1,25)
18 E W $$GET^ABSVU1("INVALID SERVICE",$G(PLANG)),*7 K ABSVX("LIST",N)
19 W ! Q
20SELECT I '$D(ABSVX("LIST")) S Y="",ABSVOUT=1 Q
21 I ABSVX("LIST")=1,$G(ABSVX("LIST",1))]"" S Y="1^"_ABSVX("LIST",1) W !," "_$$GET^ABSVU1("AUTO SELECT",$G(PLANG)),*7,! Q
22 S DIR(0)="NOA^1:6:0",DIR("A")=$$GET^ABSVU1("SELECT COMBINATION",$G(PLANG)),DIR("?")=$$GET^ABSVU1("ENTER COMBINATION NUMBER",$G(PLANG),"'^'") D ^DIR K DIR
23 I $S($D(DTOUT):1,$D(DUOUT):1,$D(DIRUT):1,$D(DIROUT):1,1:"") K DTOUT,DUOUT,DIRUT,DIROUT S Y="" Q
24 I '$D(ABSVX("LIST",+Y)) S X=$$GET^ABSVU1("INVALID SELECTION",$G(PLANG))_"*" D MSG^ABSVQ,PCOMB G SELECT
25 S $P(Y,"^",2)=$O(^ABS(503330,DA,1,"AD",ABSV("SITE"),Y,0)) Q
26PC1 ;PRINT COMBINATIONS FOR VOL (ABSVX("VOLDA")) AND SITE (ABSV("SITE")
27 ;USING SEQUENTIAL COMBINATION NUMBERS
28 N X,N,I,TAB
29 S %=0,TAB=$S($D(ABSVX("NOWRITE")):40,1:48) I $S($D(ABSVX("VOLDA"))'["1":1,ABSVX("VOLDA")="":1,'$D(ABSV("SITE")):1,ABSV("SITE")="":1,1:0) Q
30 I '$D(^ABS(503330,ABSVX("VOLDA"),1,"AD",ABSV("SITE"))) S X=$$GET^ABSVU1("NO COMBINATIONS",$G(PLANG),ABSV("SITE"))_".*" W !! D MSG^ABSVQ K ABSVX("LIST") W !! S Y="" Q
31 W !!,$$GET^ABSVU1("VALID COMBINATIONS",$G(PLANG),$P(^ABS(503330,ABSVX("VOLDA"),0),"^"),ABSV("SITE")),! S N=0
32 K ABSVX("LIST") F I=1:1 S N=$O(^ABS(503330,ABSVX("VOLDA"),1,"AD",ABSV("SITE"),N)) Q:'N D
33 . S X=$O(^ABS(503330,ABSVX("VOLDA"),1,"AD",ABSV("SITE"),N,0)) I '$D(^ABS(503330,ABSVX("VOLDA"),1,+X,0)) K ^ABS(503330,ABSVX("VOLDA"),1,"AD",ABSV("SITE"),N,+X) Q
34 . S ABSVX("LIST",I)=X,ABSVX("LIST")=I
35 . QUIT
36 S N=0 F I=1:1 S N=$O(ABSVX("LIST",N)) Q:'N D WR1
37 Q
38WR1 S X=ABSVX("LIST",N) W !,N,". " S X=$G(^ABS(503330,ABSVX("VOLDA"),1,X,0)) W:'$D(ABSVX("NOWRITE")) $P(X,"^",5),?13
39 I $P(X,"^",2)]"",$D(^ABS(503334,$P(X,"^",2),0)) W $P(^(0),"^",2)
40 E W $$GET^ABSVU1("INVALID ORG",$G(PLANG)),*7 K ABSVX("LIST",N)
41 W ?TAB I $P(X,"^",4)]"",$D(^ABS(503332,$P(X,"^",4),0)) W $E($P(^(0),"^",2),1,24)
42 E W $$GET^ABSVU1("INVALID SERVICE",$G(PLANG)),*7 K ABSVX("LIST",N) S ABSVX("LIST")=ABSVX("LIST")-1 I ABSVX("LIST")'>0 K ABSVX("LIST")
43 W ! Q
44SEL1 S ABSVOUT=1,Y=""
45 I $D(ABSVX("LIST"))'=11 S X=$$GET^ABSVU1("NO COMBINATIONS",$G(PLANG),ABSV("SITE"))_".*" W !! D MSG^ABSVQ K ABSVX("LIST") W !! S Y="" Q
46 I ABSVX("LIST")=1,$G(ABSVX("LIST",1))]"" S Y="1^"_ABSVX("LIST",1),ABSVOUT="0000" W !," "_$$GET^ABSVU1("AUTO SELECT",$G(PLANG)),*7,! Q
47 S DIR(0)="NOA^1:"_ABSVX("LIST")_":0",DIR("A")=$$GET^ABSVU1("SELECT COMBINATION",$G(PLANG)),DIR("?")=$$GET^ABSVU1("ENTER COMBINATION NUMBER",$G(PLANG),"'^'") N DQ,DP D ^DIR K DIR
48 S ABSVOUT=$D(DTOUT)_$D(DUOUT)_$D(DIRUT)_$D(DIROUT) K DTOUT,DUOUT,DIROUT,DIRUT I ABSVOUT S Y="" Q
49 I '$D(ABSVX("LIST",+Y)) S X=$$GET^ABSVU1("INVALID SELECTION",$G(PLANG))_"*" D MSG^ABSVQ,PC1 G SEL1
50 S $P(Y,"^",2)=ABSVX("LIST",+Y) Q
Note: See TracBrowser for help on using the repository browser.