126 lines
5.3 KiB
Mathematica
126 lines
5.3 KiB
Mathematica
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
|