Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GECSBATC

GECSBATC.m

Go to the documentation of this file.
  1. GECSBATC ;WISC/RFJ/KLD-batch code sheets ;01 Nov 93
  1. ;;2.0;GCS;**13**;MAR 14, 1995
  1. N %,%H,%I,COUNTER,D,DA,GECS,GECSBATC,GECSCOUN,GECSSYDA,GECSTRAN,X,Y
  1. D ^GECSSITE Q:'$G(GECS("SITE"))
  1. D BATNOFMS^GECSUSEL Q:'$G(GECS("BATDA"))
  1. S XP="READY TO BATCH "_GECS("BATCH")_" CODE SHEETS",XH="'YES' will start batching, 'NO' or '^' will exit."
  1. W !! I $$YN^GECSUTIL(2)'=1 Q
  1. W !
  1. ; check to see if system is locked
  1. S GECSSYDA=$$LOCKSYS^GECSULOC(GECS("SITE")_GECS("SITE1")_"-"_GECS("SYSID")_"-BATCH")
  1. I 'GECSSYDA Q
  1. S COUNTER=$$COUNTER^GECSUNUM(GECS("SITE")_GECS("SITE1")_"-"_GECS("SYSID")_"-"_GECS("FY")) I 'COUNTER D UNLOCK^GECSULOC(GECSSYDA) Q
  1. ;
  1. S GECSBATC=GECS("SITE")_GECS("SITE1")_"-"_GECS("SYSID")_"-"_GECS("FY")_"-"_COUNTER
  1. ;
  1. ; check to see if code sheets are waiting
  1. 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
  1. . I ($P(D,"^",6)_$P(D,"^",7))'=(GECS("SITE")_GECS("SITE1")) Q
  1. . I $P(D,"^",2)'=GECS("SYSID")!($P(D,"^",3)'=GECS("BATDA")) Q
  1. . S GECSTRAN=$G(^GECS(2100,DA,"TRANS")) I GECSTRAN=""!($P(GECSTRAN,"^",7)>DT) Q
  1. . I '$$MARK(DA,GECSBATC) Q
  1. . S GECSCOUN=GECSCOUN+1
  1. . W $J($P(^GECS(2100,DA,0),"^"),10) I $X>69 W !
  1. I GECSCOUN=0 W !,"THERE ARE NO CODE SHEETS WAITING TO BE BATCHED." D UNLOCK^GECSULOC(GECSSYDA) Q
  1. ;
  1. ; create batch
  1. W !!,"Creating BATCH NUMBER: ",GECSBATC
  1. N %DT,D0,DD,DI,DIC,DIE,DLAYGO,DQ,DR
  1. 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
  1. S X=GECSBATC D FILE^DICN
  1. ;
  1. W !,"TOTAL code sheets batched: ",GECSCOUN
  1. D UNLOCK^GECSULOC(GECSSYDA)
  1. Q
  1. ;
  1. ;
  1. MARK(DA,GECSBATC) ; mark code sheet for transmission in batch gecsbatc
  1. ; return 1 for success, 0 for unable to mark code sheet
  1. I '$D(^GECS(2100,DA,0)) Q 0
  1. N D0,DI,DIC,DIE,DQ,DR,X,Y
  1. S (DIC,DIE)="^GECS(2100,",DR=$S($P($G(^GECS(2100,DA,"TRANS")),"^",10)="":".9///3;",1:"")_".1///@;.15///Y;.8////"_GECSBATC
  1. D ^DIE I $D(Y) Q 0
  1. Q 1