source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPSMCS.m@ 1800

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

initial load of WorldVistAEHR
File size: 3.6 KB
RevLine 
[613]1PRCPSMCS ;WISC/RFJ-create and transmit isms code sheet from tmp ;7/8/96 9:30 AM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7TRANSMIT(V1,V2,V3,V4,V5,V6) ; transmit code sheets from tmp global
8 ; v1=station number
9 ; v2=transaction code (BAL or PHA, etc)
10 ; v3=reference number for header
11 ; v4=1stQueue^2ndQueue^... (form ISM or ISM^EDP)
12 ; v5=receiving station number for control segment
13 ; v6=transaction interface version number...padded to 3 numbers
14 ; with leading zeros
15 ; tmp($j,"string",1:n)=code sheet data
16 ; returns prcpxmz(sequence number)=mailman message number
17 ;
18 N %,CONTROL,COUNT,CSHEET,DATA,LASTONE,LINE,LINECNT,SEQUENCE,SIZE,XMZ
19 ; get control segment
20 S CONTROL=$$CONTROL(V1,V2,V3,V5,$G(V6))
21 ;
22 K ^TMP($J,"PRCPSMC0"),PRCPXMZ
23 ;
24 ; move code sheets to message number in tmp global
25 S SEQUENCE=1,LINE=2,(SIZE,COUNT,CSHEET)=0 F S CSHEET=$O(^TMP($J,"STRING",CSHEET)) Q:'CSHEET S DATA=^(CSHEET),COUNT=COUNT+1 D
26 . ;
27 . ; check for last code sheet => set flag
28 . I '$O(^TMP($J,"STRING",CSHEET)) S LASTONE=1,DATA=DATA_"$"
29 . ;
30 . ; calculate message size
31 . S SIZE=SIZE+$L(DATA) I SIZE>30000,'$G(LASTONE) S DATA=DATA_$C(126)
32 . ;
33 . ; build message in tmp
34 . S ^TMP($J,"PRCPSMC0",SEQUENCE,LINE,0)=DATA,LINE=LINE+1
35 . ;
36 . ; increment counters if size exceeds 30k
37 . I '$G(LASTONE),SIZE>30000 S SEQUENCE=SEQUENCE+1,LINE=2,SIZE=$L(DATA)
38 ;
39 ; get line count segment if required by transaction code
40 I "BAL"[V2 S LINECNT=$$LINECNT(COUNT,V3)
41 ;
42 ; put control headers on code sheets and transmit
43 S $P(CONTROL,"^",9)=$E("000",$L(SEQUENCE)+1,3)_SEQUENCE
44 F COUNT=1:1:SEQUENCE Q:'$D(^TMP($J,"PRCPSMC0",COUNT)) D
45 . ;
46 . ; set control header to current sequence number (stored in count)
47 . S $P(CONTROL,"^",8)=$E("000",$L(COUNT)+1,3)_COUNT,^TMP($J,"PRCPSMC0",COUNT,1,0)=CONTROL_$S(COUNT=1&($D(LINECNT)):LINECNT,1:"")
48 . ;
49 . ; create and transmit mail message
50 . D MAILMSG(COUNT,SEQUENCE,V2,V4)
51 . S PRCPXMZ(COUNT)=+$G(XMZ)
52 K ^TMP($J,"PRCPSMC0")
53 Q
54 ;
55 ;
56CONTROL(V1,V2,V3,V4,V5) ; build control segment
57 ; v1=station number
58 ; v2=transaction code
59 ; v3=reference number
60 ; v4=receiving station number
61 ; v5=transaction intreface version number
62 ; returns control segment string
63 N %,%H,%I,DATE,NOW,TIME,VERSION,X,Y
64 D NOW^%DTC S NOW=%,TIME=$E($P(%,".",2)_"000000",1,6),X1=$P(NOW,"."),X2=$E(NOW,1,3)_"0101" D ^%DTC S X=X+1,X=$E("000",$L(X)+1,3)_X,DATE=($E(NOW)+17)_$E(NOW,2,3)_X
65 S VERSION=$S($G(V5)>0:V5,1:40)
66 S VERSION=$E("000",$L(VERSION)+1,3)_VERSION
67 Q "ISM^"_$E(" ",$L(V1)+1,3)_V1_"^"_$E(" ",$L(V4)+1,3)_V4_"^"_$E(" ",$L(V2)+1,3)_V2_"^"_DATE_"^"_TIME_"^"_V3_$E(" ",$L(V3)+1,20)_"^001^001^"_VERSION_"^|"
68 ;
69 ;
70LINECNT(V1,V2) ;line count segment
71 ; v1=line count
72 ; v2=reference number
73 ; returns line count segment
74 Q "LC^"_V1_"^"_V2_"^|"
75 ;
76 ;
77MAILMSG(V1,V2,V3,V4) ;create mail message
78 ; v1=sequence number
79 ; v2=total sequences
80 ; v3=transaction type
81 ; v4=1stQueue^2ndQueue^... (form ISM or ISM^EDP)
82 ; returns xmz message number
83 N %,DA,DIC,GROUP,XCNP,XMDUZ,XMTEXT,XMY
84 ;
85 ; set group variable to send messages to mail group
86 S GROUP=0
87 ;
88 ; build receiving queue and user array
89 F %=1:1 Q:$P(V4,"^",%)="" S XMY("XXX@Q-"_$P(V4,"^",%)_".VA.GOV")="" I $G(GROUP) S XMY("G."_$P(V4,"^",%))=""
90 S DA=+$P($G(^PRCD(420.4,+$O(^PRCD(420.4,"B",V3,0)),0)),"^",4),%=0 F S %=$O(^PRCF(423.9,DA,1,%)) Q:'% S XMDUZ=+$G(^(%,0)) I XMDUZ S XMY(XMDUZ)=""
91 S XMDUZ=DUZ,XMTEXT="^TMP($J,""PRCPSMC0"","_V1_",",XMSUB=V3_" TRANSACTION TO Q-"_$TR(V4,"^","/")_" (MSG "_V1_" OF "_V2_")"
92 K XMZ D ^XMD Q
Note: See TracBrowser for help on using the repository browser.