GECSSTTR ;WISC/RFJ-stacker file transmission utilities ;08 Dec 93
;;2.0;GCS;**4,5,11,13,27**;MAR 14, 1995
Q
;
;
ERROR(DA,ERRORMSG) ; record error for stack da
; errormsg = error message to record
I '$D(^GECS(2100.1,DA,0)) Q
L +^GECS(2100.1,DA,1)
I ERRORMSG="" S ERRORMSG="Unspecified"
S $P(^GECS(2100.1,DA,1),"^",2)=ERRORMSG
L -^GECS(2100.1,DA,1)
Q
;
;
RECUSER(SEGMENT,GROUP) ; build receiving user array for segment (2101.2)
; group = 1 to include G.batch mail group
; receiving user array returned in GECSXMY
K GECSXMY
N %,D,DA,DOMAIN,SYSID
S DA=+$P($G(^GECS(2101.2,+$O(^GECS(2101.2,"B",SEGMENT,0)),0)),"^",4) I 'DA Q
S %=0 F S %=$O(^GECS(2101.1,DA,2,%)) Q:'% S D=$G(^(%,0)) I $P(D,"^",3)=1 D
. S DOMAIN=$P($G(^DIC(4.2,+$P(D,"^",2),0)),"^") I DOMAIN'="" S DOMAIN="@"_DOMAIN
. S GECSXMY($P(D,"^")_DOMAIN)=""
;
; get user in mail group
I GROUP S SYSID=$P($G(^GECS(2101.1,DA,0)),"^",4) I $L(SYSID) S GECSXMY("G."_SYSID)=""
Q
;
;
MAILMSG(SEGMENT,SEQUENCE,TOTAL) ; create mail message with code sheets
; segment = entry in file 2101.2
; sequence = sequence number
; total = total sequences
; returns xmz message number
N %,%X,%Y,GECSXMY,XCNP,XMDISPI,XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ,ZTSK
;
; build receiving queue and user array
D RECUSER(SEGMENT,1)
I '$D(GECSXMY) Q "0^No receiving users for code sheets"
S %X="GECSXMY(",%Y="XMY(" D %XY^%RCR
;
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_")"
D ^XMD
I '$G(XMZ) S XMZ="0^Mailman Error: "_$S($G(XMMG)'="":XMMG,1:"<not recorded>")
Q XMZ
;
;
MESSAGE(DA,NODE,XMZ) ; add message (XMZ) to node in stack file for DA
N %
L +^GECS(2100.1,DA,NODE)
I $D(^GECS(2100.1,DA,NODE,XMZ,0)) Q
I '$D(^GECS(2100.1,DA,NODE,0)) S ^(0)=$S(NODE=20:"^2100.12^^",1:"^2100.121^^")
S ^GECS(2100.1,DA,NODE,XMZ,0)=XMZ
S ^GECS(2100.1,"AM",XMZ,DA)=""
S %=^GECS(2100.1,DA,NODE,0),$P(%,"^",3)=XMZ,$P(%,"^",4)=$P(%,"^",4)+1,^(0)=%
L -^GECS(2100.1,DA,NODE)
Q
;
;
HOLDDATE(DATA) ; return the hold date from the tt2 segment
; if hold date is not greater than today, return null
N HOLDDATE
S HOLDDATE=$P(DATA,"^",2)_$P(DATA,"^",3)_$P(DATA,"^",4)
; some segments have yr and mo on different pieces
I $P(DATA,"^")="AT1" S HOLDDATE=$P(DATA,"^",6)_$P(DATA,"^",4)_$P(DATA,"^",5)
I "BD2PV2SA2ST2DD2"[$P(DATA,"^") S HOLDDATE=$P(DATA,"^",4)_$P(DATA,"^",2)_$P(DATA,"^",3)
I $L(HOLDDATE)'=6 Q ""
S HOLDDATE=$S($E(HOLDDATE,1,2)<70:3,1:2)_HOLDDATE
I HOLDDATE'>DT Q ""
Q HOLDDATE
;
;
CTLDATE(CTLSEG) ; put transmission date and time on ctl segment
N %,%H,%I,X,Y
D NOW^%DTC
S $P(CTLSEG,"^",10)=(17+$E(X))_$E(X,2,7)
S Y=% D DD^%DT
S $P(CTLSEG,"^",11)=$$FORMTIME^GECSUFM1($P(Y,"@",2))
Q CTLSEG
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGECSSTTR 2897 printed Nov 22, 2024@17:06:39 Page 2
GECSSTTR ;WISC/RFJ-stacker file transmission utilities ;08 Dec 93
+1 ;;2.0;GCS;**4,5,11,13,27**;MAR 14, 1995
+2 QUIT
+3 ;
+4 ;
ERROR(DA,ERRORMSG) ; record error for stack da
+1 ; errormsg = error message to record
+2 IF '$DATA(^GECS(2100.1,DA,0))
QUIT
+3 LOCK +^GECS(2100.1,DA,1)
+4 IF ERRORMSG=""
SET ERRORMSG="Unspecified"
+5 SET $PIECE(^GECS(2100.1,DA,1),"^",2)=ERRORMSG
+6 LOCK -^GECS(2100.1,DA,1)
+7 QUIT
+8 ;
+9 ;
RECUSER(SEGMENT,GROUP) ; build receiving user array for segment (2101.2)
+1 ; group = 1 to include G.batch mail group
+2 ; receiving user array returned in GECSXMY
+3 KILL GECSXMY
+4 NEW %,D,DA,DOMAIN,SYSID
+5 SET DA=+$PIECE($GET(^GECS(2101.2,+$ORDER(^GECS(2101.2,"B",SEGMENT,0)),0)),"^",4)
IF 'DA
QUIT
+6 SET %=0
FOR
SET %=$ORDER(^GECS(2101.1,DA,2,%))
if '%
QUIT
SET D=$GET(^(%,0))
IF $PIECE(D,"^",3)=1
Begin DoDot:1
+7 SET DOMAIN=$PIECE($GET(^DIC(4.2,+$PIECE(D,"^",2),0)),"^")
IF DOMAIN'=""
SET DOMAIN="@"_DOMAIN
+8 SET GECSXMY($PIECE(D,"^")_DOMAIN)=""
End DoDot:1
+9 ;
+10 ; get user in mail group
+11 IF GROUP
SET SYSID=$PIECE($GET(^GECS(2101.1,DA,0)),"^",4)
IF $LENGTH(SYSID)
SET GECSXMY("G."_SYSID)=""
+12 QUIT
+13 ;
+14 ;
MAILMSG(SEGMENT,SEQUENCE,TOTAL) ; create mail message with code sheets
+1 ; segment = entry in file 2101.2
+2 ; sequence = sequence number
+3 ; total = total sequences
+4 ; returns xmz message number
+5 NEW %,%X,%Y,GECSXMY,XCNP,XMDISPI,XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ,ZTSK
+6 ;
+7 ; build receiving queue and user array
+8 DO RECUSER(SEGMENT,1)
+9 IF '$DATA(GECSXMY)
QUIT "0^No receiving users for code sheets"
+10 SET %X="GECSXMY("
SET %Y="XMY("
DO %XY^%RCR
+11 ;
+12 SET XMDUZ=$SELECT($DATA(ZTQUEUED):.5,'$GET(DUZ):.5,$GET(GECSFQUE):.5,1:DUZ)
SET XMTEXT="^TMP($J,""GECSSTTR"","_SEQUENCE_","
SET XMSUB="GCS TRANSACTION "_SEGMENT_" (MSG "_SEQUENCE_" OF "_TOTAL_")"
+13 DO ^XMD
+14 IF '$GET(XMZ)
SET XMZ="0^Mailman Error: "_$SELECT($GET(XMMG)'="":XMMG,1:"<not recorded>")
+15 QUIT XMZ
+16 ;
+17 ;
MESSAGE(DA,NODE,XMZ) ; add message (XMZ) to node in stack file for DA
+1 NEW %
+2 LOCK +^GECS(2100.1,DA,NODE)
+3 IF $DATA(^GECS(2100.1,DA,NODE,XMZ,0))
QUIT
+4 IF '$DATA(^GECS(2100.1,DA,NODE,0))
SET ^(0)=$SELECT(NODE=20:"^2100.12^^",1:"^2100.121^^")
+5 SET ^GECS(2100.1,DA,NODE,XMZ,0)=XMZ
+6 SET ^GECS(2100.1,"AM",XMZ,DA)=""
+7 SET %=^GECS(2100.1,DA,NODE,0)
SET $PIECE(%,"^",3)=XMZ
SET $PIECE(%,"^",4)=$PIECE(%,"^",4)+1
SET ^(0)=%
+8 LOCK -^GECS(2100.1,DA,NODE)
+9 QUIT
+10 ;
+11 ;
HOLDDATE(DATA) ; return the hold date from the tt2 segment
+1 ; if hold date is not greater than today, return null
+2 NEW HOLDDATE
+3 SET HOLDDATE=$PIECE(DATA,"^",2)_$PIECE(DATA,"^",3)_$PIECE(DATA,"^",4)
+4 ; some segments have yr and mo on different pieces
+5 IF $PIECE(DATA,"^")="AT1"
SET HOLDDATE=$PIECE(DATA,"^",6)_$PIECE(DATA,"^",4)_$PIECE(DATA,"^",5)
+6 IF "BD2PV2SA2ST2DD2"[$PIECE(DATA,"^")
SET HOLDDATE=$PIECE(DATA,"^",4)_$PIECE(DATA,"^",2)_$PIECE(DATA,"^",3)
+7 IF $LENGTH(HOLDDATE)'=6
QUIT ""
+8 SET HOLDDATE=$SELECT($EXTRACT(HOLDDATE,1,2)<70:3,1:2)_HOLDDATE
+9 IF HOLDDATE'>DT
QUIT ""
+10 QUIT HOLDDATE
+11 ;
+12 ;
CTLDATE(CTLSEG) ; put transmission date and time on ctl segment
+1 NEW %,%H,%I,X,Y
+2 DO NOW^%DTC
+3 SET $PIECE(CTLSEG,"^",10)=(17+$EXTRACT(X))_$EXTRACT(X,2,7)
+4 SET Y=%
DO DD^%DT
+5 SET $PIECE(CTLSEG,"^",11)=$$FORMTIME^GECSUFM1($PIECE(Y,"@",2))
+6 QUIT CTLSEG
