source: WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQUIN01.m@ 1096

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

initial load of WorldVistAEHR
File size: 4.3 KB
Line 
1VAQUIN01 ;ALB/JFP - REQUEST PDX RECORD - (API);3JUL91
2 ;;1.5;PATIENT DATA EXCHANGE;**43**;NOV 17, 1993
3 ; Programmer entry point for sending PDX requests.
4 ;
5 ; This API can be used for both request and unsolicited.
6 ; It also utilizes time and occurrence limits for Health Summary
7 ; which are pieces on the segment root array. These pieces need
8 ; to be set by the developer. If these are not included the defaults
9 ; in the sites PDX parameter file will be used.
10 ;
11PDX(VAQOPT,VAQDFN,VAQNM,VAQISSN,VAQIDOB,DOMROOT,SEGROOT,NOTROOT) ; EP
12 ;Input: VAQOPT - REQ = request, UNS = unsolicited
13 ; VAQDFN - IFN of patient in patient file
14 ; VAQNM - name of patient
15 ; VAQISSN - patient social security number (no dashes)
16 ; VAQIDOB - patients date of birth (external format)
17 ; DOMROOT - array of domains (full global reference)
18 ; (ie: PXB.ISC-ALBANY.VA.GOV)=Institution name or null
19 ; SEGROOT - array of segments (full global reference)
20 ; (ie: PDX*MIN)=P1^P2
21 ; P1 = TIME LIMIT
22 ; P2 = OCCURRENCE LIMIT
23 ; NOTROOT - array of who to notify (only used for request)
24 ; TLIMIT - time limit for health summary (ie: 1D,12M,5Y)
25 ; OLIMIT - occurrence limit for health summary, up to 5 digits
26 ;
27 ;Output: 0 - ok
28 ; -1^error text
29 ; -- Initialize
30 N POP,ERR,VAQ0,Y,XMITARR,X,VAQDOM,VAQPID,VAQRQDT,PARMNODE,FACDA,DOMDA
31 N VAQRQSIT,VAQRQADD,VAQDZ,VAQDZN,VAQPR,DA,DR,VAQDT,SEG
32 N VAQAUSIT,VAQNOTI
33 N OLDEF,TLDEF,TLMT,OLMT
34 ; -- CHECK INPUT PARAMETERS
35 S POP=0
36 Q:('$D(VAQOPT)) "-1^option required"
37 I (VAQOPT'="REQ")&(VAQOPT'="UNS") Q "-1^option required"
38 Q:('$D(DOMROOT)) "-1^reference to domain required for processing"
39 Q:($O(@DOMROOT@(""))="") "-1^domain data required for processing"
40 Q:('$D(SEGROOT)) "-1^reference to segment required for processing"
41 Q:($O(@SEGROOT@("")))="" "-1^segment data required for processing"
42 ;
43 S:'$D(VAQDFN) VAQDFN=""
44 I VAQDFN="" D Q:POP=1 ERR
45 .I '$D(VAQNM) S POP=1,ERR="-1^Name is required if DFN is null" QUIT
46 .I '$D(VAQISSN) S POP=1,ERR="-1^SSN is required if DFN is null" QUIT
47 .I '$D(VAQNM)&'$D(VAQISSN) S POP=1,ERR="-1^name and SSN is required if DFN=null" QUIT
48 .I (VAQNM="")&(VAQISSN="") S POP=1,ERR="-1^name and SSN is required if DFN=null" QUIT
49 .S:'$D(VAQIDOB) VAQIDOB=""
50 I VAQDFN'="" D Q:POP=1 ERR
51 .I VAQDFN<1 S POP=1,ERR="-1^DFN can not be less than 1" QUIT
52 .I '$D(^DPT(VAQDFN)) S POP=1,ERR="-1^DFN is not in data base" QUIT
53 .S VAQ0=$G(^DPT(VAQDFN,0))
54 .S VAQNM=$P(VAQ0,U,1)
55 .S (VAQISSN)=$P(VAQ0,U,9)
56 .S (Y,VAQIDOB)=$P(VAQ0,U,3) X ^DD("DD") S VAQIDOB=Y
57 I (VAQNM="")&(VAQISSN="") Q "-1^name or SSN is required"
58 ;
59 S XMITARR="^TMP(""TRANARR"","_$J_")"
60 K @XMITARR
61 D PRELOAD^VAQREQ06
62 S VAQDOM=""
63 F S VAQDOM=$O(@DOMROOT@(VAQDOM)) Q:VAQDOM="" D XMIT
64 S X=$$GENTASK^VAQADM5(XMITARR)
65 I +X=-1 S ERR="-1^"_$P(X,U,2) Q ERR
66 K @XMITARR
67 QUIT 0
68 ;
69XMIT ; -- Make an entry in the 'PDX TRANSACTION' FILE
70 S X="+" ; -- auto number
71 S DIC="^VAT(394.61,",DIC(0)="L",DLAYGO=394.61
72 D ^DIC K DIC,X,DLAYGO
73 Q:Y<0
74 S (VAQPR,DA)=+Y,VAQDT=$P(Y,U,2)
75 ; -- FILL IN REST OF FIELDS OF 'TRANSACTION' FILE
76 I VAQOPT="REQ" D LDREQ^VAQREQ06
77 I VAQOPT="UNS" D LDUNS^VAQREQ06
78 I $D(@SEGROOT) D MSEG
79 I (VAQOPT="REQ")&($D(NOTIROOT)) D:$D(@NOTROOT) MNOTI
80 S @XMITARR@(VAQPR)="" ; -- Load an array of newly entered transactions
81 ; -- Update workload file
82 S X=$$WORKDONE^VAQADS01($S(VAQOPT="REQ":"RQST",VAQOPT="UNS":"SEND",1:""),VAQPR,$G(DUZ))
83 QUIT
84 ;
85MSEG ; -- Loads the data segment multiple
86 S PARAMND=$G(^VAT(394.81,1,"LIMITS")) ; -- Sets defaults from PDX param
87 S TLDEF=$P(PARAMND,U,1)
88 S OLDEF=$P(PARAMND,U,2)
89 ;
90 S DIE="^VAT(394.61,",SEG=""
91 F S SEG=$O(@SEGROOT@(SEG)) Q:SEG="" D
92 .S HSCOMPND=$$HLTHSEG^VAQDBIH1(SEG,0)
93 .I $P(HSCOMPND,U,1)=0 S (TLMT,OLMT)="" ; -- Not health summary segment
94 .I $P(HSCOMPND,U,1)'=0 D
95 ..S SEGND=$G(@SEGROOT@(SEG))
96 ..S TLMT=$P(SEGND,U,1),OLMT=$P(SEGND,U,2)
97 ..I (TLMT="")&($P(HSCOMPND,U,2)=1) S TLMT=TLDEF
98 ..I (OLMT="")&($P(HSCOMPND,U,3)=1) S OLMT=OLDEF
99 ..I $P(HSCOMPND,U,2)=0 S TLMT=""
100 ..I $P(HSCOMPND,U,3)=0 S OLMT=""
101 .S DR(2,394.618)=".02///"_TLMT_";.03///"_OLMT
102 .S DR="80///"_SEG
103 .D ^DIE
104 K DIE,DR,DLAYGO
105 QUIT
106 ;
107MNOTI ; -- Loads the notify muliple
108 S DIE="^VAT(394.61,",DLAYGO=394.61,NOTI=""
109 F S NOTI=$O(@NOTROOT@(NOTI)) Q:NOTI="" D
110 .S DR="71///"_NOTI
111 .D ^DIE
112 K DIE,DR,DLAYGO
113 QUIT
114 ;
Note: See TracBrowser for help on using the repository browser.