source: WorldVistAEHR/trunk/r/NETWORK_HEALTH_EXCHANGE-AFJX/AFJXPNHT.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.6 KB
Line 
1AFJXPNHT ;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)
7ENTER ; 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
13PROCESS(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
26DOMLKUP(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
37CHKADDPT ; 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=""
61ADDNICK ; 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
Note: See TracBrowser for help on using the repository browser.