forked from KRMAssociatesInc/JDS-GTM
/
VPRJCT1.m
107 lines (107 loc) · 4.45 KB
/
VPRJCT1.m
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
VPRJCT1 ;SLC/KCM -- Apply Rel and Rev Templates
;;1.0;JSON DATA STORE;;Sep 01, 2012
;
RELTLTP(ROOT,KEY,TLT,PID) ; apply rel template for VPR and put in ROOT
N CTN,OBJECT,STAMP,JPID
;
S JPID=$$JPID4PID^VPRJPR(PID)
I JPID="" D SETERROR^VPRJRER(224,"Identifier "_PID) Q
; Get latest object stamp
S STAMP=$O(^VPRPT(JPID,PID,KEY,""),-1)
; TODO: check to see if PID is defined here for xvpr queries
S CTN=$P(KEY,":",3) M OBJECT=^VPRPT(JPID,PID,KEY,STAMP)
G RELTLT
;
RELTLTD(ROOT,KEY,TLT) ; apply rel template for DATA and put in ROOT
N CTN,OBJECT,STAMP
; Get latest object stamp
S STAMP=$O(^VPRJD(KEY,""),-1)
S CTN=$P(KEY,":",3) M OBJECT=^VPRJD(KEY,STAMP)
G RELTLT
;
RELTLT ; common entry point for rel template
; from: RELTLTP, RELTLTD expects: CTN, OBJECT
; ROOT: closed global reference like ^TMP($J)
; ITEM: item or record number
; KEY: KEY in the ^VPRPT or ^VPRJD
; .TLT: rel,relname
; .TLT(collection,...): information for template based on collection
N SPEC,VALS,ERRS
M SPEC=TLT("collection",CTN)
; just return UID if there is not template defined for this collection
I '$D(SPEC) S @ROOT@(1)="{""uid"":"""_$G(OBJECT("uid"))_"""}" Q
D GETVALS^VPRJCV1(.OBJECT,.VALS,.SPEC,1)
D SETJSON^VPRJCV1(.OBJECT,.VALS,.SPEC,1)
D ENCODE^VPRJSON("OBJECT",ROOT,"ERRS")
; TODO: figure out how to throw an error at this point (writing out response)
Q
;
REVTLTP(ROOT,KEY,TLT,PID) ; add multiple for rev template and put in ROOT
N OBJECT,REVFLD,REL,UID,CNT,JPID
S REVFLD=TLT("common","rev"),REL=TLT("common","rel"),CNT=0
;
S JPID=$$JPID4PID^VPRJPR(PID)
I JPID="" D SETERROR^VPRJRER(224,"Identifier "_PID) Q
; TODO: check to see if PID is defined here for xvpr queries
M OBJECT=^VPRPT(JPID,PID,KEY)
S UID="" F S UID=$O(^VPRPTI(JPID,PID,"rev",KEY,REL,UID)) Q:UID="" D REVTLT
D ENCODE^VPRJSON("OBJECT",ROOT,"ERRS")
; TODO: figure out how to throw an error at this point (writing out response)
Q
;
REVTLTD(ROOT,KEY,TLT) ; apply rev template for DATA and put in ROOT
N OBJECT,REVFLD,REL,UID,CNT,STAMP
S STAMP=$O(^VPRJD(KEY,""),-1)
S REVFLD=TLT("common","rev"),REL=TLT("common","rel"),CNT=0
M OBJECT=^VPRJD(KEY,STAMP)
S UID="" F S UID=$O(^VPRJDX("rev",KEY,REL,UID)) Q:UID="" D REVTLT
D ENCODE^VPRJSON("OBJECT",ROOT,"ERRS")
; TODO: figure out how to throw an error at this point (writing out response)
Q
;
REVTLT ; common entry point for rev template
; from: REVTLTP, REVTLTD expects: CTN, OBJECT
S CNT=CNT+1
I $G(TLT("common","revTemplate"))="uid" S OBJECT(REVFLD,CNT,"uid")=UID Q
; otherwise apply template
N JSON
D UID2JSN^VPRJCV1(UID,.JSON,TLT("common","revTemplate"))
M OBJECT(REVFLD,CNT,":")=JSON
Q
;
; Build JSON objects for associated templates
; @param {string} CLTN - identifies the collection
; @param {array} OBJECT - (passed by reference) decoded JSON object as a MUMPS array
; @param {array} TLTARY - (passed by reference) array of JSON objects that get built based on templates
BLDTLT(CLTN,OBJECT,TLTARY)
N TLTNM,TJSON
S TLTNM="" F S TLTNM=$O(^VPRMETA("collection",CLTN,"template",TLTNM)) Q:TLTNM="" D Q:$G(HTTPERR)
. I $D(^VPRMETA("template",TLTNM,"collection",CLTN))<10 D SETERROR^VPRJRER(219,TLTNM) Q
. I $G(^VPRMETA("template",TLTNM,"common","applyOn"))'="S" Q ; skip applyOnQuery
. N SPEC
. S SPEC=TLTNM
. M SPEC=^VPRMETA("template",TLTNM,"collection",CLTN)
. D APPLY^VPRJCT(.SPEC,.OBJECT,.TJSON) Q:$G(HTTPERR)
. M TLTARY(TLTNM)=TJSON
Q
QRYTLT(ROOT,KEY,TLT,PID,INST) ; apply template at query time and put in ROOT
Q
; Load the specification for a template
; @param {array} TEMPLATE - (passed by reference) contains the formatted MUMPS array for a template
LOADSPEC(TEMPLATE)
; TEMPLATE contains the template name
; .TEMPLATE(collection,...): returned information
Q:TEMPLATE="uid" ; special case - uid is hard coded template
N TYPE,NAME,RELTLT
S TYPE="template",NAME=TEMPLATE
I $E(TEMPLATE,1,4)="rel;" S TYPE="link",NAME=$P(TEMPLATE,";",2),RELTLT=$P(TEMPLATE,";",3)
I $E(TEMPLATE,1,4)="rev;" S TYPE="link",NAME=$P(TEMPLATE,";",2),RELTLT=$P(TEMPLATE,";",3)
I '$D(^VPRMETA(TYPE,NAME)) D SETERROR^VPRJRER(105,NAME) Q
I TYPE="template",($G(^VPRMETA("template",NAME,"common","applyOn"))'="Q") Q ; only merge query type
M TEMPLATE=^VPRMETA(TYPE,NAME)
I $P(TEMPLATE,";")="rev",'$L($G(TEMPLATE("common","rev"))) D SETERROR^VPRJRER(113,TEMPLATE) Q
I $L($G(RELTLT)) D
. I $P(TEMPLATE,";")="rev" S TEMPLATE("common","revTemplate")=RELTLT Q
. N CTN
. S CTN="" F S CTN=$O(TEMPLATE("collection",CTN)) Q:'$L(CTN) S TEMPLATE("collection",CTN,1,1,"srcTemplate")=RELTLT
Q