- GECSSTTM ;WISC/RFJ-stacker file transmission (multi docs in a msg) ;08 Dec 93
- ;;2.0;GCS;**4,5**;MAR 14, 1995
- Q
- ;
- ;
- TRANSALL ; transmit code sheets waiting for clock in stack file
- ; check for another job transmitting stack code sheets
- N DA,GECSFQUE
- L +^GECS(2100.1,"ATRANSMIT"):10 I '$T Q
- S GECSFQUE=1
- K ^TMP($J,"GECSSTTR")
- S DA=0 F S DA=$O(^GECS(2100.1,"AS","Q",DA)) Q:'DA D BUILD(DA)
- D TRANSMIT^GECSSTTT
- K ^TMP($J,"GECSSTTR")
- L -^GECS(2100.1,"ATRANSMIT")
- S ZTREQ="@"
- Q
- ;
- ;
- BUILD(DA) ; build tmp global for stack entry da
- ; $g(gecsfaut)=1 for immediate transmissions
- I '$D(^GECS(2100.1,DA,0)) Q
- L +^GECS(2100.1,DA):10 I '$T Q
- ;
- N %,BATCHDA,CHECKSUM,DA1,DATA,ENDOFCS,ENDOFMSG,FINDHOLD,GECSFLAG,GECSLPC,HOLDDATE,LINE,SEGMENT,SEQSIZE,SEQUENCE,STACSIZE,X,Y
- ;
- I $E($G(^GECS(2100.1,DA,10,1,0)),1,3)'="CTL" D SETSTAT^GECSSTAA(DA,"E"),ERROR^GECSSTTR(DA,"Control segment/first line of code sheet missing") L -^GECS(2100.1,DA) Q
- ;
- S SEGMENT=$P(^GECS(2100.1,DA,0),"^",5)
- I SEGMENT="" D SETSTAT^GECSSTAA(DA,"E"),ERROR^GECSSTTR(DA,"Segment not defined for entry") L -^GECS(2100.1,DA) Q
- S (ENDOFCS,ENDOFMSG)=""
- I $P(SEGMENT,":",2)="FMS" S ENDOFCS="{",ENDOFMSG="}"
- ;
- S BATCHDA=+$P($G(^GECS(2101.2,+$O(^GECS(2101.2,"B",SEGMENT,0)),0)),"^",4)
- I 'BATCHDA D SETSTAT^GECSSTAA(DA,"E"),ERROR^GECSSTTR(DA,"Batch type in file 2101.2 is incorrect") L -^GECS(2100.1,DA) Q
- ;
- S GECSLPC=$G(^%ZOSF("LPC")) I GECSLPC="" S GECSLPC="S Y="""""
- ; for automatically created docs, check checksum and hold date
- I $P($G(^GECS(2100.1,DA,0)),"^",6)="A" D I $G(GECSFLAG) L -^GECS(2100.1,DA) Q
- . ; check hold date greater than today
- . S HOLDDATE=$P($G(^GECS(2100.1,DA,11)),"^",3)
- . ; for immediate transmissions, queue code sheet
- . I HOLDDATE>DT D:$G(GECSFAUT) SETSTAT^GECSSTAA(DA,"Q") S GECSFLAG=1 Q
- . ; compute checksum and find hold date if not defined
- . S CHECKSUM=""
- . S DA1=0 F S DA1=$O(^GECS(2100.1,DA,10,DA1)) Q:'DA1 S DATA=$G(^(DA1,0)) D Q:$G(GECSFLAG)
- . . I 'HOLDDATE I $E($P(DATA,"^"),3)=2!($P(DATA,"^")="AT1") S FINDHOLD=$$HOLDDATE^GECSSTTR(DATA) I FINDHOLD S $P(^GECS(2100.1,DA,11),"^",3)=FINDHOLD,GECSFLAG=1 Q
- . . S X=CHECKSUM_DATA X GECSLPC S CHECKSUM=Y
- . ; for immediate transmissions, queue code sheet
- . I $G(GECSFLAG) D:$G(GECSFAUT) SETSTAT^GECSSTAA(DA,"Q") Q
- . ; compare checksums
- . S X=$P($G(^GECS(2100.1,DA,11)),"^",2) I X="" Q
- . I X'=CHECKSUM D SETSTAT^GECSSTAA(DA,"E"),ERROR^GECSSTTR(DA,"Code sheet has been altered since creation") S GECSFLAG=1
- ;
- ; change transmission date on ctl segment
- S ^GECS(2100.1,DA,10,1,0)=$$CTLDATE^GECSSTTR(^GECS(2100.1,DA,10,1,0))
- ;
- ; fit code sheet in a sequence number if possible
- S STACSIZE=$P($G(^GECS(2100.1,DA,11)),"^")
- I STACSIZE>30000 D MULTIPLE L -^GECS(2100.1,DA) Q
- S SEQUENCE=0 F S SEQUENCE=$O(^TMP($J,"GECSSTTR","SIZE",SEQUENCE)) Q:'SEQUENCE S SEQSIZE=^(SEQUENCE) I ($P(SEQSIZE,"^")+STACSIZE)<30000,^TMP($J,"GECSSTTR","BATCH",SEQUENCE)=BATCHDA Q
- ; create a new sequence
- I 'SEQUENCE D SEQUENCE S SEQSIZE="0^0"
- ;
- ; recompute checksum with new transmission date and time on ctl segment
- S LINE=$P(SEQSIZE,"^",2),CHECKSUM=""
- S DA1=0 F S DA1=$O(^GECS(2100.1,DA,10,DA1)) Q:'DA1 S DATA=$G(^(DA1,0)) I DATA'="" D
- . S LINE=LINE+1,^TMP($J,"GECSSTTR","CS",SEQUENCE,LINE,0)=DATA
- . S X=CHECKSUM_DATA X GECSLPC S CHECKSUM=Y
- . ; check for last code sheet in stack entry
- . I '$O(^GECS(2100.1,DA,10,DA1)),$L($G(ENDOFCS)) D Q
- . . I DATA'[ENDOFCS S DATA=DATA_ENDOFCS
- . . S ^TMP($J,"GECSSTTR","CS",SEQUENCE,LINE,0)=DATA
- ;
- ; store new checksum
- S $P(^GECS(2100.1,DA,11),"^",2)=CHECKSUM
- ;
- D ENDSEQ($P(SEQSIZE,"^")+STACSIZE,LINE)
- L -^GECS(2100.1,DA)
- Q
- ;
- ;
- MULTIPLE ; code sheet is larger than 30k, create multiple msgs
- D SEQUENCE
- N %,COUNT,SIZE,STRTSEQ,MAILMSGS
- S STRTSEQ=SEQUENCE
- S MAILMSGS=1,(LINE,SIZE)=0,CHECKSUM=""
- S DA1=0 F S DA1=$O(^GECS(2100.1,DA,10,DA1)) Q:'DA1 S DATA=$G(^(DA1,0)) I DATA'="" D
- . S LINE=LINE+1,^TMP($J,"GECSSTTR","CS",SEQUENCE,LINE,0)=DATA
- . S X=CHECKSUM_DATA X GECSLPC S CHECKSUM=Y
- . ; check for last code sheet in stack entry
- . I '$O(^GECS(2100.1,DA,10,DA1)),$L($G(ENDOFCS)) D Q
- . . I DATA'[ENDOFCS S DATA=DATA_ENDOFCS
- . . S ^TMP($J,"GECSSTTR","CS",SEQUENCE,LINE,0)=DATA
- . S SIZE=SIZE+$L(DATA)
- . I SIZE>30000 D
- . . I $L($G(ENDOFMSG)),DATA'[ENDOFMSG S ^TMP($J,"GECSSTTR","CS",SEQUENCE,LINE,0)=DATA_ENDOFMSG
- . . D ENDSEQ(SIZE,LINE),SEQUENCE S MAILMSGS=MAILMSGS+1,LINE=2,SIZE=0
- ;
- ; store new checksum
- S $P(^GECS(2100.1,DA,11),"^",2)=CHECKSUM
- ;
- ; modify sequence count
- S DATA=^GECS(2100.1,DA,10,1,0),$P(DATA,"^",13)=$E("000",$L(MAILMSGS)+1,3)_MAILMSGS
- S COUNT=1 F %=STRTSEQ:1 Q:'$D(^TMP($J,"GECSSTTR","CS",%)) S $P(DATA,"^",12)=$E("000",$L(COUNT)+1,3)_COUNT,^TMP($J,"GECSSTTR","CS",%,1,0)=DATA,COUNT=COUNT+1
- ;
- ; send size=30001 to prevent other code sheets from being added
- D ENDSEQ(30001,LINE)
- Q
- ;
- ;
- ENDSEQ(SIZE,LINE) ; set end sequence control in tmp
- ; size=size of code sheet; line=last line of sequence
- N %
- S ^TMP($J,"GECSSTTR","SIZE",SEQUENCE)=SIZE_"^"_LINE
- S ^TMP($J,"GECSSTTR","LIST",SEQUENCE,DA)=""
- S ^TMP($J,"GECSSTTR","BATCH",SEQUENCE)=BATCHDA
- S %=$G(^TMP($J,"GECSSTTR","SEGS",SEQUENCE)) I %[$P(SEGMENT,":") Q
- S ^TMP($J,"GECSSTTR","SEGS",SEQUENCE)=%_$S(%="":"",1:",")_$P(SEGMENT,":")
- Q
- ;
- ;
- SEQUENCE ; return next sequence number
- S SEQUENCE=$G(^TMP($J,"GECSSTTR","SEQ"))+1,^TMP($J,"GECSSTTR","SEQ")=SEQUENCE
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGECSSTTM 5601 printed Mar 13, 2025@21:01:08 Page 2
- GECSSTTM ;WISC/RFJ-stacker file transmission (multi docs in a msg) ;08 Dec 93
- +1 ;;2.0;GCS;**4,5**;MAR 14, 1995
- +2 QUIT
- +3 ;
- +4 ;
- TRANSALL ; transmit code sheets waiting for clock in stack file
- +1 ; check for another job transmitting stack code sheets
- +2 NEW DA,GECSFQUE
- +3 LOCK +^GECS(2100.1,"ATRANSMIT"):10
- IF '$TEST
- QUIT
- +4 SET GECSFQUE=1
- +5 KILL ^TMP($JOB,"GECSSTTR")
- +6 SET DA=0
- FOR
- SET DA=$ORDER(^GECS(2100.1,"AS","Q",DA))
- if 'DA
- QUIT
- DO BUILD(DA)
- +7 DO TRANSMIT^GECSSTTT
- +8 KILL ^TMP($JOB,"GECSSTTR")
- +9 LOCK -^GECS(2100.1,"ATRANSMIT")
- +10 SET ZTREQ="@"
- +11 QUIT
- +12 ;
- +13 ;
- BUILD(DA) ; build tmp global for stack entry da
- +1 ; $g(gecsfaut)=1 for immediate transmissions
- +2 IF '$DATA(^GECS(2100.1,DA,0))
- QUIT
- +3 LOCK +^GECS(2100.1,DA):10
- IF '$TEST
- QUIT
- +4 ;
- +5 NEW %,BATCHDA,CHECKSUM,DA1,DATA,ENDOFCS,ENDOFMSG,FINDHOLD,GECSFLAG,GECSLPC,HOLDDATE,LINE,SEGMENT,SEQSIZE,SEQUENCE,STACSIZE,X,Y
- +6 ;
- +7 IF $EXTRACT($GET(^GECS(2100.1,DA,10,1,0)),1,3)'="CTL"
- DO SETSTAT^GECSSTAA(DA,"E")
- DO ERROR^GECSSTTR(DA,"Control segment/first line of code sheet missing")
- LOCK -^GECS(2100.1,DA)
- QUIT
- +8 ;
- +9 SET SEGMENT=$PIECE(^GECS(2100.1,DA,0),"^",5)
- +10 IF SEGMENT=""
- DO SETSTAT^GECSSTAA(DA,"E")
- DO ERROR^GECSSTTR(DA,"Segment not defined for entry")
- LOCK -^GECS(2100.1,DA)
- QUIT
- +11 SET (ENDOFCS,ENDOFMSG)=""
- +12 IF $PIECE(SEGMENT,":",2)="FMS"
- SET ENDOFCS="{"
- SET ENDOFMSG="}"
- +13 ;
- +14 SET BATCHDA=+$PIECE($GET(^GECS(2101.2,+$ORDER(^GECS(2101.2,"B",SEGMENT,0)),0)),"^",4)
- +15 IF 'BATCHDA
- DO SETSTAT^GECSSTAA(DA,"E")
- DO ERROR^GECSSTTR(DA,"Batch type in file 2101.2 is incorrect")
- LOCK -^GECS(2100.1,DA)
- QUIT
- +16 ;
- +17 SET GECSLPC=$GET(^%ZOSF("LPC"))
- IF GECSLPC=""
- SET GECSLPC="S Y="""""
- +18 ; for automatically created docs, check checksum and hold date
- +19 IF $PIECE($GET(^GECS(2100.1,DA,0)),"^",6)="A"
- Begin DoDot:1
- +20 ; check hold date greater than today
- +21 SET HOLDDATE=$PIECE($GET(^GECS(2100.1,DA,11)),"^",3)
- +22 ; for immediate transmissions, queue code sheet
- +23 IF HOLDDATE>DT
- if $GET(GECSFAUT)
- DO SETSTAT^GECSSTAA(DA,"Q")
- SET GECSFLAG=1
- QUIT
- +24 ; compute checksum and find hold date if not defined
- +25 SET CHECKSUM=""
- +26 SET DA1=0
- FOR
- SET DA1=$ORDER(^GECS(2100.1,DA,10,DA1))
- if 'DA1
- QUIT
- SET DATA=$GET(^(DA1,0))
- Begin DoDot:2
- +27 IF 'HOLDDATE
- IF $EXTRACT($PIECE(DATA,"^"),3)=2!($PIECE(DATA,"^")="AT1")
- SET FINDHOLD=$$HOLDDATE^GECSSTTR(DATA)
- IF FINDHOLD
- SET $PIECE(^GECS(2100.1,DA,11),"^",3)=FINDHOLD
- SET GECSFLAG=1
- QUIT
- +28 SET X=CHECKSUM_DATA
- XECUTE GECSLPC
- SET CHECKSUM=Y
- End DoDot:2
- if $GET(GECSFLAG)
- QUIT
- +29 ; for immediate transmissions, queue code sheet
- +30 IF $GET(GECSFLAG)
- if $GET(GECSFAUT)
- DO SETSTAT^GECSSTAA(DA,"Q")
- QUIT
- +31 ; compare checksums
- +32 SET X=$PIECE($GET(^GECS(2100.1,DA,11)),"^",2)
- IF X=""
- QUIT
- +33 IF X'=CHECKSUM
- DO SETSTAT^GECSSTAA(DA,"E")
- DO ERROR^GECSSTTR(DA,"Code sheet has been altered since creation")
- SET GECSFLAG=1
- End DoDot:1
- IF $GET(GECSFLAG)
- LOCK -^GECS(2100.1,DA)
- QUIT
- +34 ;
- +35 ; change transmission date on ctl segment
- +36 SET ^GECS(2100.1,DA,10,1,0)=$$CTLDATE^GECSSTTR(^GECS(2100.1,DA,10,1,0))
- +37 ;
- +38 ; fit code sheet in a sequence number if possible
- +39 SET STACSIZE=$PIECE($GET(^GECS(2100.1,DA,11)),"^")
- +40 IF STACSIZE>30000
- DO MULTIPLE
- LOCK -^GECS(2100.1,DA)
- QUIT
- +41 SET SEQUENCE=0
- FOR
- SET SEQUENCE=$ORDER(^TMP($JOB,"GECSSTTR","SIZE",SEQUENCE))
- if 'SEQUENCE
- QUIT
- SET SEQSIZE=^(SEQUENCE)
- IF ($PIECE(SEQSIZE,"^")+STACSIZE)<30000
- IF ^TMP($JOB,"GECSSTTR","BATCH",SEQUENCE)=BATCHDA
- QUIT
- +42 ; create a new sequence
- +43 IF 'SEQUENCE
- DO SEQUENCE
- SET SEQSIZE="0^0"
- +44 ;
- +45 ; recompute checksum with new transmission date and time on ctl segment
- +46 SET LINE=$PIECE(SEQSIZE,"^",2)
- SET CHECKSUM=""
- +47 SET DA1=0
- FOR
- SET DA1=$ORDER(^GECS(2100.1,DA,10,DA1))
- if 'DA1
- QUIT
- SET DATA=$GET(^(DA1,0))
- IF DATA'=""
- Begin DoDot:1
- +48 SET LINE=LINE+1
- SET ^TMP($JOB,"GECSSTTR","CS",SEQUENCE,LINE,0)=DATA
- +49 SET X=CHECKSUM_DATA
- XECUTE GECSLPC
- SET CHECKSUM=Y
- +50 ; check for last code sheet in stack entry
- +51 IF '$ORDER(^GECS(2100.1,DA,10,DA1))
- IF $LENGTH($GET(ENDOFCS))
- Begin DoDot:2
- +52 IF DATA'[ENDOFCS
- SET DATA=DATA_ENDOFCS
- +53 SET ^TMP($JOB,"GECSSTTR","CS",SEQUENCE,LINE,0)=DATA
- End DoDot:2
- QUIT
- End DoDot:1
- +54 ;
- +55 ; store new checksum
- +56 SET $PIECE(^GECS(2100.1,DA,11),"^",2)=CHECKSUM
- +57 ;
- +58 DO ENDSEQ($PIECE(SEQSIZE,"^")+STACSIZE,LINE)
- +59 LOCK -^GECS(2100.1,DA)
- +60 QUIT
- +61 ;
- +62 ;
- MULTIPLE ; code sheet is larger than 30k, create multiple msgs
- +1 DO SEQUENCE
- +2 NEW %,COUNT,SIZE,STRTSEQ,MAILMSGS
- +3 SET STRTSEQ=SEQUENCE
- +4 SET MAILMSGS=1
- SET (LINE,SIZE)=0
- SET CHECKSUM=""
- +5 SET DA1=0
- FOR
- SET DA1=$ORDER(^GECS(2100.1,DA,10,DA1))
- if 'DA1
- QUIT
- SET DATA=$GET(^(DA1,0))
- IF DATA'=""
- Begin DoDot:1
- +6 SET LINE=LINE+1
- SET ^TMP($JOB,"GECSSTTR","CS",SEQUENCE,LINE,0)=DATA
- +7 SET X=CHECKSUM_DATA
- XECUTE GECSLPC
- SET CHECKSUM=Y
- +8 ; check for last code sheet in stack entry
- +9 IF '$ORDER(^GECS(2100.1,DA,10,DA1))
- IF $LENGTH($GET(ENDOFCS))
- Begin DoDot:2
- +10 IF DATA'[ENDOFCS
- SET DATA=DATA_ENDOFCS
- +11 SET ^TMP($JOB,"GECSSTTR","CS",SEQUENCE,LINE,0)=DATA
- End DoDot:2
- QUIT
- +12 SET SIZE=SIZE+$LENGTH(DATA)
- +13 IF SIZE>30000
- Begin DoDot:2
- +14 IF $LENGTH($GET(ENDOFMSG))
- IF DATA'[ENDOFMSG
- SET ^TMP($JOB,"GECSSTTR","CS",SEQUENCE,LINE,0)=DATA_ENDOFMSG
- +15 DO ENDSEQ(SIZE,LINE)
- DO SEQUENCE
- SET MAILMSGS=MAILMSGS+1
- SET LINE=2
- SET SIZE=0
- End DoDot:2
- End DoDot:1
- +16 ;
- +17 ; store new checksum
- +18 SET $PIECE(^GECS(2100.1,DA,11),"^",2)=CHECKSUM
- +19 ;
- +20 ; modify sequence count
- +21 SET DATA=^GECS(2100.1,DA,10,1,0)
- SET $PIECE(DATA,"^",13)=$EXTRACT("000",$LENGTH(MAILMSGS)+1,3)_MAILMSGS
- +22 SET COUNT=1
- FOR %=STRTSEQ:1
- if '$DATA(^TMP($JOB,"GECSSTTR","CS",%))
- QUIT
- SET $PIECE(DATA,"^",12)=$EXTRACT("000",$LENGTH(COUNT)+1,3)_COUNT
- SET ^TMP($JOB,"GECSSTTR","CS",%,1,0)=DATA
- SET COUNT=COUNT+1
- +23 ;
- +24 ; send size=30001 to prevent other code sheets from being added
- +25 DO ENDSEQ(30001,LINE)
- +26 QUIT
- +27 ;
- +28 ;
- ENDSEQ(SIZE,LINE) ; set end sequence control in tmp
- +1 ; size=size of code sheet; line=last line of sequence
- +2 NEW %
- +3 SET ^TMP($JOB,"GECSSTTR","SIZE",SEQUENCE)=SIZE_"^"_LINE
- +4 SET ^TMP($JOB,"GECSSTTR","LIST",SEQUENCE,DA)=""
- +5 SET ^TMP($JOB,"GECSSTTR","BATCH",SEQUENCE)=BATCHDA
- +6 SET %=$GET(^TMP($JOB,"GECSSTTR","SEGS",SEQUENCE))
- IF %[$PIECE(SEGMENT,":")
- QUIT
- +7 SET ^TMP($JOB,"GECSSTTR","SEGS",SEQUENCE)=%_$SELECT(%="":"",1:",")_$PIECE(SEGMENT,":")
- +8 QUIT
- +9 ;
- +10 ;
- SEQUENCE ; return next sequence number
- +1 SET SEQUENCE=$GET(^TMP($JOB,"GECSSTTR","SEQ"))+1
- SET ^TMP($JOB,"GECSSTTR","SEQ")=SEQUENCE
- +2 QUIT
