source: WorldVistAEHR/trunk/r/GENERIC_CODE_SHEET-GEC/GECSSTTR.m@ 1639

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

initial load of WorldVistAEHR

File size: 2.8 KB
Line 
1GECSSTTR ;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 ;
6ERROR(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 ;
16RECUSER(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 ;
31MAILMSG(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 ;
49MESSAGE(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 ;
61HOLDDATE(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 ;
74CTLDATE(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
Note: See TracBrowser for help on using the repository browser.