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