1 0 HMPUPD ;SLC/MKB,ASMR/RRB,CK - Update local data ;Jun 22, 2016 17:23:52
2 1  ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**1,2**;May 15, 2016;Build 28
3 2  ;Per VA Directive 6402, this routine should not be modified.
4 3  ;
5 4  
Q
6 5  
;
7 0
PHONE(HMP,JSON) ; RPC = HMP PUT PHONE
8 1  
Q
9 0
PUT(HMP,DFN,CMD,JSON) ; -- update phone numbers
10 1  ; RPC = HMP PUT DEMOGRAPHICS
11 2  ;
12 3  
ARRAY,HMPERR,ERR,HOME,CELL,WORK,NOK,ECON,X,OK,HMPSYS
13 4  
HMPSYS=$$SYS^HMPUTILS
14 5  
DECODE^HMPJSON("JSON","ARRAY","HMPERR")
15 6  
I $D(HMPERRD  G PQ
16 7  
ARRAY HMPTMP,HMPTXT
17 8  
HMPTXT(1)="Problem decoding json input."
18 9  
SETERROR^HMPUTILS(.HMPTMP,.HMPERR,.HMPTXT,.JSON)
19 10  . 
HMPERR ENCODE^HMPJSON("HMPTMP","ARRAY","HMPERR")
20 11  . 
HMP(.5)="{""apiVersion"":""1.01"",""error"":{"
21 12  
HMP(1)=ARRAY
22 13  
HMP(2)="}}"
23 14  ;
24 15  
DFN=+$G(DFNDFN<1 ERR=$$ERR(1,DFNPHQ
25 16  
CMD=$G(CMD;can only update phone#
26 17  
HMPX,HMPDR,I,(HMPDR,HOME,CELL,WORK,NOK,ECON)=""
27 18  
VAL("old")
28 19  
I="" F  S I=$O(ARRAY("telecom",I)) Q:I<1  D
29 20  
I $G(ARRAY("telecom",I,"use"))="H" D  Q
30 21  
.. HOME=$G(ARRAY("telecom",I,"value"))
31 22  .. 
HOME=HOME("old"HOME="" Q           ;no change
32 23  
.. "@"[HOME S:$L(HOME("old")) HOME="@" Q  ;delete
33 24  
.. HOME=$$FORMAT(HOME),ARRAY("telecom",I,"value")=HOME
34 25  
I $G(ARRAY("telecom",I,"use"))="MC" D  Q
35 26  
.. CELL=$G(ARRAY("telecom",I,"value"))
36 27  .. 
CELL=CELL("old"CELL="" Q           ;no change
37 28  
.. "@"[CELL S:$L(CELL("old")) CELL="@" Q  ;delete
38 29  
.. CELL=$$FORMAT(CELL),ARRAY("telecom",I,"value")=CELL
39 30  
I $G(ARRAY("telecom",I,"use"))="WP" D  Q
40 31  
.. WORK=$G(ARRAY("telecom",I,"value"))
41 32  .. 
WORK=WORK("old"WORK="" Q           ;no change
42 33  
.. "@"[WORK S:$L(WORK("old")) WORK="@" Q  ;delete
43 34  
.. WORK=$$FORMAT(WORK),ARRAY("telecom",I,"value")=WORK
44 35  
I="" F  S I=$O(ARRAY("contact",I)) Q:I<1  D
45 36  
X=$P($G(ARRAY("contact",I,"typeCode")),":",4) Q:X=""  ;NOK or ECON
46 37  
J="" F  S J=$O(ARRAY("contact",I,"telecom",J)) Q:J<1  D
47 38  
.. Q:$G(ARRAY("contact",I,"telecom",J,"use"))'="H"
48 39  
.. @X=$G(ARRAY("contact",I,"telecom",J,"value"))
49 40  .. 
@X=@X@("old"@X="" Q           ;no change
50 41  
.. "@"[@S:$L(@X@("old")) @X="@" Q  ;delete
51 42  
.. @X=$$FORMAT(@X),ARRAY("contact",I,"telecom",J,"value")=@X
52 43  
.. ; X="NOK" S NOK=$$FORMAT(NOK),ARRAY("contact",I,"telecom",J,"value")=NOK
53 44  ;
54 45  
S:$L(HOMEHMPX(.131)=HOME,HMPDR=".131"
55 46  
S:$L(CELLHMPX(.134)=CELL,HMPDR=HMPDR_$S($L(HMPDR):";",1:"")_".134"
56 47  
S:$L(WORKHMPX(.132)=WORK,HMPDR=HMPDR_$S($L(HMPDR):";",1:"")_".132"
57 48  
S:$L(ECONHMPX(.339)=ECON,HMPDR=HMPDR_$S($L(HMPDR):";",1:"")_".339"
58 49  
S:$L(NOKHMPX(.219)=NOK,HMPDR=HMPDR_$S($L(HMPDR):";",1:"")_".219"
59 50  
'$O(HMPX(0)) ERR=$$ERR(3) PHQ
60 51  
EDIT^VAFCPTED(DFN,"HMPX",HMPDR)
61 52  
X=$G(^DPT(DFN,.13)),OK=1 D  ;check global ;ICR 10035 DE2818 ASF 11/12/15
62 53  
I $L(HOME),$S(HOME="@":$L($P(X,U)),1:(HMPX(.131)'=$P(X,U))) OK=0
63 54  . 
I $L(CELL),$S(CELL="@":$L($P(X,U,4)),1:(HMPX(.134)'=$P(X,U,4))) OK=0
64 55  . 
I $L(WORK),$S(WORK="@":$L($P(X,U,2)),1:(HMPX(.132)'=$P(X,U,2))) OK=0
65 56  . 
I $L(ECONX=$G(^DPT(DFN,.33)) I $S(ECON="@":$L($P(X,U,9)),1:(HMPX(.339)'=$P(X,U,9))) OK=0 ;ICR 10035 DE2818 ASF 11/12/15
66 57  
I $L(NOKX=$G(^DPT(DFN,.21)) I $S(NOK="@":$L($P(X,U,9)),1:(HMPX(.219)'=$P(X,U,9))) OK=0 ;ICR 10035 DE2818 ASF 11/12/15
67 58  
S:'OK ERR=$$ERR(5)
68 59  
;
69 0
PHQ ; add item count and terminating characters
70 1  
I $D(ERRHMP(1)="{""apiVersion"":""1.01"",""error"":{""message"":"""_ERR_"""},""success"":false}" PQ
71 2  
; HMP="{""apiVersion"":""1.01"",""data"":{""updated"":"_""""_$$HL7NOW_""""_",""localId"":"""_DFN_"""},""success"":true}"
72 3  
POSTX^HMPEVNT("patient",DFN)
73 4  
ENCODE^HMPJSON("ARRAY","HMP","HMPERR")
74 5  
I $D(HMPERRD  G PQ
75 6  
HMP HMPTMP,HMPTXT
76 7  
HMPTXT(1)="Problem encoding json output."
77 8  
SETERROR^HMPUTILS(.HMPTMP,.HMPERR,.HMPTXT,.ARRAY)
78 9  . 
HMPERR ENCODE^HMPJSON("HMPTMP","HMP","HMPERR")
79 10  . 
HMP(.5)="{""apiVersion"":""1.01"",""error"":{",HMP(99)="}}"
80 11  
HMP(.5)="{""apiVersion"":""1.01"",""params"":{"_$$SYS^HMPDJ_"},""success"":true,"
81 12  
HMP(.6)="""data"":{""updated"":"""_$$HL7NOW^HMPDJ_""",""totalItems"":1,""items"":["
82 13  
HMP(99)="]}}"
83 0
PQ ; exit
84 1  
^TMP($J,"HMP")
85 2  
^TMP($J,"HMP")=HMP
86 3  
HMP HMP=$NA(^TMP($J,"HMP"))
87 4  
Q
88 5  
;
89 0
FORMAT(X) ; -- enforce (xxx)xxx-xxxx phone format
90 1  
X=$G(XX?1"("3N1")"3N1"-"4N.X
91 2  
P,N,I,P=""
92 3  
I=1:1:$L(XN=$E(X,IN=+P=P_N
93 4  
S:$L(P)<10 P=$E("0000000000",1,10-$L(P))_P
94 5  
Y=$S(P:"("_$E(P,1,3)_")"_$E(P,4,6)_"-"_$E(P,7,10),1:"")
95 6  
Y
96 7  
;
97 0
HL7NOW() ; -- Return current time in HL7 format
98 1  
Q $$FMTHL7^HMPSTMP($$NOW^XLFDT)  ; DE5016
99 2  ;
100 0
ERR(X,VAL) ; -- return error message
101 1  
MSG  MSG="Error"
102 2  
X=1  MSG="Patient with dfn '"_$G(VAL)_"' not found"
103 3  
X=2  MSG="Domain type '"_$G(VAL)_"' not recognized"
104 4  
X=3  MSG="Data not changed"
105 5  
X=4  MSG="Unable to create new object"
106 6  
X=5  MSG="Update failed"
107 7  
X=99 MSG="Unknown request"
108 8  
MSG
109 9  
;
110 0
VAL(SUB) ; -- pull values from ^DPT
111 1  
X=$G(^DPT(DFN,.13)) ;ICR 10035 DE2818 ASF 11/12/15
112 2  
HOME(SUB)=$P(X,U),CELL(SUB)=$P(X,U,4),WORK(SUB)=$P(X,U,2)
113 3  
X=$G(^DPT(DFN,.33)),ECON(SUB)=$P(X,U,9) ;ICR 10035 DE2818 ASF 11/12/15
114 4  
X=$G(^DPT(DFN,.21)),NOK(SUB)=$P(X,U,9) ;ICR 10035 DE2818 ASF 11/12/15
115 5  
Q