source: WorldVistAEHR/trunk/r/NETWORK_HEALTH_EXCHANGE-AFJX/AFJXPNHA.m@ 1520

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

initial load of WorldVistAEHR

File size: 2.8 KB
Line 
1AFJXPNHA ;FO-OAKLAND/GMB-SEND SERVER MSG TO ADD PTS TO DB ;1/17/96 13:14
2 ;;5.1;Network Health Exchange;**31**;Jan 23, 1996
3 ; Totally rewritten 11/2001. (Previously FJ/CWS/RF/BC.)
4 ; Entry points used:
5 ; ENTER - option AFJXNH ADD PATIENTS
6ENTER ;
7 D PROCESS("NIGHTLY NETWORK PT/ID UPDATE",$$FMADD^XLFDT(DT,-2))
8 Q
9PROCESS(AXSUB,AXCUTOFF,AXHDR,AXMAX,AXALIVE) ; Process data
10 ; AXSUB - Message subject
11 ; AXCUTOFF - Only include patients added after this FM date.
12 ; If zero, then all patients are included.
13 ; AXHDR - Include 5 header lines in the message? 0=no; 1=yes
14 ; AXMAX - Maximum number of lines per message. If zero, no max.
15 ; AXALIVE - Include only living patients? 0=no; 1=yes
16 N AXTO
17 S AXCUTOFF=+$G(AXCUTOFF),AXHDR=+$G(AXHDR),AXMAX=+$G(AXMAX),AXALIVE=+$G(AXALIVE)
18 D GETADDR(.AXTO) Q:'$D(AXTO)
19 K ^TMP("AFJX",$J)
20 D SENDPTS
21 Q
22GETADDR(AXTO) ;
23 N AX25IEN,AX25REC,AXDOMREC
24 S AX25IEN=0
25 F S AX25IEN=$O(^AFJ(537025,AX25IEN)) Q:'AX25IEN D
26 . S AX25REC=$G(^AFJ(537025,AX25IEN,0)) Q:AX25REC=""
27 . Q:'$P(AX25REC,U,4)
28 . S AXDOMREC=$G(^DIC(4.2,$P(AX25REC,U),0))
29 . I $P(AXDOMREC,U,2)["C" D Q
30 . . ;N DIK,DA ; Domain is closed, so delete it from Authorized Sites
31 . . ;S DIK="^AFJ(537025,",DA=AX25IEN D ^DIK
32 . S AXTO("S.AFJXNETP@"_$P(AXDOMREC,U,1))=""
33 Q
34SENDPTS ;
35 N AXLINE,AXSITE,AXNICK,AXDFN,AXREC,AXDATE,AXNAME,AXSSN,AXDOB,AXPART
36 S AXSITE=^XMB("NETNAME")
37 S AXLINE=$S(AXHDR:5,1:0)
38 S AX25IEN=+$O(^AFJ(537025,"B",^XMB("NUM"),0))
39 S AXNICK=$P($G(^AFJ(537025,AX25IEN,0)),U,7)
40 I 'AXCUTOFF S AXDFN=0
41 E D
42 . N AXDAYS
43 . S AXDAYS=$$FMDIFF^XLFDT(DT,AXCUTOFF)
44 . I AXDAYS>10 S AXDFN=0 Q
45 . S AXDFN=$O(^DPT(":"),-1)-(AXDAYS*500)
46 . I AXDFN<1 S AXDFN=0
47 F S AXDFN=$O(^DPT(AXDFN)) Q:'AXDFN D
48 . I AXALIVE Q:$G(^DPT(AXDFN,.35))
49 . S AXREC=$G(^DPT(AXDFN,0))
50 . S AXDATE=$P(AXREC,U,16) I AXDATE<AXCUTOFF Q
51 . S AXNAME=$P(AXREC,U,1) I $E(AXNAME)'?1U!($E(AXNAME,1,2)="ZZ")!($E(AXNAME,1,3)="EEE") Q ;VHA DIRECTIVE 96-0006
52 . S AXSSN=$P(AXREC,U,9) I AXSSN["P"!(AXSSN?5"0"4N) Q ;VHA DIRECTIVE 96-0006
53 . S AXDOB=$P(AXREC,U,3)
54 . ; The last 3 pieces are not used by ^AFJXPNHT. (So why send them?)
55 . S AXLINE=AXLINE+1,^TMP("AFJX",$J,AXLINE,0)=AXSSN_U_AXDOB_U_AXNAME_U_AXSITE_U_AXDATE_U_AXNICK
56 . I AXMAX,AXLINE=AXMAX D
57 . . D SEND(.AXTO)
58 . . S AXLINE=$S(AXHDR:5,1:0)
59 Q:'$D(^TMP("AFJX",$J))
60 D SEND(.AXTO)
61 Q
62SEND(AXTO) ;
63 N XMSUB,XMDUZ,XMTEXT,XMY
64 M XMY=AXTO
65 S XMDUZ=.5
66 S XMSUB=AXSUB
67 I AXMAX D
68 . S AXPART=$G(AXPART)+1
69 . S XMSUB=XMSUB_" Part "_AXPART
70 I AXHDR D HEADER
71 S XMTEXT="^TMP(""AFJX"",$J,"
72 D ^XMD
73 K ^TMP("AFJX",$J)
74 Q
75HEADER ;
76 S ^TMP("AFJX",$J,1,0)=$$REPEAT^XLFSTR("@",60)
77 S ^TMP("AFJX",$J,2,0)=XMSUB_" AS OF "_$$FMTE^XLFDT($$NOW^XLFDT)
78 S ^TMP("AFJX",$J,3,0)=$$REPEAT^XLFSTR("@",60)
79 S ^TMP("AFJX",$J,4,0)=^XMB("NETNAME")_" Patient File DPT(0) "_$G(^DPT(0))
80 S ^TMP("AFJX",$J,5,0)=""
81 Q
Note: See TracBrowser for help on using the repository browser.