source: WorldVistAEHR/trunk/r/GENERIC_CODE_SHEET-GEC/GECSBATC.m@ 1520

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

initial load of WorldVistAEHR

File size: 2.0 KB
RevLine 
[613]1GECSBATC ;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 ;
37MARK(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
Note: See TracBrowser for help on using the repository browser.