GECSSTTT ;WISC/RFJ-stacker file transmission routine ;08 Dec 93
;;2.0;GCS;**27**;MAR 14, 1995
Q
;
;
TRANSMIT ; transmit from ^tmp($j,"gecssttr","cs",sequence,line,0)
N %X,%Y,BATCH,BATCHDA,DA,GECSXMY,SEGTYPES,SEQUENCE,XCNP,XMDISPI,XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ
S SEQUENCE=0 F S SEQUENCE=$O(^TMP($J,"GECSSTTR","CS",SEQUENCE)) Q:'SEQUENCE D
. S BATCHDA=^TMP($J,"GECSSTTR","BATCH",SEQUENCE),BATCH=$G(^GECS(2101.1,BATCHDA,0)) S:$P(BATCH,"^")="" $P(BATCH,"^")="<<UNDEFINED BATCH TYPE>>" S:$P(BATCH,"^",4)="" $P(BATCH,"^",4)="???"
. D RECUSER(BATCHDA,1)
. I '$D(GECSXMY) D TRANSERR("No receiving users for batch type: "_$P(BATCH,"^")) Q
. S %X="GECSXMY(",%Y="XMY(" D %XY^%RCR
. ;
. S SEGTYPES=$G(^TMP($J,"GECSSTTR","SEGS",SEQUENCE))
. S XMDUZ=$S($D(ZTQUEUED):.5,'$G(DUZ):.5,$G(GECSFQUE):.5,1:DUZ),XMTEXT="^TMP($J,""GECSSTTR"",""CS"","_SEQUENCE_",",XMSUB="GCS TRANSACTION "_$P(BATCH,"^",4)_$S(SEGTYPES="":"",1:":"_SEGTYPES)
. I $L(XMSUB)>65 S XMSUB=$E(XMSUB,1,64)_"*"
. K XMMG,XMZ
. D ^XMD
. I '$G(XMZ) D TRANSERR("Mailman Error: "_$S($G(XMMG)'="":XMMG,1:"<not recorded>")) Q
. S DA=0 F S DA=$O(^TMP($J,"GECSSTTR","LIST",SEQUENCE,DA)) Q:'DA D
. . D MESSAGE^GECSSTTR(DA,20,XMZ)
. . D SETSTAT^GECSSTAA(DA,"T")
Q
;
;
TRANSERR(ERROR) ; error during transmitting mail message
S DA=0 F S DA=$O(^TMP($J,"GECSSTTR","LIST",SEQUENCE,DA)) Q:'DA D ERROR^GECSSTTR(DA,ERROR)
Q
;
;
RECUSER(DA,GROUP) ; build receiving user array for batch (2101.1)
; group = 1 to include G.batch mail group
; receiving user array returned in GECSXMY
K GECSXMY
N %,D,DOMAIN,SYSID
I '$D(^GECS(2101.1,+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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGECSSTTT 2007 printed Dec 13, 2024@01:56:32 Page 2
GECSSTTT ;WISC/RFJ-stacker file transmission routine ;08 Dec 93
+1 ;;2.0;GCS;**27**;MAR 14, 1995
+2 QUIT
+3 ;
+4 ;
TRANSMIT ; transmit from ^tmp($j,"gecssttr","cs",sequence,line,0)
+1 NEW %X,%Y,BATCH,BATCHDA,DA,GECSXMY,SEGTYPES,SEQUENCE,XCNP,XMDISPI,XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ
+2 SET SEQUENCE=0
FOR
SET SEQUENCE=$ORDER(^TMP($JOB,"GECSSTTR","CS",SEQUENCE))
if 'SEQUENCE
QUIT
Begin DoDot:1
+3 SET BATCHDA=^TMP($JOB,"GECSSTTR","BATCH",SEQUENCE)
SET BATCH=$GET(^GECS(2101.1,BATCHDA,0))
if $PIECE(BATCH,"^")=""
SET $PIECE(BATCH,"^")="<<UNDEFINED BATCH TYPE>>"
if $PIECE(BATCH,"^",4)=""
SET $PIECE(BATCH,"^",4)="???"
+4 DO RECUSER(BATCHDA,1)
+5 IF '$DATA(GECSXMY)
DO TRANSERR("No receiving users for batch type: "_$PIECE(BATCH,"^"))
QUIT
+6 SET %X="GECSXMY("
SET %Y="XMY("
DO %XY^%RCR
+7 ;
+8 SET SEGTYPES=$GET(^TMP($JOB,"GECSSTTR","SEGS",SEQUENCE))
+9 SET XMDUZ=$SELECT($DATA(ZTQUEUED):.5,'$GET(DUZ):.5,$GET(GECSFQUE):.5,1:DUZ)
SET XMTEXT="^TMP($J,""GECSSTTR"",""CS"","_SEQUENCE_","
SET XMSUB="GCS TRANSACTION "_$PIECE(BATCH,"^",4)_$SELECT(SEGTYPES="":"",1:":"_SEGTYPES)
+10 IF $LENGTH(XMSUB)>65
SET XMSUB=$EXTRACT(XMSUB,1,64)_"*"
+11 KILL XMMG,XMZ
+12 DO ^XMD
+13 IF '$GET(XMZ)
DO TRANSERR("Mailman Error: "_$SELECT($GET(XMMG)'="":XMMG,1:"<not recorded>"))
QUIT
+14 SET DA=0
FOR
SET DA=$ORDER(^TMP($JOB,"GECSSTTR","LIST",SEQUENCE,DA))
if 'DA
QUIT
Begin DoDot:2
+15 DO MESSAGE^GECSSTTR(DA,20,XMZ)
+16 DO SETSTAT^GECSSTAA(DA,"T")
End DoDot:2
End DoDot:1
+17 QUIT
+18 ;
+19 ;
TRANSERR(ERROR) ; error during transmitting mail message
+1 SET DA=0
FOR
SET DA=$ORDER(^TMP($JOB,"GECSSTTR","LIST",SEQUENCE,DA))
if 'DA
QUIT
DO ERROR^GECSSTTR(DA,ERROR)
+2 QUIT
+3 ;
+4 ;
RECUSER(DA,GROUP) ; build receiving user array for batch (2101.1)
+1 ; group = 1 to include G.batch mail group
+2 ; receiving user array returned in GECSXMY
+3 KILL GECSXMY
+4 NEW %,D,DOMAIN,SYSID
+5 IF '$DATA(^GECS(2101.1,+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
