| 1 | GECSSTTR ;WISC/RFJ-stacker file transmission utilities ;08 Dec 93
|
|---|
| 2 | ;;2.0;GCS;**4,5,11,13,27**;MAR 14, 1995
|
|---|
| 3 | Q
|
|---|
| 4 | ;
|
|---|
| 5 | ;
|
|---|
| 6 | ERROR(DA,ERRORMSG) ; record error for stack da
|
|---|
| 7 | ; errormsg = error message to record
|
|---|
| 8 | I '$D(^GECS(2100.1,DA,0)) Q
|
|---|
| 9 | L +^GECS(2100.1,DA,1)
|
|---|
| 10 | I ERRORMSG="" S ERRORMSG="Unspecified"
|
|---|
| 11 | S $P(^GECS(2100.1,DA,1),"^",2)=ERRORMSG
|
|---|
| 12 | L -^GECS(2100.1,DA,1)
|
|---|
| 13 | Q
|
|---|
| 14 | ;
|
|---|
| 15 | ;
|
|---|
| 16 | RECUSER(SEGMENT,GROUP) ; build receiving user array for segment (2101.2)
|
|---|
| 17 | ; group = 1 to include G.batch mail group
|
|---|
| 18 | ; receiving user array returned in GECSXMY
|
|---|
| 19 | K GECSXMY
|
|---|
| 20 | N %,D,DA,DOMAIN,SYSID
|
|---|
| 21 | S DA=+$P($G(^GECS(2101.2,+$O(^GECS(2101.2,"B",SEGMENT,0)),0)),"^",4) I 'DA Q
|
|---|
| 22 | S %=0 F S %=$O(^GECS(2101.1,DA,2,%)) Q:'% S D=$G(^(%,0)) I $P(D,"^",3)=1 D
|
|---|
| 23 | . S DOMAIN=$P($G(^DIC(4.2,+$P(D,"^",2),0)),"^") I DOMAIN'="" S DOMAIN="@"_DOMAIN
|
|---|
| 24 | . S GECSXMY($P(D,"^")_DOMAIN)=""
|
|---|
| 25 | ;
|
|---|
| 26 | ; get user in mail group
|
|---|
| 27 | I GROUP S SYSID=$P($G(^GECS(2101.1,DA,0)),"^",4) I $L(SYSID) S GECSXMY("G."_SYSID)=""
|
|---|
| 28 | Q
|
|---|
| 29 | ;
|
|---|
| 30 | ;
|
|---|
| 31 | MAILMSG(SEGMENT,SEQUENCE,TOTAL) ; create mail message with code sheets
|
|---|
| 32 | ; segment = entry in file 2101.2
|
|---|
| 33 | ; sequence = sequence number
|
|---|
| 34 | ; total = total sequences
|
|---|
| 35 | ; returns xmz message number
|
|---|
| 36 | N %,%X,%Y,GECSXMY,XCNP,XMDISPI,XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ,ZTSK
|
|---|
| 37 | ;
|
|---|
| 38 | ; build receiving queue and user array
|
|---|
| 39 | D RECUSER(SEGMENT,1)
|
|---|
| 40 | I '$D(GECSXMY) Q "0^No receiving users for code sheets"
|
|---|
| 41 | S %X="GECSXMY(",%Y="XMY(" D %XY^%RCR
|
|---|
| 42 | ;
|
|---|
| 43 | S XMDUZ=$S($D(ZTQUEUED):.5,'$G(DUZ):.5,$G(GECSFQUE):.5,1:DUZ),XMTEXT="^TMP($J,""GECSSTTR"","_SEQUENCE_",",XMSUB="GCS TRANSACTION "_SEGMENT_" (MSG "_SEQUENCE_" OF "_TOTAL_")"
|
|---|
| 44 | D ^XMD
|
|---|
| 45 | I '$G(XMZ) S XMZ="0^Mailman Error: "_$S($G(XMMG)'="":XMMG,1:"<not recorded>")
|
|---|
| 46 | Q XMZ
|
|---|
| 47 | ;
|
|---|
| 48 | ;
|
|---|
| 49 | MESSAGE(DA,NODE,XMZ) ; add message (XMZ) to node in stack file for DA
|
|---|
| 50 | N %
|
|---|
| 51 | L +^GECS(2100.1,DA,NODE)
|
|---|
| 52 | I $D(^GECS(2100.1,DA,NODE,XMZ,0)) Q
|
|---|
| 53 | I '$D(^GECS(2100.1,DA,NODE,0)) S ^(0)=$S(NODE=20:"^2100.12^^",1:"^2100.121^^")
|
|---|
| 54 | S ^GECS(2100.1,DA,NODE,XMZ,0)=XMZ
|
|---|
| 55 | S ^GECS(2100.1,"AM",XMZ,DA)=""
|
|---|
| 56 | S %=^GECS(2100.1,DA,NODE,0),$P(%,"^",3)=XMZ,$P(%,"^",4)=$P(%,"^",4)+1,^(0)=%
|
|---|
| 57 | L -^GECS(2100.1,DA,NODE)
|
|---|
| 58 | Q
|
|---|
| 59 | ;
|
|---|
| 60 | ;
|
|---|
| 61 | HOLDDATE(DATA) ; return the hold date from the tt2 segment
|
|---|
| 62 | ; if hold date is not greater than today, return null
|
|---|
| 63 | N HOLDDATE
|
|---|
| 64 | S HOLDDATE=$P(DATA,"^",2)_$P(DATA,"^",3)_$P(DATA,"^",4)
|
|---|
| 65 | ; some segments have yr and mo on different pieces
|
|---|
| 66 | I $P(DATA,"^")="AT1" S HOLDDATE=$P(DATA,"^",6)_$P(DATA,"^",4)_$P(DATA,"^",5)
|
|---|
| 67 | I "BD2PV2SA2ST2DD2"[$P(DATA,"^") S HOLDDATE=$P(DATA,"^",4)_$P(DATA,"^",2)_$P(DATA,"^",3)
|
|---|
| 68 | I $L(HOLDDATE)'=6 Q ""
|
|---|
| 69 | S HOLDDATE=$S($E(HOLDDATE,1,2)<70:3,1:2)_HOLDDATE
|
|---|
| 70 | I HOLDDATE'>DT Q ""
|
|---|
| 71 | Q HOLDDATE
|
|---|
| 72 | ;
|
|---|
| 73 | ;
|
|---|
| 74 | CTLDATE(CTLSEG) ; put transmission date and time on ctl segment
|
|---|
| 75 | N %,%H,%I,X,Y
|
|---|
| 76 | D NOW^%DTC
|
|---|
| 77 | S $P(CTLSEG,"^",10)=(17+$E(X))_$E(X,2,7)
|
|---|
| 78 | S Y=% D DD^%DT
|
|---|
| 79 | S $P(CTLSEG,"^",11)=$$FORMTIME^GECSUFM1($P(Y,"@",2))
|
|---|
| 80 | Q CTLSEG
|
|---|
