source: FOIAVistA/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQREQ06.m@ 1538

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

initial load of FOIAVistA 6/30/08 version
File size: 4.1 KB
Line 
1VAQREQ06 ;ALB/JFP - REQUEST PDX RECORD,TRANSMIT;01MAR93
2 ;;1.5;PATIENT DATA EXCHANGE;**4,20,26,32**;NOV 17, 1993
3EP ; -- Programmer entry point for sending PDX requests
4 ; -- This code is used by both request and unsolicited request
5 ;
6 D:$D(XRTL) T0^%ZOSV ; -- Capacity start
7 S VAQDOM="",(POP,DOMCNT)=0 W !!,"Working..."
8 D PRELOAD
9 F S VAQDOM=$O(^TMP("VAQSEG",$J,VAQDOM)) Q:VAQDOM="" D XMIT
10 I POP K POP QUIT
11 S VAQFLAG=1
12 W !!,"Transactions filed "
13TASK ; -- Load taskman variables and task off
14 S ZTRTN="GENXMIT^VAQADM50"
15 S ZTDESC=$S(VAQOPT="REQ":"PDX, REQUEST",VAQOPT="UNS":"PDX, UNSOLICITED",1:"PDX, GENERATE TRANSMISSION")
16 S ZTDTH=$H,ZTIO=""
17 S ZTSAVE("VAQTRN(")=""
18 I ZTRTN'="" D ^%ZTLOAD
19 I $D(ZTSK) W "and queued "
20 K ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTSK
21 K ^TMP("CMNT",$J),FACDA,NOTI,PARMNODE,DOMDA,X,Y,DOMCNT,LOAD
22 S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV ; -- Capacity stop
23 QUIT
24 ;
25XMIT ; -- Makes an entry in the 'PDX TRANSACTION' file
26 S Y=$$NEWTRAN^VAQFILE Q:Y<0
27 S DOMCNT=DOMCNT+1 W:(DOMCNT#10)=0 "."
28 S (VAQPR,DA)=+Y,VAQTRN=$P(Y,"^",2)
29 S LOAD=$S(VAQOPT="REQ":"LDREQ",VAQOPT="UNS":"LDUNS",1:"LDREQ")
30 D @LOAD
31 D:$D(^TMP("VAQNOTI",$J)) MNOTI
32 D:$D(^TMP("VAQSEG",$J)) MSEG
33 I VAQOPT="UNS"&($D(^TMP("CMNT",$J))) D CMNT
34 ; -- Load an array of newly entered transactions
35 S VAQTRN(VAQPR)=""
36 ; -- Updates workload file
37 S X=$$WORKDONE^VAQADS01($S(VAQOPT="REQ":"RQST",VAQOPT="UNS":"SEND",1:""),VAQPR,$G(DUZ))
38 Q
39 ;
40PRELOAD ; -- Loads the constant data for multiple domains
41 S %DT="ST",X="NOW" D ^%DT S VAQRQDT=Y
42 S VAQPID=""
43 S VAQSENPT=""
44 I VAQDFN>0 D
45 .S DFN=+VAQDFN
46 .D PID^VADPT6
47 .S VAQPID=$P($G(VA("PID")),U,1)
48 .K VA("PID"),VA("BID")
49 .S VAQSENPT=$$GETSEN^VAQUTL97(DFN) ; --Sensitive patient
50 .S:VAQSENPT<0 VAQSENPT=""
51 ;
52 S PARMNODE=$G(^VAT(394.81,1,0))
53 S FACDA=$P(PARMNODE,U,1),DOMDA=$P(PARMNODE,U,2)
54 S VAQRQSIT=$P($G(^DIC(4,FACDA,0)),U,1)
55 S VAQRQADD=$P($G(^DIC(4.2,DOMDA,0)),U,1)
56 ;
57 S (VAQDZ,VAQDZN)=""
58 I $G(DUZ)'="" D
59 .S VAQDZN=$S($D(DUZ):$P(^VA(200,DUZ,0),U,1),1:"")
60 .S VAQDZ=$S($D(DUZ):DUZ,1:"")
61 QUIT
62 ;
63LDREQ ; -- Sets DR string and non-constant variables, LOAD FOR REQUEST
64 S:'$D(VAQNOTI) VAQNOTI=0 ; -- UNS does not use notify logic
65 S VAQAUSIT=$$GETINST^VAQUTL97(VAQDOM)
66 S DR=".02///VAQ-RQST"
67 S DR(1,394.61,.03)=".03////"_$S(+VAQDFN>0:+VAQDFN,1:"")
68 S DR(1,394.61,.04)=".04///"_VAQSENPT
69 S DR(1,394.61,.05)=".05///VAQ-RQST"
70 S DR(1,394.61,10)="10///"_VAQNM
71 S DR(1,394.61,11)="11///"_VAQISSN
72 S DR(1,394.61,12)="12///"_VAQIDOB
73 S DR(1,394.61,13)="13///"_VAQPID
74 S DR(1,394.61,20)="20///"_VAQRQDT
75 S DR(1,394.61,21)="21///"_VAQDZN
76 S DR(1,394.61,30)="30///"_VAQRQSIT
77 S DR(1,394.61,31)="31///"_VAQRQADD
78 S DR(1,394.61,60)="60///"_VAQAUSIT
79 S DR(1,394.61,61)="61///"_VAQDOM
80 S DR(1,394.61,70)="70///"_VAQNOTI
81 ;
82 S DIE="^VAT(394.61,"
83 D ^DIE K DIE,DR
84 QUIT
85 ;
86LDUNS ; -- Sets DR string and non-constant variables, LOAD FOR UNSOLICITED
87 S VAQAUSIT=$$GETINST^VAQUTL97(VAQDOM)
88 S DR=".02///VAQ-TUNSL"
89 S DR(1,394.61,.03)=".03////"_$S(+VAQDFN>0:+VAQDFN,1:"")
90 S DR(1,394.61,.04)=".04///"_VAQSENPT
91 S DR(1,394.61,.05)=".05///VAQ-UNSOL"
92 S DR(1,394.61,10)="10///"_VAQNM
93 S DR(1,394.61,11)="11///"_VAQISSN
94 S DR(1,394.61,12)="12///"_VAQIDOB
95 S DR(1,394.61,13)="13///"_VAQPID
96 S DR(1,394.61,20)="20///"_VAQRQDT
97 S DR(1,394.61,21)="21///"_VAQDZN
98 S DR(1,394.61,50)="50///"_VAQRQDT
99 S DR(1,394.61,51)="51///"_VAQDZN
100 S DR(1,394.61,30)="60///"_VAQRQSIT
101 S DR(1,394.61,31)="61///"_VAQRQADD
102 S DR(1,394.61,60)="30///"_VAQAUSIT
103 S DR(1,394.61,61)="31///"_VAQDOM
104 ;
105 S DIE="^VAT(394.61,"
106 D ^DIE K DIE,DR
107 QUIT
108MNOTI ; -- Loads the notify muliple
109 S DIE="^VAT(394.61,",DLAYGO=394.61,NOTI=""
110 F S NOTI=$O(^TMP("VAQNOTI",$J,NOTI)) Q:NOTI="" D
111 .S DR="71///"_NOTI
112 .D ^DIE
113 K DIE,DR,DLAYGO
114 QUIT
115 ;
116MSEG ; -- Loads the data segment muliple
117 S SEG=""
118 F S SEG=$O(^TMP("VAQSEG",$J,VAQDOM,SEG)) Q:(SEG="") D
119 .S SEGND=$G(^TMP("VAQSEG",$J,VAQDOM,SEG))
120 .S VAQJUNK=$$FILESEG^VAQFILE2(394.61,VAQPR,80,$P(SEGND,"^",1),$P(SEGND,"^",3),$P(SEGND,"^",4))
121 K VAQJUNK
122 QUIT
123 ;
124CMNT ; -- Loads comment for unsolicited request (WORD PROCESSOR FIELD)
125 S %X="^TMP(""CMNT"",$J,"
126 S %Y="^VAT(394.61,"_DA_",""CMNT"","
127 D %XY^%RCR
128 K %X,%Y
129 QUIT
130 ;
131END ; -- End of code
132 ;QUIT
Note: See TracBrowser for help on using the repository browser.