Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GECSSTTR

GECSSTTR.m

Go to the documentation of this file. 
  1. GECSSTTR ;WISC/RFJ-stacker file transmission utilities ;08 Dec 93
  1.  ;;2.0;GCS;**4,5,11,13,27**;MAR 14, 1995
  1.  Q
  1.  ;
  1.  ;
  1. ERROR(DA,ERRORMSG)          ;  record error for stack da
  1.  ;  errormsg = error message to record
  1.  I '$D(^GECS(2100.1,DA,0)) Q
  1.  L +^GECS(2100.1,DA,1)
  1.  I ERRORMSG="" S ERRORMSG="Unspecified"
  1.  S $P(^GECS(2100.1,DA,1),"^",2)=ERRORMSG
  1.  L -^GECS(2100.1,DA,1)
  1.  Q
  1.  ;
  1.  ;
  1. RECUSER(SEGMENT,GROUP)     ;  build receiving user array for segment (2101.2)
  1.  ;  group = 1 to include G.batch mail group
  1.  ;  receiving user array returned in GECSXMY
  1.  K GECSXMY
  1.  N %,D,DA,DOMAIN,SYSID
  1.  S DA=+$P($G(^GECS(2101.2,+$O(^GECS(2101.2,"B",SEGMENT,0)),0)),"^",4) I 'DA Q
  1.  S %=0 F  S %=$O(^GECS(2101.1,DA,2,%)) Q:'%  S D=$G(^(%,0)) I $P(D,"^",3)=1 D
  1.  .   S DOMAIN=$P($G(^DIC(4.2,+$P(D,"^",2),0)),"^") I DOMAIN'="" S DOMAIN="@"_DOMAIN
  1.  .   S GECSXMY($P(D,"^")_DOMAIN)=""
  1.  ;
  1.  ; get user in mail group
  1.  I GROUP S SYSID=$P($G(^GECS(2101.1,DA,0)),"^",4) I $L(SYSID) S GECSXMY("G."_SYSID)=""
  1.  Q
  1.  ;
  1.  ;
  1. MAILMSG(SEGMENT,SEQUENCE,TOTAL) ;  create mail message with code sheets
  1.  ;  segment = entry in file 2101.2
  1.  ;  sequence = sequence number
  1.  ;  total = total sequences
  1.  ;  returns xmz message number
  1.  N %,%X,%Y,GECSXMY,XCNP,XMDISPI,XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ,ZTSK
  1.  ;
  1.  ;  build receiving queue and user array
  1.  D RECUSER(SEGMENT,1)
  1.  I '$D(GECSXMY) Q "0^No receiving users for code sheets"
  1.  S %X="GECSXMY(",%Y="XMY(" D %XY^%RCR
  1.  ;
  1.  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_")"
  1.  D ^XMD
  1.  I '$G(XMZ) S XMZ="0^Mailman Error: "_$S($G(XMMG)'="":XMMG,1:"<not recorded>")
  1.  Q XMZ
  1.  ;
  1.  ;
  1. MESSAGE(DA,NODE,XMZ) ;  add message (XMZ) to node in stack file for DA
  1.  N %
  1.  L +^GECS(2100.1,DA,NODE)
  1.  I $D(^GECS(2100.1,DA,NODE,XMZ,0)) Q
  1.  I '$D(^GECS(2100.1,DA,NODE,0)) S ^(0)=$S(NODE=20:"^2100.12^^",1:"^2100.121^^")
  1.  S ^GECS(2100.1,DA,NODE,XMZ,0)=XMZ
  1.  S ^GECS(2100.1,"AM",XMZ,DA)=""
  1.  S %=^GECS(2100.1,DA,NODE,0),$P(%,"^",3)=XMZ,$P(%,"^",4)=$P(%,"^",4)+1,^(0)=%
  1.  L -^GECS(2100.1,DA,NODE)
  1.  Q
  1.  ;
  1.  ;
  1. HOLDDATE(DATA) ;  return the hold date from the tt2 segment
  1.  ;  if hold date is not greater than today, return null
  1.  N HOLDDATE
  1.  S HOLDDATE=$P(DATA,"^",2)_$P(DATA,"^",3)_$P(DATA,"^",4)
  1.  ;  some segments have yr and mo on different pieces
  1.  I $P(DATA,"^")="AT1" S HOLDDATE=$P(DATA,"^",6)_$P(DATA,"^",4)_$P(DATA,"^",5)
  1.  I "BD2PV2SA2ST2DD2"[$P(DATA,"^") S HOLDDATE=$P(DATA,"^",4)_$P(DATA,"^",2)_$P(DATA,"^",3)
  1.  I $L(HOLDDATE)'=6 Q ""
  1.  S HOLDDATE=$S($E(HOLDDATE,1,2)<70:3,1:2)_HOLDDATE
  1.  I HOLDDATE'>DT Q ""
  1.  Q HOLDDATE
  1.  ;
  1.  ;
  1. CTLDATE(CTLSEG) ;  put transmission date and time on ctl segment
  1.  N %,%H,%I,X,Y
  1.  D NOW^%DTC
  1.  S $P(CTLSEG,"^",10)=(17+$E(X))_$E(X,2,7)
  1.  S Y=% D DD^%DT
  1.  S $P(CTLSEG,"^",11)=$$FORMTIME^GECSUFM1($P(Y,"@",2))
  1.  Q CTLSEG