119 lines
4.6 KiB
Mathematica
119 lines
4.6 KiB
Mathematica
QACVEMPX ; Return Person Data using Value List Handler Pattern to update Patient Advocate PatsPerson table ;5/8/06 10:36
|
|
;;2.0;Patient Representative;**19**;07/25/1995;Build 55
|
|
EN(PATSBY,LKUPVAL,PATSROWS,PATSFRM0,PATSFRM1) ; Lookup Employee by Name, then
|
|
; Output XML formatted data from NEW PERSON file.
|
|
; PATSBY contains the name of the output array (pass by reference)
|
|
; LKUPVAL is the name of the person to be matched (LAST,FIRST), or
|
|
; an array of Security Keys.
|
|
; PATSROWS=Number of rows to return in each call
|
|
; PATSFRM0=Employee Name value from previous call (empty on first call)
|
|
; PATSFRM1=Employee IEN from previous call (empty on first call)
|
|
K ^TMP("DILIST",$J),^TMP("PatsPersonXml",$J)
|
|
N STDNAME,NAMECOMP,IENS,PIECE,OUTCNT,TAGLIST,FROM,PART,SRVIEN,MAILCODE,TITLE,SRVRSTA,PATSMORE,PATSERR,DIERR,I,J,X,Y
|
|
; If LKUPVAL exists, it contains an employee name. Else, it is
|
|
; an array of Security Key values and we want to find all holders
|
|
; of those keys.
|
|
; Standardize the name, parse out last name and first name.
|
|
I $G(LKUPVAL)]"" S STDNAME=LKUPVAL D BYNAME
|
|
I $G(LKUPVAL)="" D
|
|
. D EN^QACVKHLD(.LKUPVAL,PATSROWS,.PATSFRM0,.PATSFRM1)
|
|
. S FROM(1)=$G(PATSFRM0),FROM(2)=$G(PATSFRM1)
|
|
. S PATSMORE=$S(FROM(1)="":0,1:1)
|
|
. Q
|
|
I '$D(^TMP("DILIST",$J)),'$D(^TMP("DIERR",$J)) Q
|
|
S PATSERR="" I $D(^TMP("DIERR",$J)) S PATSERR=$G(^TMP("DIERR",$J,1,"TEXT",1))
|
|
; Get Station Number of Institution where server resides (IA #1518)
|
|
S SRVRSTA=$$STA^XUAF4(+$$GET1^DIQ(8989.3,1,217,"I"))
|
|
; Set name of output array into output parameter.
|
|
S PATSBY=$NA(^TMP("PatsPersonXml",$J))
|
|
; Now build the output.
|
|
D HDR
|
|
S OUTCNT=2
|
|
D EN2(.OUTCNT),FOOTER(.OUTCNT)
|
|
Q
|
|
;
|
|
;
|
|
BYNAME ; Standardize the name, parse out last name and first name. (IA #3065)
|
|
D STDNAME^XLFNAME(.STDNAME,"FG")
|
|
N FIRST,LAST,LEN,SCR,CURRDT
|
|
S LAST=$P(STDNAME,","),FIRST=$P(STDNAME,",",2,99)
|
|
S CURRDT=$$DT^XLFDT()
|
|
; Screen out terminated users.
|
|
S SCR="I ($P(^(0),""^"",11)=""""!(CURRDT<$P(^(0),""^"",11)))"
|
|
; If first name was passed, check for it with a screen.
|
|
S LEN=$L(FIRST) I LEN>0 S SCR=SCR_",$E($P($P(^(0),""^""),"","",2,99),1,"_LEN_")="_""""_FIRST_""""
|
|
; Set the starting values, and partial match values.
|
|
I $G(PATSFRM0)="" S FROM(1)=LAST,FROM(2)=""
|
|
E S FROM(1)=PATSFRM0,FROM(2)=$G(PATSFRM1)
|
|
S PART(1)=LAST
|
|
I '$G(PATSROWS) S PATSROWS=10
|
|
; Return list of standard name pointer, title and mail code (IA #10060)
|
|
D LIST^DIC(200,,"@;8;28","MP",PATSROWS,.FROM,.PART,"B",SCR)
|
|
; Set flag telling whether there are more entries to fetch).
|
|
S PATSMORE=$S(FROM(1)="":0,1:1)
|
|
Q
|
|
;
|
|
HDR ; Build header node
|
|
S ^TMP("PatsPersonXml",$J,1)="<?xml version=""1.0"" encoding=""utf-8""?>"
|
|
S ^TMP("PatsPersonXml",$J,2)="<PersonDataSet hasMore="""_PATSMORE_""" patsFrom0="""_FROM(1)_""" patsFrom1="""_FROM(2)_""" vistAError="""_PATSERR_""">"
|
|
Q
|
|
;
|
|
EN2(OUTCNT) ; Build output for individual persons.
|
|
N TAGLIST,IENS,TITLE,MAILCODE,NAMECOMP,I,J,X,Y
|
|
; Build list of XML tags to use in output.
|
|
D BLDLST(.TAGLIST)
|
|
; Read through lister results and build output
|
|
F I=0:0 S I=$O(^TMP("DILIST",$J,I)) Q:'I S X=$G(^(I,0)) D
|
|
. S OUTCNT=OUTCNT+1
|
|
. S ^TMP("PatsPersonXml",$J,OUTCNT)="<PatsPerson>"
|
|
. S IENS=$P(X,"^") Q:IENS="" S IENS=IENS_","
|
|
. ; NOTE: does not remove reserved XML characters (see $$SYMENC^MXMLUTL, IA#4153)
|
|
. S TITLE=$E($P(X,"^",2),1,30)
|
|
. S MAILCODE=$E($P(X,"^",3),1,30)
|
|
. ; Get the individual name components and add them to the output (IA #3065)
|
|
. K NAMECOMP S NAMECOMP("FILE")=200,NAMECOMP("FIELD")=.01,NAMECOMP("IENS")=IENS
|
|
. S NAMECOMP=$$HLNAME^XLFNAME(.NAMECOMP,"S")
|
|
. F J=1:1:6 D
|
|
.. S OUTCNT=OUTCNT+1
|
|
.. S Y=$P(NAMECOMP,"^",J)
|
|
.. S ^TMP("PatsPersonXml",$J,OUTCNT)="<"_TAGLIST(J)_">"_Y_"</"_TAGLIST(J)_">"
|
|
.. Q
|
|
. S OUTCNT=OUTCNT+1
|
|
. S ^TMP("PatsPersonXml",$J,OUTCNT)="<Title>"_TITLE_"</Title>"
|
|
. S OUTCNT=OUTCNT+1
|
|
. S ^TMP("PatsPersonXml",$J,OUTCNT)="<MailCode>"_MAILCODE_"</MailCode>"
|
|
. S OUTCNT=OUTCNT+1
|
|
. S ^TMP("PatsPersonXml",$J,OUTCNT)="<VistaIen>"_$P(X,"^")_"</VistaIen>"
|
|
. S OUTCNT=OUTCNT+1
|
|
. S ^TMP("PatsPersonXml",$J,OUTCNT)="</PatsPerson>"
|
|
. Q
|
|
Q
|
|
;
|
|
FOOTER(OUTCNT) ; Add the footer
|
|
S ^TMP("PatsPersonXml",$J,OUTCNT+1)="</PersonDataSet>"
|
|
K ^TMP("DILIST",$J)
|
|
Q
|
|
;
|
|
CONV(NAMEPART) ; Convert a name part to mixed case
|
|
N LEN,TEMP,UPPER,I,X
|
|
S LEN=$L(NAMEPART),UPPER=1,TEMP=""
|
|
F I=1:1:LEN S X=$E(NAMEPART,I,I) D
|
|
. I UPPER=1 D
|
|
.. I X?1L S X=$C($A(X)-32)
|
|
.. S UPPER=0 Q
|
|
. E I X?1U S X=$C($A(X)+32)
|
|
. S TEMP=TEMP_X
|
|
. I X'?1L,X'?1U S UPPER=1
|
|
. Q
|
|
Q TEMP
|
|
;
|
|
BLDLST(TAGLIST) ; Build list of XML data tags
|
|
S TAGLIST(1)="LastName"
|
|
S TAGLIST(2)="FirstName"
|
|
S TAGLIST(3)="MiddleName"
|
|
S TAGLIST(4)="NameSuffix"
|
|
S TAGLIST(5)="NamePrefix"
|
|
S TAGLIST(6)="Degree"
|
|
Q
|
|
;
|