| [613] | 1 | AFJXPNHT ;FO-OAKLAND/GMB-PROC SERVER MSG TO ADD PTS TO DB ;1/26/96 10:09
|
|---|
| 2 | ;;5.1;Network Health Exchange;**1,2,31**;Jan 23, 1996
|
|---|
| 3 | ; Totally rewritten 11/2001. (Previously FJ/CWS.)
|
|---|
| 4 | ; Entry points:
|
|---|
| 5 | ; ENTER - Invoked by server option AFJXNETP
|
|---|
| 6 | ; (Messages are created in ^AFJXPNHA)
|
|---|
| 7 | ENTER ; Process incoming message
|
|---|
| 8 | ; XQMSG has XMZ, XQSUB has msg subject, & XQSND has msg sender (from)
|
|---|
| 9 | N XMSER,XMZ
|
|---|
| 10 | D PROCESS(XQMSG,XQSUB,XQSND)
|
|---|
| 11 | S XMSER="S.AFJXNETP",XMZ=XQMSG D REMSBMSG^XMA1C
|
|---|
| 12 | Q
|
|---|
| 13 | PROCESS(AXMZ,AXSUB,AXFROM) ;
|
|---|
| 14 | N AXSITE,AX25IEN,AX25REC,AXUPDF,AXUPDN,AXNICK,AXI,AXDOMIEN,AXREC
|
|---|
| 15 | S DUZ=.5,DUZ(0)="@"
|
|---|
| 16 | S AXSITE=$S(AXFROM["@":$P($P(AXFROM,"@",2),">"),1:^XMB("NETNAME"))
|
|---|
| 17 | Q:AXSITE=""
|
|---|
| 18 | D DOMLKUP(AXSITE,.AXDOMIEN,.AX25IEN) Q:'AX25IEN
|
|---|
| 19 | S AX25REC=$G(^AFJ(537025,AX25IEN,0))
|
|---|
| 20 | S AXUPDF=$P(AX25REC,U,6) Q:'AXUPDF ; Accept network file update? 0=no; 1=yes
|
|---|
| 21 | S AXUPDN=$P(AX25REC,U,8) ; Update network identifier? 0=no; 1=yes
|
|---|
| 22 | S AXNICK=$S(AXUPDN:$P(AX25REC,U,7),1:"") ; Nickname
|
|---|
| 23 | S AXI=$S($E(^XMB(3.9,AXMZ,2,1,0),1,1)="@":5,1:.99999999)
|
|---|
| 24 | F S AXI=$O(^XMB(3.9,AXMZ,2,AXI)) Q:'AXI S AXREC=^(AXI,0) D CHKADDPT
|
|---|
| 25 | Q
|
|---|
| 26 | DOMLKUP(AXSITE,AXDOMIEN,AX25IEN) ;
|
|---|
| 27 | N AXDOMREC
|
|---|
| 28 | S AX25IEN=0
|
|---|
| 29 | S AXDOMIEN=$$FIND1^DIC(4.2,"","MX",AXSITE,"B^C") Q:'AXDOMIEN
|
|---|
| 30 | S AX25IEN=$O(^AFJ(537025,"B",AXDOMIEN,0)) Q:'AX25IEN
|
|---|
| 31 | S AXDOMREC=$G(^DIC(4.2,AXDOMIEN,0))
|
|---|
| 32 | I AXDOMREC'="",$P(AXDOMREC,U,2)'["C" Q
|
|---|
| 33 | ;N DIK,DA ; Domain is closed, so delete it from the authorized sites
|
|---|
| 34 | ;S DIK="^AFJ(537025,",DA=AX25IEN D ^DIK
|
|---|
| 35 | S AX25IEN=0
|
|---|
| 36 | Q
|
|---|
| 37 | CHKADDPT ; ADD/EDIT Patient
|
|---|
| 38 | N AXSSN,AXDOB,AXNAME,DIC,X,Y,AX10IEN,AX25IEN
|
|---|
| 39 | Q:AXREC["S.AFJXNETP" ; Why is this here?
|
|---|
| 40 | S AXSSN=$P(AXREC,U,1),AXDOB=$P(AXREC,U,2),AXNAME=$P(AXREC,U,3)
|
|---|
| 41 | Q:$G(AXSSN)=""
|
|---|
| 42 | Q:$E(AXSSN,1,9)'?9N
|
|---|
| 43 | S X=AXSSN,DIC="^AFJ(537010,",DIC(0)="X"
|
|---|
| 44 | D ^DIC
|
|---|
| 45 | S AX10IEN=+Y
|
|---|
| 46 | I AX10IEN>0 D
|
|---|
| 47 | . N DIE,DA,DR
|
|---|
| 48 | . S DIE="^AFJ(537010,",DA=AX10IEN,DR="4////"_DT
|
|---|
| 49 | . D ^DIE
|
|---|
| 50 | E D Q:AX10IEN<0
|
|---|
| 51 | . N DIC,X,Y,DD,DO,DA,DINUM,DLAYGO
|
|---|
| 52 | . S DIC="^AFJ(537010,",DIC(0)="LX",X=AXSSN,DLAYGO=537010
|
|---|
| 53 | . S DIC("DR")="1////"_AXDOB_";2////"_AXNAME_";4////"_DT
|
|---|
| 54 | . D FILE^DICN
|
|---|
| 55 | . S AX10IEN=+Y
|
|---|
| 56 | I '$D(^AFJ(537010,AX10IEN,1,"B",AXDOMIEN)) D
|
|---|
| 57 | . N AXFDA
|
|---|
| 58 | . S AXFDA(537010.04,"+1,"_AX10IEN_",",.01)=AXDOMIEN
|
|---|
| 59 | . D UPDATE^DIE("","AXFDA")
|
|---|
| 60 | Q:AXNICK=""
|
|---|
| 61 | ADDNICK ; Add network identifier
|
|---|
| 62 | N AXDFN,AXDOMIEN,AXNWI,AXNWI2,AX25IEN
|
|---|
| 63 | S AXDFN=$$FIND1^DIC(2,"","X",AXSSN,"SSN") Q:'AXDFN
|
|---|
| 64 | S (AXNWI,AXNWI2)=$G(^DPT(AXDFN,537025))
|
|---|
| 65 | S AXDOMIEN=0
|
|---|
| 66 | F S AXDOMIEN=$O(^AFJ(537010,AX10IEN,1,"B",AXDOMIEN)) Q:'AXDOMIEN D
|
|---|
| 67 | . S AX25IEN=$O(^AFJ(537025,"B",AXDOMIEN,0)) Q:'AX25IEN
|
|---|
| 68 | . S AXNICK=$P($G(^AFJ(537025,AX25IEN,0)),U,7) Q:AXNICK=""
|
|---|
| 69 | . I AXNWI'[AXNICK S AXNWI=AXNWI_AXNICK
|
|---|
| 70 | I AXNWI'=AXNWI2 S ^DPT(AXDFN,537025)=AXNWI
|
|---|
| 71 | Q
|
|---|
