GECSBATC ;WISC/RFJ/KLD-batch code sheets ;01 Nov 93
;;2.0;GCS;**13**;MAR 14, 1995
N %,%H,%I,COUNTER,D,DA,GECS,GECSBATC,GECSCOUN,GECSSYDA,GECSTRAN,X,Y
D ^GECSSITE Q:'$G(GECS("SITE"))
D BATNOFMS^GECSUSEL Q:'$G(GECS("BATDA"))
S XP="READY TO BATCH "_GECS("BATCH")_" CODE SHEETS",XH="'YES' will start batching, 'NO' or '^' will exit."
W !! I $$YN^GECSUTIL(2)'=1 Q
W !
; check to see if system is locked
S GECSSYDA=$$LOCKSYS^GECSULOC(GECS("SITE")_GECS("SITE1")_"-"_GECS("SYSID")_"-BATCH")
I 'GECSSYDA Q
S COUNTER=$$COUNTER^GECSUNUM(GECS("SITE")_GECS("SITE1")_"-"_GECS("SYSID")_"-"_GECS("FY")) I 'COUNTER D UNLOCK^GECSULOC(GECSSYDA) Q
;
S GECSBATC=GECS("SITE")_GECS("SITE1")_"-"_GECS("SYSID")_"-"_GECS("FY")_"-"_COUNTER
;
; check to see if code sheets are waiting
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
. I ($P(D,"^",6)_$P(D,"^",7))'=(GECS("SITE")_GECS("SITE1")) Q
. I $P(D,"^",2)'=GECS("SYSID")!($P(D,"^",3)'=GECS("BATDA")) Q
. S GECSTRAN=$G(^GECS(2100,DA,"TRANS")) I GECSTRAN=""!($P(GECSTRAN,"^",7)>DT) Q
. I '$$MARK(DA,GECSBATC) Q
. S GECSCOUN=GECSCOUN+1
. W $J($P(^GECS(2100,DA,0),"^"),10) I $X>69 W !
I GECSCOUN=0 W !,"THERE ARE NO CODE SHEETS WAITING TO BE BATCHED." D UNLOCK^GECSULOC(GECSSYDA) Q
;
; create batch
W !!,"Creating BATCH NUMBER: ",GECSBATC
N %DT,D0,DD,DI,DIC,DIE,DLAYGO,DQ,DR
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
S X=GECSBATC D FILE^DICN
;
W !,"TOTAL code sheets batched: ",GECSCOUN
D UNLOCK^GECSULOC(GECSSYDA)
Q
;
;
MARK(DA,GECSBATC) ; mark code sheet for transmission in batch gecsbatc
; return 1 for success, 0 for unable to mark code sheet
I '$D(^GECS(2100,DA,0)) Q 0
N D0,DI,DIC,DIE,DQ,DR,X,Y
S (DIC,DIE)="^GECS(2100,",DR=$S($P($G(^GECS(2100,DA,"TRANS")),"^",10)="":".9///3;",1:"")_".1///@;.15///Y;.8////"_GECSBATC
D ^DIE I $D(Y) Q 0
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGECSBATC 2040 printed Dec 13, 2024@01:56:03 Page 2
GECSBATC ;WISC/RFJ/KLD-batch code sheets ;01 Nov 93
+1 ;;2.0;GCS;**13**;MAR 14, 1995
+2 NEW %,%H,%I,COUNTER,D,DA,GECS,GECSBATC,GECSCOUN,GECSSYDA,GECSTRAN,X,Y
+3 DO ^GECSSITE
if '$GET(GECS("SITE"))
QUIT
+4 DO BATNOFMS^GECSUSEL
if '$GET(GECS("BATDA"))
QUIT
+5 SET XP="READY TO BATCH "_GECS("BATCH")_" CODE SHEETS"
SET XH="'YES' will start batching, 'NO' or '^' will exit."
+6 WRITE !!
IF $$YN^GECSUTIL(2)'=1
QUIT
+7 WRITE !
+8 ; check to see if system is locked
+9 SET GECSSYDA=$$LOCKSYS^GECSULOC(GECS("SITE")_GECS("SITE1")_"-"_GECS("SYSID")_"-BATCH")
+10 IF 'GECSSYDA
QUIT
+11 SET COUNTER=$$COUNTER^GECSUNUM(GECS("SITE")_GECS("SITE1")_"-"_GECS("SYSID")_"-"_GECS("FY"))
IF 'COUNTER
DO UNLOCK^GECSULOC(GECSSYDA)
QUIT
+12 ;
+13 SET GECSBATC=GECS("SITE")_GECS("SITE1")_"-"_GECS("SYSID")_"-"_GECS("FY")_"-"_COUNTER
+14 ;
+15 ; check to see if code sheets are waiting
+16 SET (DA,GECSCOUN)=0
FOR
SET DA=$ORDER(^GECS(2100,"AC","Y",DA))
if 'DA
QUIT
SET D=$GET(^GECS(2100,DA,0))
IF D'=""
Begin DoDot:1
+17 IF ($PIECE(D,"^",6)_$PIECE(D,"^",7))'=(GECS("SITE")_GECS("SITE1"))
QUIT
+18 IF $PIECE(D,"^",2)'=GECS("SYSID")!($PIECE(D,"^",3)'=GECS("BATDA"))
QUIT
+19 SET GECSTRAN=$GET(^GECS(2100,DA,"TRANS"))
IF GECSTRAN=""!($PIECE(GECSTRAN,"^",7)>DT)
QUIT
+20 IF '$$MARK(DA,GECSBATC)
QUIT
+21 SET GECSCOUN=GECSCOUN+1
+22 WRITE $JUSTIFY($PIECE(^GECS(2100,DA,0),"^"),10)
IF $X>69
WRITE !
End DoDot:1
+23 IF GECSCOUN=0
WRITE !,"THERE ARE NO CODE SHEETS WAITING TO BE BATCHED."
DO UNLOCK^GECSULOC(GECSSYDA)
QUIT
+24 ;
+25 ; create batch
+26 WRITE !!,"Creating BATCH NUMBER: ",GECSBATC
+27 NEW %DT,D0,DD,DI,DIC,DIE,DLAYGO,DQ,DR
+28 SET DIC="^GECS(2101.3,"
SET DIC(0)="L"
SET DLAYGO=2101.3
SET DIC("DR")=".1///"_GECS("SYSID")_";.2///"_GECS("BATDA")_";.5///B;.7///NOW;.8////"_DUZ
+29 SET X=GECSBATC
DO FILE^DICN
+30 ;
+31 WRITE !,"TOTAL code sheets batched: ",GECSCOUN
+32 DO UNLOCK^GECSULOC(GECSSYDA)
+33 QUIT
+34 ;
+35 ;
MARK(DA,GECSBATC) ; mark code sheet for transmission in batch gecsbatc
+1 ; return 1 for success, 0 for unable to mark code sheet
+2 IF '$DATA(^GECS(2100,DA,0))
QUIT 0
+3 NEW D0,DI,DIC,DIE,DQ,DR,X,Y
+4 SET (DIC,DIE)="^GECS(2100,"
SET DR=$SELECT($PIECE($GET(^GECS(2100,DA,"TRANS")),"^",10)="":".9///3;",1:"")_".1///@;.15///Y;.8////"_GECSBATC
+5 DO ^DIE
IF $DATA(Y)
QUIT 0
+6 QUIT 1
