- 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 Jan 18, 2025@02:57:15 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