source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGRRPSGT.m@ 767

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

initial load of WorldVistAEHR

File size: 6.3 KB
Line 
1DGRRPSGT ; ALB/SGG - DG R&R PatientServices GET data - return XML ; 09/30/03
2 ;;5.3;Registration;**557**;Aug 13, 1993
3 ;
4DOC ;
5 ; ==================================================================
6 ; Documentation for the DGRRPS* routines is in DGRRPSAA.
7 ; ==================================================================
8 ; This routine is called from the RPC DGRR GET PATIENT SERVICES DATA
9 ; ==================================================================
10 ;
11 ;
12PATIENT(RESULT,PARAMS) ;
13 ;
14 NEW CURLINE,ICN,PTID,ERRMESS,PSARRAY,PSGLBCNT,DGRRPS,GLOB,TRACECNT,TRACENO,REQDT
15 ;
16 DO INITIZE
17 ;Call to INTRACE commented out to prevent to building of the XTMP global.
18 ;DO INTRACE
19 DO GETPATID(.ICN,.PTID,.ERRMESS) IF $G(ERRMESS)'="" GOTO ERROR
20 S REQDT=$G(PARAMS("REQUESTED_DATE"))
21 DO GETGLOBS
22 ;
23BUILD ; BUILD THE PATIENT XML
24 SET PSARRAY(1)=$$XMLHDR^DGRR557U_"^^^1" DO APPEND(.PSARRAY)
25 SET PSARRAY(1)="<Patient>" DO APPEND(.PSARRAY)
26 DO GETPSARY^DGRRPSID(.PSARRAY) DO APPEND(.PSARRAY)
27 IF +$G(PARAMS("PrimaryDemo")) DO GETPSARY^DGRRPSD1(.PSARRAY) DO APPEND(.PSARRAY)
28 IF +$G(PARAMS("SecondaryDemo")) DO GETPSARY^DGRRPSD2(.PSARRAY) DO APPEND(.PSARRAY)
29 IF +$G(PARAMS("TertiaryDemo")) DO GETPSARY^DGRRPSD3(.PSARRAY) DO APPEND(.PSARRAY)
30 IF +$G(PARAMS("MainAddress")) DO GETPSARY^DGRRPSAM(.PSARRAY) DO APPEND(.PSARRAY)
31 IF +$G(PARAMS("TemporaryAddress")) DO GETPSARY^DGRRPSAT(.PSARRAY) DO APPEND(.PSARRAY)
32 IF +$G(PARAMS("ConfidentialAddress")) DO GETPSARY^DGRRPSAC(.PSARRAY) DO APPEND(.PSARRAY)
33 IF +$G(PARAMS("ContactInfo")) DO GETPSARY^DGRRPSKN(.PSARRAY) DO APPEND(.PSARRAY)
34 IF +$G(PARAMS("ADTInfo")) DO GETPSARY^DGRRPSAD(.PSARRAY,REQDT) DO APPEND(.PSARRAY)
35 IF +$G(PARAMS("EnrollEligibility")) DO GETPSARY^DGRRPSEE(.PSARRAY) DO APPEND(.PSARRAY)
36 IF +$G(PARAMS("Incompetent")) DO GETPSARY^DGRRPSIC(.PSARRAY) DO APPEND(.PSARRAY)
37 DO GETPSARY^DGRRPSIN(.PSARRAY) DO APPEND(.PSARRAY)
38 SET PSARRAY(1)="<Error Message=''></Error>" DO APPEND(.PSARRAY)
39 SET PSARRAY(1)="</Patient>"_"^^^1" DO APPEND(.PSARRAY)
40 ;Call to OUTTRACE commented out preventing the building/purging of the
41 ;XTMP global.
42 ;DO OUTTRACE
43EXIT QUIT
44 ;
45APPEND(PSARRAY) ;
46 ; Append PSARRAY(1...n)= TextOnly ^ XML_attribute ^ ValueOfAttribute ^ FileNowFlag
47 ; In some code there are 5th and 6th pieces to this,, they are not used,, it was the start of a receiver/parser that was never needed
48 NEW MAXGL,TEXT,ATTRIB,VALUE,CLOSEOUT,NEWLINE
49 SET MAXGL=240 ; maximum global length
50 SET PSARRAY="" FOR SET PSARRAY=$O(PSARRAY(PSARRAY)) QUIT:PSARRAY="" DO
51 .SET TEXT=$P(PSARRAY(PSARRAY),"^",1)
52 .SET ATTRIB=$P(PSARRAY(PSARRAY),"^",2)
53 .SET VALUE=$P(PSARRAY(PSARRAY),"^",3)
54 .SET CLOSEOUT=$P(PSARRAY(PSARRAY),"^",4)
55 .SET CURLINE=$G(CURLINE)
56 .SET NEWLINE=TEXT
57 .IF ATTRIB'="" SET NEWLINE=NEWLINE_" "_ATTRIB_"='"_$S(VALUE'="":$$CHARCHK^DGRR557U(VALUE),1:"")_"'"
58 .IF ($L(CURLINE)+$L(NEWLINE))>MAXGL DO
59 ..SET ^TMP($J,"PS-DATA",PSGLBCNT)=$E(CURLINE_NEWLINE,1,MAXGL)
60 ..SET PSGLBCNT=PSGLBCNT+1
61 ..SET CURLINE=$E(CURLINE_NEWLINE,MAXGL+1,999),NEWLINE=""
62 .SET CURLINE=CURLINE_NEWLINE
63 .IF +$G(CLOSEOUT),+$L(CURLINE) DO
64 ..SET ^TMP($J,"PS-DATA",PSGLBCNT)=CURLINE
65 ..SET PSGLBCNT=PSGLBCNT+1
66 ..SET CURLINE=""
67 .QUIT
68 KILL PSARRAY
69 QUIT
70 ;
71INITIZE ; Initialize variables
72 KILL RESULT
73 KILL ^TMP($J,"PS-DATA")
74 SET PSGLBCNT=1
75 SET DGRRPS="^TMP($J,""PS-DATA"")"
76 SET RESULT=$NA(@DGRRPS)
77 IF '$D(DT) D DTNOLF^DICRW
78 KILL PSARRAY
79 QUIT
80 ;
81INTRACE ; Keep a record of what has been requested
82 N PURGDT
83 S PURGDT=$$FMADD^XLFDT(DT,31)
84 IF '$D(^XTMP("DGRRPS",0)) SET ^XTMP("DGRRPS",0)=PURGDT_"^"_DT_"^"_"LAST 30 DAYS OF PATIENT SERVICES ACTIVITY - CREATED IN RTN DGRRPSGT - THIS GLOBAL IS SELF PURGING ON >10,000 RECORDS OR >31 DAYS - email:VHA OI SDD CS Person Demographic"
85 SET $P(^XTMP("DGRRPS",0),"^",1)=PURGDT
86 SET TRACECNT=$G(^XTMP("DGRRPS","COUNT"))+1,^XTMP("DGRRPS","COUNT")=TRACECNT
87 SET ^XTMP("DGRRPS","TRACE",TRACECNT,"DATE",DT)=$$NOW^XLFDT
88 MERGE ^XTMP("DGRRPS","TRACE",TRACECNT,"PARAMS")=PARAMS
89 QUIT
90 ;
91GETPATID(ICN,PTID,ERRMESS) ; Get patient PTID and ICN
92 IF $G(PARAMS("PatientId_Type"))="ICN" DO
93 .SET ICN=$G(PARAMS("PatientId"))
94 .IF $E(ICN,1,6)=" ICN: " SET ICN=$E(ICN,7,99)
95 .SET ICN=$P(ICN,"^",1)
96 .SET PTID=$$GETDFN^MPIF001(ICN)
97 .; Call MPI API to be sure ICN is returned in ICN_V_checksum format
98 .SET ICN=$$GETICN^MPIF001(PTID)
99 .IF $G(PTID)<1 SET ERRMESS=$P(PTID,"^",2)
100 IF $G(PARAMS("PatientId_Type"))="DFN" DO
101 .SET PTID=+$G(PARAMS("PatientId"))
102 .SET ICN=$$GETICN^MPIF001(PTID)
103 .;IF +ICN<1 SET ERRMESS=$P(ICN,"^",2)
104 .IF ICN<1 SET ICN=""
105 IF ($G(PARAMS("PatientId_Type"))'="DFN"),($G(PARAMS("PatientId_Type"))'="ICN") SET ERRMESS="Unknown PatientId_Type"
106 QUIT
107 ;
108GETGLOBS ; Get required DPT globals
109 SET GLOB(0)=$G(^DPT(PTID,0))
110 SET GLOB(.11)=$G(^DPT(PTID,.11))
111 SET GLOB(.121)=$G(^DPT(PTID,.121))
112 SET GLOB(.13)=$G(^DPT(PTID,.13))
113 KILL GLOB(.14) MERGE GLOB(.14)=^DPT(PTID,.14)
114 SET GLOB(.141)=$G(^DPT(PTID,.141))
115 SET GLOB(.15)=$G(^DPT(PTID,.15))
116 SET GLOB(.22)=$G(^DPT(PTID,.22))
117 SET GLOB(.24)=$G(^DPT(PTID,.24))
118 SET GLOB(.29)=$G(^DPT(PTID,.29))
119 SET GLOB(.291)=$G(^DPT(PTID,.291))
120 SET GLOB(.3)=$G(^DPT(PTID,.3))
121 SET GLOB(.31)=$G(^DPT(PTID,.31))
122 SET GLOB(.32)=$G(^DPT(PTID,.32))
123 SET GLOB(.35)=$G(^DPT(PTID,.35))
124 SET GLOB(.36)=$G(^DPT(PTID,.36))
125 SET GLOB(.361)=$G(^DPT(PTID,.361))
126 SET GLOB(38.1)=$G(^DGSL(38.1,PTID,0))
127 SET GLOB(57)=$G(^DPT(PTID,57))
128 SET GLOB("NAME")=$$GETNME(PTID)
129 QUIT
130 ;
131GETNME(PTID) ; return patient name components
132 NEW RE,DGRRN
133 S DGRRN("FILE")=2
134 S DGRRN("FIELD")=.01
135 S DGRRN("IENS")=$$IENS^DILF(+PTID)
136 S RE=$$HLNAME^XLFNAME(.DGRRN)
137 Q RE
138 ;
139OUTTRACE ; Keep a record of what has been put out
140 MERGE ^XTMP("DGRRPS","TRACE",+$G(TRACECNT),"DATA")=^TMP($J,"PS-DATA")
141PURGE ; Purge trace > 31 days and >10,000 records
142 SET TRACENO="" FOR SET TRACENO=$O(^XTMP("DGRRPS","TRACE",TRACENO)) QUIT:TRACENO="" QUIT:($O(^XTMP("DGRRPS","TRACE",TRACENO,"DATE",""))>($$FMADD^XLFDT(DT,-31))) KILL ^XTMP("DGRRPS","TRACE",TRACENO)
143 SET TRACENO="" FOR SET TRACENO=$O(^XTMP("DGRRPS","TRACE",TRACENO)) QUIT:TRACENO="" QUIT:(TRACENO>($O(^XTMP("DGRRPS","TRACE",""),-1)-10000)) KILL ^XTMP("DGRRPS","TRACE",TRACENO)
144 QUIT
145 ;
146ERROR ; Build an Error XML and quit
147 DO INITIZE
148 SET PSARRAY(1)=$$XMLHDR^DGRR557U_"^^^1"
149 SET PSARRAY(2)="<Patient>"_"^^^1"
150 SET PSARRAY(3)="<Error"
151 SET PSARRAY(4)="^Message^"_ERRMESS
152 SET PSARRAY(5)="^PatientId^"_$G(PARAMS("PatientId"))
153 SET PSARRAY(6)="></Error>"_"^^^1"
154 SET PSARRAY(7)="</Patient>"_"^^^1" DO APPEND(.PSARRAY)
155 ;DO OUTTRACE
156 QUIT
Note: See TracBrowser for help on using the repository browser.