source: WorldVistAEHR/trunk/r/GENERIC_CODE_SHEET-GEC/GECSSTTT.m@ 949

Last change on this file since 949 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1GECSSTTT ;WISC/RFJ-stacker file transmission routine ;08 Dec 93
2 ;;2.0;GCS;**27**;MAR 14, 1995
3 Q
4 ;
5 ;
6TRANSMIT ; transmit from ^tmp($j,"gecssttr","cs",sequence,line,0)
7 N %X,%Y,BATCH,BATCHDA,DA,GECSXMY,SEGTYPES,SEQUENCE,XCNP,XMDISPI,XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ
8 S SEQUENCE=0 F S SEQUENCE=$O(^TMP($J,"GECSSTTR","CS",SEQUENCE)) Q:'SEQUENCE D
9 . 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)="???"
10 . D RECUSER(BATCHDA,1)
11 . I '$D(GECSXMY) D TRANSERR("No receiving users for batch type: "_$P(BATCH,"^")) Q
12 . S %X="GECSXMY(",%Y="XMY(" D %XY^%RCR
13 . ;
14 . S SEGTYPES=$G(^TMP($J,"GECSSTTR","SEGS",SEQUENCE))
15 . 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)
16 . I $L(XMSUB)>65 S XMSUB=$E(XMSUB,1,64)_"*"
17 . K XMMG,XMZ
18 . D ^XMD
19 . I '$G(XMZ) D TRANSERR("Mailman Error: "_$S($G(XMMG)'="":XMMG,1:"<not recorded>")) Q
20 . S DA=0 F S DA=$O(^TMP($J,"GECSSTTR","LIST",SEQUENCE,DA)) Q:'DA D
21 . . D MESSAGE^GECSSTTR(DA,20,XMZ)
22 . . D SETSTAT^GECSSTAA(DA,"T")
23 Q
24 ;
25 ;
26TRANSERR(ERROR) ; error during transmitting mail message
27 S DA=0 F S DA=$O(^TMP($J,"GECSSTTR","LIST",SEQUENCE,DA)) Q:'DA D ERROR^GECSSTTR(DA,ERROR)
28 Q
29 ;
30 ;
31RECUSER(DA,GROUP) ; build receiving user array for batch (2101.1)
32 ; group = 1 to include G.batch mail group
33 ; receiving user array returned in GECSXMY
34 K GECSXMY
35 N %,D,DOMAIN,SYSID
36 I '$D(^GECS(2101.1,+DA)) Q
37 S %=0 F S %=$O(^GECS(2101.1,DA,2,%)) Q:'% S D=$G(^(%,0)) I $P(D,"^",3)=1 D
38 . S DOMAIN=$P($G(^DIC(4.2,+$P(D,"^",2),0)),"^") I DOMAIN'="" S DOMAIN="@"_DOMAIN
39 . S GECSXMY($P(D,"^")_DOMAIN)=""
40 ;
41 ; get user in mail group
42 I GROUP S SYSID=$P($G(^GECS(2101.1,DA,0)),"^",4) I $L(SYSID) S GECSXMY("G."_SYSID)=""
43 Q
Note: See TracBrowser for help on using the repository browser.