source: FOIAVistA/trunk/r/NETWORK_HEALTH_EXCHANGE-AFJX/AFJXWCP1.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 3.8 KB
Line 
1AFJXWCP1 ;FO-OAKLAND/GMB-REQUEST PATIENT INFORMATION ;4/11/96 05:36
2 ;;5.1;Network Health Exchange;**1,31,34**;Jan 23, 1996
3 ; Totally rewritten 11/2001. (Previously FJ/CWS.)
4 ; Called from ^AFJXWCPM
5REQUEST(AXTYPE) ; Request data
6 N AXFINIS,AXABORT,AXPARM,AXSSN,I
7 S (AXFINIS,AXABORT)=0
8 D INIT(AXTYPE,.AXPARM,.AXABORT) Q:AXABORT
9 W @IOF,!! F I=1:1:80 W "@"
10 W !,?8,"This option will request ",AXPARM("U")," DATA from another VAMC."
11 W ! F I=1:1:80 W "@"
12 W !!,?5,"You can't request information if the patient is not already on file.",!
13 F D Q:AXFINIS!AXABORT
14 . N DIC,X,Y,AXTO
15 . W !!
16 . S DIC("A")="SOCIAL SECURITY # or NAME: "
17 . S DIC="^DPT("
18 . S DIC(0)="AEMOQZ"
19 . D ^DIC I Y<1 S AXFINIS=1 Q
20 . S AXSSN=$P(Y(0),U,9)
21 . I $G(AXSSN)["P" W !,?5,$C(7),"SORRY, You can't request Pseudo SSNs." Q
22 . D SITES(.AXTO,.AXABORT) Q:AXABORT
23 . I '$D(AXTO) D Q
24 . . W !,$C(7),"No valid sites chosen. No request sent."
25 . D MESSAGE(.AXTO,AXSSN)
26 Q
27INIT(AXTYPE,AXPARM,AXABORT) ;
28 I AXTYPE="R" S AXPARM("U")="PATIENT PHARMACY",AXPARM("S")="PHARMACY DATA",AXPARM("L")="PHARM"
29 E I AXTYPE="RB" S AXPARM("U")="BRIEF PHARMACY",AXPARM("S")="BRIEF PHARMACY",AXPARM("L")="NHBP"
30 E I AXTYPE="P" S AXPARM("U")="PATIENT",AXPARM("S")="TOTAL DATA",AXPARM("L")="TOTAL"
31 E I AXTYPE="PB" S AXPARM("U")="BRIEF PATIENT",AXPARM("S")="BRIEF DATA",AXPARM("L")="BRIEF"
32 E D Q
33 . W !,"Routine ^AFJXWCP1 called with incorrect TYPE parameter: ",AXTYPE
34 . S AXABORT=1
35 N DIR,X,Y
36 W !
37 S DIR(0)="Y"
38 S DIR("A")="Would you like to look for any previous requests on file"
39 S DIR("B")="NO"
40 D ^DIR I $D(DTOUT)!$D(DUOUT) S AXABORT=1 Q
41 D:Y ENTER^AFJXMBOX
42 Q
43SITES(AXTO,AXABORT) ; Choose station(s)
44 N AXFINIS,AXDOMIEN,AX25IEN,DIR,X,Y,DIRUT
45 S DIR(0)="S^A:ALL Local Area Sites;S:Selected Sites"
46 S DIR("A")="Request patient information from"
47 D ^DIR I $D(DIRUT) S AXABORT=1 Q
48 I Y="A" D CHKALL(.AXTO) Q
49 K DIR,X,Y
50 S AXFINIS=0
51 F D Q:AXFINIS!AXABORT
52 . N DIC,X,Y,DUOUT,DTOUT
53 . W !
54 . S DIC=537025,DIC(0)="AEMOQ"
55 . S DIC("A")=$S($D(AXTO):"Another site: ",1:"Select a site: ")
56 . S DIC("S")="I $P($G(^DIC(4.2,+^(0),0)),U,2)'[""C"""
57 . D ^DIC I $D(DUOUT)!$D(DTOUT) S AXABORT=1 Q
58 . I Y<1 S AXFINIS=1 Q
59 . S AXDOMIEN=$P(Y,U,2),AX25IEN=+Y
60 . D CHKSITE(AXDOMIEN,AX25IEN,.AXTO)
61 Q
62CHKALL(AXTO) ; "ALL LOCAL AREA SITES"
63 N AX25IEN,AX25REC
64 W !,"Network Area Recipients:"
65 S AX25IEN=0
66 F S AX25IEN=$O(^AFJ(537025,AX25IEN)) Q:'AX25IEN D
67 . S AX25REC=$G(^AFJ(537025,AX25IEN,0))
68 . I $P(AX25REC,U,3) D CHKSITE($P(AX25REC,U),AX25IEN,.AXTO)
69 Q
70CHKSITE(AXDOMIEN,AX25IEN,AXTO) ;
71 N AXBAD,AXDOMREC
72 S AXBAD=0
73 I AXDOMIEN=^XMB("NUM") D
74 . ;S AXBAD=1
75 . S AXTO("S.AFJXSERVER")=""
76 . W !,^XMB("NETNAME")," FYI: That's this domain."
77 . S AXTO("S.AFJXSERVER")=""
78 E D
79 . S AXDOMREC=$P(^DIC(4.2,AXDOMIEN,0),U,1,2)
80 . I AXDOMREC="" D Q
81 . . S AXBAD=1
82 . . ;W !!,$C(7),"Broken pointer to the DOMAIN file."
83 . I $P(AXDOMREC,U,2)'["C" D Q
84 . . S AXTO("S.AFJXSERVER@"_$P(AXDOMREC,U,1))=""
85 . . W !,$P(AXDOMREC,U,1)
86 . S AXBAD=1
87 . ;W !!,$C(7),"Domain ",DOMNAME," is closed."
88 Q:'AXBAD
89 ;W !," Ignoring it."
90 Q
91 ;W !," Deleting it from the Authorized Sites file."
92 ;N DIK,DA S DIK="^AFJ(537025,",DA=AX25IEN D ^DIK
93 ;Q
94MESSAGE(XMY,AXSSN) ; Build message and transmit
95 N XMSUB,XMDUZ,XMTEXT,XMZ,AXRQST,AXREC,DIC,DLAYGO,X,Y,DA,DINUM,DD,DO
96 W !!,"Sending Patient Data Request..."
97 S XMDUZ=DUZ,XMTEXT="AXRQST("
98 S XMSUB="NETWORK HEALTH EXCHANGE "_AXPARM("S")_" REQUEST FOR "_AXSSN
99 S AXRQST(1)=AXSSN_U_DUZ_U_$P($G(^VA(200,+DUZ,0)),U)_U_$$NOW^XLFDT_U_^XMB("NETNAME")_U_AXPARM("L")
100 D ^XMD W !,"Local Message ID: "_XMZ
101 ; Audit
102 S AXREC=AXRQST(1)
103 S DIC="^AFJ(537000,",DLAYGO=537000
104 S DIC(0)="L",X=XMZ
105 S DIC("DR")="1////"_$P(AXREC,U,4)_";2////"_AXPARM("L")_";3////"_AXSSN_";6////"_DUZ_";7////"_$P(AXREC,U,3)_";8////"_^XMB("NUM")_";11////Y"
106 D FILE^DICN
107 W !!,"Your request has been submitted for completion."
108 Q
Note: See TracBrowser for help on using the repository browser.