- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HAFJXPNHT 2720 printed Apr 23, 2025@18:32:21 Page 2
- AFJXPNHT ;FO-OAKLAND/GMB-PROC SERVER MSG TO ADD PTS TO DB ;1/26/96 10:09
- +1 ;;5.1;Network Health Exchange;**1,2,31**;Jan 23, 1996
- +2 ; Totally rewritten 11/2001. (Previously FJ/CWS.)
- +3 ; Entry points:
- +4 ; ENTER - Invoked by server option AFJXNETP
- +5 ; (Messages are created in ^AFJXPNHA)
- ENTER ; Process incoming message
- +1 ; XQMSG has XMZ, XQSUB has msg subject, & XQSND has msg sender (from)
- +2 NEW XMSER,XMZ
- +3 DO PROCESS(XQMSG,XQSUB,XQSND)
- +4 SET XMSER="S.AFJXNETP"
- SET XMZ=XQMSG
- DO REMSBMSG^XMA1C
- +5 QUIT
- PROCESS(AXMZ,AXSUB,AXFROM) ;
- +1 NEW AXSITE,AX25IEN,AX25REC,AXUPDF,AXUPDN,AXNICK,AXI,AXDOMIEN,AXREC
- +2 SET DUZ=.5
- SET DUZ(0)="@"
- +3 SET AXSITE=$SELECT(AXFROM["@":$PIECE($PIECE(AXFROM,"@",2),">"),1:^XMB("NETNAME"))
- +4 if AXSITE=""
- QUIT
- +5 DO DOMLKUP(AXSITE,.AXDOMIEN,.AX25IEN)
- if 'AX25IEN
- QUIT
- +6 SET AX25REC=$GET(^AFJ(537025,AX25IEN,0))
- +7 ; Accept network file update? 0=no; 1=yes
- SET AXUPDF=$PIECE(AX25REC,U,6)
- if 'AXUPDF
- QUIT
- +8 ; Update network identifier? 0=no; 1=yes
- SET AXUPDN=$PIECE(AX25REC,U,8)
- +9 ; Nickname
- SET AXNICK=$SELECT(AXUPDN:$PIECE(AX25REC,U,7),1:"")
- +10 SET AXI=$SELECT($EXTRACT(^XMB(3.9,AXMZ,2,1,0),1,1)="@":5,1:.99999999)
- +11 FOR
- SET AXI=$ORDER(^XMB(3.9,AXMZ,2,AXI))
- if 'AXI
- QUIT
- SET AXREC=^(AXI,0)
- DO CHKADDPT
- +12 QUIT
- DOMLKUP(AXSITE,AXDOMIEN,AX25IEN) ;
- +1 NEW AXDOMREC
- +2 SET AX25IEN=0
- +3 SET AXDOMIEN=$$FIND1^DIC(4.2,"","MX",AXSITE,"B^C")
- if 'AXDOMIEN
- QUIT
- +4 SET AX25IEN=$ORDER(^AFJ(537025,"B",AXDOMIEN,0))
- if 'AX25IEN
- QUIT
- +5 SET AXDOMREC=$GET(^DIC(4.2,AXDOMIEN,0))
- +6 IF AXDOMREC'=""
- IF $PIECE(AXDOMREC,U,2)'["C"
- QUIT
- +7 ;N DIK,DA ; Domain is closed, so delete it from the authorized sites
- +8 ;S DIK="^AFJ(537025,",DA=AX25IEN D ^DIK
- +9 SET AX25IEN=0
- +10 QUIT
- CHKADDPT ; ADD/EDIT Patient
- +1 NEW AXSSN,AXDOB,AXNAME,DIC,X,Y,AX10IEN,AX25IEN
- +2 ; Why is this here?
- if AXREC["S.AFJXNETP"
- QUIT
- +3 SET AXSSN=$PIECE(AXREC,U,1)
- SET AXDOB=$PIECE(AXREC,U,2)
- SET AXNAME=$PIECE(AXREC,U,3)
- +4 if $GET(AXSSN)=""
- QUIT
- +5 if $EXTRACT(AXSSN,1,9)'?9N
- QUIT
- +6 SET X=AXSSN
- SET DIC="^AFJ(537010,"
- SET DIC(0)="X"
- +7 DO ^DIC
- +8 SET AX10IEN=+Y
- +9 IF AX10IEN>0
- Begin DoDot:1
- +10 NEW DIE,DA,DR
- +11 SET DIE="^AFJ(537010,"
- SET DA=AX10IEN
- SET DR="4////"_DT
- +12 DO ^DIE
- End DoDot:1
- +13 IF '$TEST
- Begin DoDot:1
- +14 NEW DIC,X,Y,DD,DO,DA,DINUM,DLAYGO
- +15 SET DIC="^AFJ(537010,"
- SET DIC(0)="LX"
- SET X=AXSSN
- SET DLAYGO=537010
- +16 SET DIC("DR")="1////"_AXDOB_";2////"_AXNAME_";4////"_DT
- +17 DO FILE^DICN
- +18 SET AX10IEN=+Y
- End DoDot:1
- if AX10IEN<0
- QUIT
- +19 IF '$DATA(^AFJ(537010,AX10IEN,1,"B",AXDOMIEN))
- Begin DoDot:1
- +20 NEW AXFDA
- +21 SET AXFDA(537010.04,"+1,"_AX10IEN_",",.01)=AXDOMIEN
- +22 DO UPDATE^DIE("","AXFDA")
- End DoDot:1
- +23 if AXNICK=""
- QUIT
- ADDNICK ; Add network identifier
- +1 NEW AXDFN,AXDOMIEN,AXNWI,AXNWI2,AX25IEN
- +2 SET AXDFN=$$FIND1^DIC(2,"","X",AXSSN,"SSN")
- if 'AXDFN
- QUIT
- +3 SET (AXNWI,AXNWI2)=$GET(^DPT(AXDFN,537025))
- +4 SET AXDOMIEN=0
- +5 FOR
- SET AXDOMIEN=$ORDER(^AFJ(537010,AX10IEN,1,"B",AXDOMIEN))
- if 'AXDOMIEN
- QUIT
- Begin DoDot:1
- +6 SET AX25IEN=$ORDER(^AFJ(537025,"B",AXDOMIEN,0))
- if 'AX25IEN
- QUIT
- +7 SET AXNICK=$PIECE($GET(^AFJ(537025,AX25IEN,0)),U,7)
- if AXNICK=""
- QUIT
- +8 IF AXNWI'[AXNICK
- SET AXNWI=AXNWI_AXNICK
- End DoDot:1
- +9 IF AXNWI'=AXNWI2
- SET ^DPT(AXDFN,537025)=AXNWI
- +10 QUIT
