1 | GECSBATC ;WISC/RFJ/KLD-batch code sheets ;01 Nov 93
|
---|
2 | ;;2.0;GCS;**13**;MAR 14, 1995
|
---|
3 | N %,%H,%I,COUNTER,D,DA,GECS,GECSBATC,GECSCOUN,GECSSYDA,GECSTRAN,X,Y
|
---|
4 | D ^GECSSITE Q:'$G(GECS("SITE"))
|
---|
5 | D BATNOFMS^GECSUSEL Q:'$G(GECS("BATDA"))
|
---|
6 | S XP="READY TO BATCH "_GECS("BATCH")_" CODE SHEETS",XH="'YES' will start batching, 'NO' or '^' will exit."
|
---|
7 | W !! I $$YN^GECSUTIL(2)'=1 Q
|
---|
8 | W !
|
---|
9 | ; check to see if system is locked
|
---|
10 | S GECSSYDA=$$LOCKSYS^GECSULOC(GECS("SITE")_GECS("SITE1")_"-"_GECS("SYSID")_"-BATCH")
|
---|
11 | I 'GECSSYDA Q
|
---|
12 | S COUNTER=$$COUNTER^GECSUNUM(GECS("SITE")_GECS("SITE1")_"-"_GECS("SYSID")_"-"_GECS("FY")) I 'COUNTER D UNLOCK^GECSULOC(GECSSYDA) Q
|
---|
13 | ;
|
---|
14 | S GECSBATC=GECS("SITE")_GECS("SITE1")_"-"_GECS("SYSID")_"-"_GECS("FY")_"-"_COUNTER
|
---|
15 | ;
|
---|
16 | ; check to see if code sheets are waiting
|
---|
17 | S (DA,GECSCOUN)=0 F S DA=$O(^GECS(2100,"AC","Y",DA)) Q:'DA S D=$G(^GECS(2100,DA,0)) I D'="" D
|
---|
18 | . I ($P(D,"^",6)_$P(D,"^",7))'=(GECS("SITE")_GECS("SITE1")) Q
|
---|
19 | . I $P(D,"^",2)'=GECS("SYSID")!($P(D,"^",3)'=GECS("BATDA")) Q
|
---|
20 | . S GECSTRAN=$G(^GECS(2100,DA,"TRANS")) I GECSTRAN=""!($P(GECSTRAN,"^",7)>DT) Q
|
---|
21 | . I '$$MARK(DA,GECSBATC) Q
|
---|
22 | . S GECSCOUN=GECSCOUN+1
|
---|
23 | . W $J($P(^GECS(2100,DA,0),"^"),10) I $X>69 W !
|
---|
24 | I GECSCOUN=0 W !,"THERE ARE NO CODE SHEETS WAITING TO BE BATCHED." D UNLOCK^GECSULOC(GECSSYDA) Q
|
---|
25 | ;
|
---|
26 | ; create batch
|
---|
27 | W !!,"Creating BATCH NUMBER: ",GECSBATC
|
---|
28 | N %DT,D0,DD,DI,DIC,DIE,DLAYGO,DQ,DR
|
---|
29 | S DIC="^GECS(2101.3,",DIC(0)="L",DLAYGO=2101.3,DIC("DR")=".1///"_GECS("SYSID")_";.2///"_GECS("BATDA")_";.5///B;.7///NOW;.8////"_DUZ
|
---|
30 | S X=GECSBATC D FILE^DICN
|
---|
31 | ;
|
---|
32 | W !,"TOTAL code sheets batched: ",GECSCOUN
|
---|
33 | D UNLOCK^GECSULOC(GECSSYDA)
|
---|
34 | Q
|
---|
35 | ;
|
---|
36 | ;
|
---|
37 | MARK(DA,GECSBATC) ; mark code sheet for transmission in batch gecsbatc
|
---|
38 | ; return 1 for success, 0 for unable to mark code sheet
|
---|
39 | I '$D(^GECS(2100,DA,0)) Q 0
|
---|
40 | N D0,DI,DIC,DIE,DQ,DR,X,Y
|
---|
41 | S (DIC,DIE)="^GECS(2100,",DR=$S($P($G(^GECS(2100,DA,"TRANS")),"^",10)="":".9///3;",1:"")_".1///@;.15///Y;.8////"_GECSBATC
|
---|
42 | D ^DIE I $D(Y) Q 0
|
---|
43 | Q 1
|
---|