source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNLXMD.m@ 632

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

initial load of FOIAVistA 6/30/08 version

File size: 2.3 KB
Line 
1SPNLXMD ;ISCSF/RAH - LOAD Records INTO Mail AND Send ;1/12/96 10:27
2V ;;2.0;Spinal Cord Dysfunction;**2**;01/02/1997
3 ;
4EN1(SPNLTEXT,SPNLSUB,SPNLXMY,SPNLERR) ; Entry point.
5 D INIT
6 S SPNLERR=0,SPNLLN=0,SPNLV=0,SPNLSSN="",SPNLNX=0,SPNLTX=0,SPNLLMT=0,SPNLEX=""
7 D EDITCK I SPNLERR D CLR Q
8 D REFORM I SPNLERR D CLR Q
9 D LOADIT
10 D CLR
11 Q
12EDITCK ; Verify proper data set up when called.
13 I '$D(SPNLTEXT) S SPNLERR="1^SPNLTEXT NOT DEFINED" W:'$D(ZTQUEUED) !!,"GLOBAL LOCATION REQUIRED!!!" Q
14 I '$D(SPNLSUB) S SPNLERR="2^SPNLSUB NOT DEFINED" W:'$D(ZTQUEUED) !!,"MESSAGE SUBJECT REQUIRED!!!" Q
15 I '$D(SPNLXMY) S SPNLERR="3^SPNLXMY NOT DEFINED" W:'$D(ZTQUEUED) !!,"MESSAGE DESTINATION REQUIRED!!!" Q
16 S:'$D(DUZ) SPNLDUZ=".5"
17 Q
18REFORM ;
19 S SPNLX=1
20 F S SPNLSSN=$O(^TMP("SPNX",SPNLJ,SPNLSDT,SPNLFAC,SPNLSSN)) Q:SPNLSSN="" D
21 .S SPNLEX=.9 I $D(^TMP("SPNX",SPNLJ,SPNLSDT,SPNLFAC,SPNLSSN))#10 S SPNLTXT="^TMP(""SPNX"",SPNLJ,SPNLSDT,SPNLFAC,SPNLSSN)" D GLB2MAIL
22 .F S SPNLEX=$O(^TMP("SPNX",SPNLJ,SPNLSDT,SPNLFAC,SPNLSSN,SPNLEX)) Q:SPNLEX="" D
23 ..S SPNLNX=0
24 ..F S SPNLNX=$O(^TMP("SPNX",SPNLJ,SPNLSDT,SPNLFAC,SPNLSSN,SPNLEX,SPNLNX)) Q:SPNLNX'>0 D
25 ...S SPNLTXT="^TMP(""SPNX"",SPNLJ,SPNLSDT,SPNLFAC,SPNLSSN,SPNLEX,SPNLNX)" D GLB2MAIL
26 S SPNLTEXT(2)=SPNLTEXT_"""MAIL"""_",SPNLNX)",SPNLTEXT(1)=SPNLTEXT_"""XMD"""_",SPNLLN)"
27 I '$D(@(SPNLTEXT_"""MAIL"",1)")) S SPNLERR="4^NO RECORD CHANGES TO TRANSMIT" Q
28 Q
29GLB2MAIL ;
30 S SPNLMN=@(SPNLTXT),SPNLMM=SPNLFAC_";"_SPNLSSN_";"_SPNLEX_";"_SPNLNX_"$"_SPNLMN
31 S ^TMP("SPNX",SPNLJ,"MAIL",SPNLX)="D$ "_SPNLMM,SPNLX=SPNLX+1
32 Q
33LOADIT ;
34 S SPNLLN=2,MAXRECS=SPNXRECS+2
35 F S SPNLNX=$O(@(SPNLTEXT(2))) Q:SPNLNX="" D Q:SPNLERR
36 . S SPNLLN=SPNLLN+1
37 . I SPNLLN>MAXRECS D SENDMSG S SPNLLN=3
38 . S @SPNLTEXT(1)=@SPNLTEXT(2)
39 D SENDMSG
40 K MAXRECS
41 Q
42SENDMSG ;
43 S SPNLLN=2 S @SPNLTEXT(1)="F$ "_^TMP("SPNX",SPNLJ,SPNLSDT,SPNLFAC)
44 S SPNLLN=1 S @SPNLTEXT(1)="H$ "_SPNLHDR
45 S SPNLV=SPNLV+1,XMSUB=SPNLSUB,XMDUZ=SPNLDUZ
46 ;S XMY(DUZ)=""
47 S XMY(SPNLXMY)=""
48 S XMTEXT=SPNLTEXT_"""XMD""," D ^XMD I '$D(XMZ) S SPNLERR="5^TRANSMIT ERROR" W:'$D(ZTQUEUED) !,"TRANSMISSION ERR" G XIT1
49 S SPNLXMZ=XMZ
50 K @(SPNLTEXT_"""XMD"")")
51XIT1 ;
52 Q
53CLR ;
54 K SPNLEX,SPNLII,SPNLJ,SPNLLMT,SPNLMM,SPNLMN,SPNLSSN,SPNLTX,SPNLTXT
55 K SPNLTY,SPNLX,SPNLXMZ,SPNLDUZ,SPNLLN,SPNLNX,SPNLV
56 K XMDUZ,XMSUB,XMTEXT,XMY,XMZ
57 Q
58INIT ;
59 K XMSUB,XMTEXT,XMY,XMZ
60 S SPNLJ=$J
61 I DUZ'="" S SPNLDUZ=DUZ
62 E S SPNLDUZ=.5
63 Q
Note: See TracBrowser for help on using the repository browser.