72 lines
2.6 KiB
Mathematica
72 lines
2.6 KiB
Mathematica
|
AFJXPNHT ;FO-OAKLAND/GMB-PROC SERVER MSG TO ADD PTS TO DB ;1/26/96 10:09
|
||
|
|
;;5.1;Network Health Exchange;**1,2,31**;Jan 23, 1996
|
||
|
|
; Totally rewritten 11/2001. (Previously FJ/CWS.)
|
||
|
|
; Entry points:
|
||
|
|
; ENTER - Invoked by server option AFJXNETP
|
||
|
|
; (Messages are created in ^AFJXPNHA)
|
||
|
|
ENTER ; Process incoming message
|
||
|
|
; XQMSG has XMZ, XQSUB has msg subject, & XQSND has msg sender (from)
|
||
|
|
N XMSER,XMZ
|
||
|
|
D PROCESS(XQMSG,XQSUB,XQSND)
|
||
|
|
S XMSER="S.AFJXNETP",XMZ=XQMSG D REMSBMSG^XMA1C
|
||
|
|
Q
|
||
|
|
PROCESS(AXMZ,AXSUB,AXFROM) ;
|
||
|
|
N AXSITE,AX25IEN,AX25REC,AXUPDF,AXUPDN,AXNICK,AXI,AXDOMIEN,AXREC
|
||
|
|
S DUZ=.5,DUZ(0)="@"
|
||
|
|
S AXSITE=$S(AXFROM["@":$P($P(AXFROM,"@",2),">"),1:^XMB("NETNAME"))
|
||
|
|
Q:AXSITE=""
|
||
|
|
D DOMLKUP(AXSITE,.AXDOMIEN,.AX25IEN) Q:'AX25IEN
|
||
|
|
S AX25REC=$G(^AFJ(537025,AX25IEN,0))
|
||
|
|
S AXUPDF=$P(AX25REC,U,6) Q:'AXUPDF ; Accept network file update? 0=no; 1=yes
|
||
|
|
S AXUPDN=$P(AX25REC,U,8) ; Update network identifier? 0=no; 1=yes
|
||
|
|
S AXNICK=$S(AXUPDN:$P(AX25REC,U,7),1:"") ; Nickname
|
||
|
|
S AXI=$S($E(^XMB(3.9,AXMZ,2,1,0),1,1)="@":5,1:.99999999)
|
||
|
|
F S AXI=$O(^XMB(3.9,AXMZ,2,AXI)) Q:'AXI S AXREC=^(AXI,0) D CHKADDPT
|
||
|
|
Q
|
||
|
|
DOMLKUP(AXSITE,AXDOMIEN,AX25IEN) ;
|
||
|
|
N AXDOMREC
|
||
|
|
S AX25IEN=0
|
||
|
|
S AXDOMIEN=$$FIND1^DIC(4.2,"","MX",AXSITE,"B^C") Q:'AXDOMIEN
|
||
|
|
S AX25IEN=$O(^AFJ(537025,"B",AXDOMIEN,0)) Q:'AX25IEN
|
||
|
|
S AXDOMREC=$G(^DIC(4.2,AXDOMIEN,0))
|
||
|
|
I AXDOMREC'="",$P(AXDOMREC,U,2)'["C" Q
|
||
|
|
;N DIK,DA ; Domain is closed, so delete it from the authorized sites
|
||
|
|
;S DIK="^AFJ(537025,",DA=AX25IEN D ^DIK
|
||
|
|
S AX25IEN=0
|
||
|
|
Q
|
||
|
|
CHKADDPT ; ADD/EDIT Patient
|
||
|
|
N AXSSN,AXDOB,AXNAME,DIC,X,Y,AX10IEN,AX25IEN
|
||
|
|
Q:AXREC["S.AFJXNETP" ; Why is this here?
|
||
|
|
S AXSSN=$P(AXREC,U,1),AXDOB=$P(AXREC,U,2),AXNAME=$P(AXREC,U,3)
|
||
|
|
Q:$G(AXSSN)=""
|
||
|
|
Q:$E(AXSSN,1,9)'?9N
|
||
|
|
S X=AXSSN,DIC="^AFJ(537010,",DIC(0)="X"
|
||
|
|
D ^DIC
|
||
|
|
S AX10IEN=+Y
|
||
|
|
I AX10IEN>0 D
|
||
|
|
. N DIE,DA,DR
|
||
|
|
. S DIE="^AFJ(537010,",DA=AX10IEN,DR="4////"_DT
|
||
|
|
. D ^DIE
|
||
|
|
E D Q:AX10IEN<0
|
||
|
|
. N DIC,X,Y,DD,DO,DA,DINUM,DLAYGO
|
||
|
|
. S DIC="^AFJ(537010,",DIC(0)="LX",X=AXSSN,DLAYGO=537010
|
||
|
|
. S DIC("DR")="1////"_AXDOB_";2////"_AXNAME_";4////"_DT
|
||
|
|
. D FILE^DICN
|
||
|
|
. S AX10IEN=+Y
|
||
|
|
I '$D(^AFJ(537010,AX10IEN,1,"B",AXDOMIEN)) D
|
||
|
|
. N AXFDA
|
||
|
|
. S AXFDA(537010.04,"+1,"_AX10IEN_",",.01)=AXDOMIEN
|
||
|
|
. D UPDATE^DIE("","AXFDA")
|
||
|
|
Q:AXNICK=""
|
||
|
|
ADDNICK ; Add network identifier
|
||
|
|
N AXDFN,AXDOMIEN,AXNWI,AXNWI2,AX25IEN
|
||
|
|
S AXDFN=$$FIND1^DIC(2,"","X",AXSSN,"SSN") Q:'AXDFN
|
||
|
|
S (AXNWI,AXNWI2)=$G(^DPT(AXDFN,537025))
|
||
|
|
S AXDOMIEN=0
|
||
|
|
F S AXDOMIEN=$O(^AFJ(537010,AX10IEN,1,"B",AXDOMIEN)) Q:'AXDOMIEN D
|
||
|
|
. S AX25IEN=$O(^AFJ(537025,"B",AXDOMIEN,0)) Q:'AX25IEN
|
||
|
|
. S AXNICK=$P($G(^AFJ(537025,AX25IEN,0)),U,7) Q:AXNICK=""
|
||
|
|
. I AXNWI'[AXNICK S AXNWI=AXNWI_AXNICK
|
||
|
|
I AXNWI'=AXNWI2 S ^DPT(AXDFN,537025)=AXNWI
|
||
|
|
Q
|