| [613] | 1 | AFJXPNHA ;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
|
|---|
| 6 | ENTER ;
|
|---|
| 7 | D PROCESS("NIGHTLY NETWORK PT/ID UPDATE",$$FMADD^XLFDT(DT,-2))
|
|---|
| 8 | Q
|
|---|
| 9 | PROCESS(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
|
|---|
| 22 | GETADDR(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
|
|---|
| 34 | SENDPTS ;
|
|---|
| 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
|
|---|
| 62 | SEND(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
|
|---|
| 75 | HEADER ;
|
|---|
| 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
|
|---|
