source: WorldVistAEHR/trunk/r/HEALTHEVET_DESKTOP-XHD/XHDPCAT.m@ 1800

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

initial load of WorldVistAEHR
File size: 4.9 KB
Line 
1XHDPCAT ; SLC/JER - Configurator Server Calls ; 25 Jul 2003 9:42 AM
2 ;;1.0;HEALTHEVET DESKTOP;;Jul 15, 2003
3INSERT(ERR,CATFLDS) ; Insert ParameterCategory
4 N XHDI,FDA,LASTI,LASTS,LASTN,X,XHDDAD,NEWDA
5 S X="ONERROR^XHDPCAT",@^%ZOSF("TRAP")
6 S XHDI="",(ERR,LASTS,LASTN)=0,LASTI=1
7 F S XHDI=$O(CATFLDS(XHDI)) Q:+XHDI'>0 D
8 . S FDA($$GETFILE(XHDI),$$GETIENS(XHDI),$$GETORI(XHDI))=CATFLDS(XHDI)
9 I $D(FDA)'>9 S ERR="1^Request not well-formed." Q
10 D UPDATER(.ERR,.FDA) Q:+ERR
11 I '+ERR S NEWDA=$P(ERR,U,2)
12 ; If new record's parent doesn't include it as a subCategory, add it
13 S XHDDAD=+$P(^XHD(8935.91,NEWDA,0),U,4)
14 I +XHDDAD,'+$O(^XHD(8935.91,"SCAT",NEWDA,XHDDAD,0)) D Q:+ERR
15 . N FDA,SUBERR
16 . S FDA(8935.913,"?+1,"_XHDDAD_",",.01)=(+$O(^XHD(8935.91,1,3,"A"),-1)+1)
17 . S FDA(8935.913,"?+1,"_XHDDAD_",",.02)="`"_NEWDA
18 . D UPDATER(.SUBERR,.FDA) S:+SUBERR ERR=SUBERR
19 ; If there are subcategories, file NEWDA as their parentId
20 I +NEWDA D
21 . N XHDJ,SUBERR S XHDJ=0
22 . F S XHDJ=$O(^XHD(8935.91,NEWDA,3,XHDJ)) Q:+XHDJ'>0!+ERR D
23 . . N SUBDA,FDA,IEN,MSG
24 . . S SUBDA=$P($G(^XHD(8935.91,NEWDA,3,XHDJ,0)),U,2) Q:+SUBDA'>0
25 . . I +$P($G(^XHD(8935.91,SUBDA,0)),U,4)=NEWDA Q
26 . . S FDA(8935.91,SUBDA_",",.04)="`"_NEWDA
27 . . D FILER(.SUBERR,.FDA,SUBDA) S:+SUBERR ERR=SUBERR
28 Q
29ADDPARAM(ERR,CATFLDS) ; Add Parameter to Category
30 N XHDI,FDA,PCDA,X S X="ONERROR^XHDPCAT",@^%ZOSF("TRAP")
31 S XHDI="",ERR=0,PCDA=+$G(CATFLDS("IEN"))
32 I $S('PCDA:1,'$D(^XHD(8935.91,PCDA,0)):1,1:0) D Q
33 . S ERR="1^Invalid ID passed."
34 L +^XHD(8935.91,PCDA):1
35 E D Q
36 . S ERR="1^Another process is modifying Category #"_PCDA
37 F S XHDI=$O(CATFLDS(XHDI)) Q:+XHDI'>0 D
38 . S FDA(8935.912,"?+1,"_PCDA_",",$P(XHDI,U,3))=CATFLDS(XHDI)
39 I $D(FDA)'>9 S ERR="1^Request not well-formed." Q
40 D UPDATER(.ERR,.FDA)
41 L -^XHD(8935.91,PCDA)
42 Q
43UPDATER(ERR,FDA) ; Call UPDATE^DIE to create pCats or subCats
44 N IEN,MSG
45 D UPDATE^DIE("E","FDA","IEN","MSG")
46 I $D(MSG("DIERR")) S ERR="1^"_MSG("DIERR",1,"TEXT",1) Q
47 S ERR="0^"_IEN(1)_U_IEN(1,0)
48 Q
49UPDATE(ERR,CATFLDS) ; Call FILE^DIE to update ParameterCategory
50 N XHDI,FDA,X S X="ONERROR^XHDPCAT",@^%ZOSF("TRAP")
51 S XHDI="",ERR=0,PCDA=+$G(CATFLDS("IEN"))
52 I $S('PCDA:1,'$D(^XHD(8935.91,PCDA,0)):1,1:0) D Q
53 . S ERR="1^Invalid ID passed."
54 F S XHDI=$O(CATFLDS(XHDI)) Q:+XHDI'>0 D
55 . S FDA($$GETFILE(XHDI),$$GETUPIEN(PCDA,XHDI),$$GETORI(XHDI))=CATFLDS(XHDI)
56 I $D(FDA)'>9 S ERR="1^Request not well-formed." Q
57 D UPDATER(.ERR,.FDA)
58 Q
59REMPARAM(ERR,PDEF,PCDA) ; Remove Parameter from Category
60 N XHDSDA,XHDI,FDA,X S X="ONERROR^XHDPCAT",@^%ZOSF("TRAP")
61 S XHDI="",ERR=0
62 I $S('+$G(PCDA):1,'$D(^XHD(8935.91,PCDA,0)):1,1:0) D Q
63 . S ERR="1^Invalid ID passed."
64 S XHDSDA=$O(^XHD(8935.91,PCDA,2,"C",PDEF,0))
65 I +XHDSDA S FDA(8935.912,XHDSDA_","_PCDA_",",.01)="@"
66 I $D(FDA)'>9 S ERR="1^Parameter "_PDEF_" not found in Category "_PCDA_"." Q
67 D FILER(.ERR,.FDA,PCDA)
68 Q
69REMOVE(ERR,PCAT,PARENT) ; Remove Parameter Category from parent
70 N XHDSDA,FDA,X S XHDSDA=0,X="ONERROR^XHDPCAT",@^%ZOSF("TRAP")
71 ; remove reference to parent
72 S FDA(8935.91,PCAT_",",.04)="@"
73 ; remove PCAT from parent's subCat multiple
74 S XHDSDA=$O(^XHD(8935.91,PARENT,3,"C",PCAT,0))
75 I +XHDSDA S FDA(8935.913,XHDSDA_","_PARENT_",",.01)="@"
76 I $D(FDA)'>9 S ERR="1^Sub-category not found in Parent Category." Q
77 D FILER(.ERR,.FDA,PARENT)
78 Q
79DELETE(ERR,PCAT,DELKIDS) ; Delete Parameter Category and all descendents
80 N X,FDA,PARENT S X="ONERROR^XHDPCAT",@^%ZOSF("TRAP"),ERR=0
81 ; if DELKIDS, remove descendents first
82 I +$G(DELKIDS) D Q:+ERR
83 . N XHDI S XHDI=0
84 . F S XHDI=$O(^XHD(8935.91,PCAT,3,XHDI)) Q:+XHDI'>0!+ERR D
85 . . N XHDSDA S XHDSDA=$P($G(^XHD(8935.91,PCAT,3,XHDI,0)),U,2)
86 . . I '+XHDSDA S ERR="1^Corrupt Sub-category at PCat #"_PCAT_", seq #"_XHDI Q
87 . . D DELETE(.ERR,XHDSDA,1)
88 ;Remove the sub-category from its parent prior to deletion
89 S PARENT=$P($G(^XHD(8935.91,PCAT,0)),U,4)
90 I +PARENT D REMOVE(.ERR,PCAT,PARENT)
91 ; delete record
92 S FDA(8935.91,PCAT_",",.01)="@"
93 I $D(FDA)'>9 S ERR="1^Request not well-formed." Q
94 D FILER(.ERR,.FDA,PCAT)
95 Q
96FILER(ERR,FDA,XHDDA) ; Call FILE^DIE with FDA to post changes
97 I $D(FDA)'>9 S ERR="1^Request not well-formed." Q
98 L +^XHD(8935.91,XHDDA):1
99 E D Q
100 . S ERR="1^Another process is modifying Category #"_XHDDA
101 D FILE^DIE("E","FDA","MSG")
102 L -^XHD(8935.91,XHDDA)
103 I $D(MSG("DIERR")) S ERR="1^"_MSG("DIERR",1,"TEXT",1) Q
104 S ERR="0^"_XHDDA
105 Q
106ONERROR ; Trap errors
107 S ERR="1^"_$TR($$EC^%ZOSV,"^","~")
108 D ^%ZTER
109 Q
110GETUPIEN(PCDA,XHDI) ; Get IENS for UPDATE call
111 Q $S($L(XHDI,U)=3:"?+"_$P(XHDI,U,2)_","_PCDA_",",1:PCDA_",")
112GETFILE(XHDI) ; Get first subscript for FDA
113 Q $S($P(XHDI,U)=2:8935.912,$P(XHDI,U)=3:8935.913,1:8935.91)
114GETIENS(XHDI) ; Get IENS for UPDATE^DIE call
115 I $L(XHDI,U)=3 D
116 . S LASTI=LASTI+$S($P(XHDI,U)'=LASTS:1,$P(XHDI,U,2)'=LASTN:1,1:0)
117 . S LASTS=$P(XHDI,U),LASTN=$P(XHDI,U,2)
118 Q $S($L(XHDI,U)=3:"?+"_LASTI_",?+1,",1:"?+1,")
119GETORI(XHDI) ; Get field subscript for FDA
120 Q $S($L(XHDI,U)=3:$P(XHDI,U,3),1:XHDI)
Note: See TracBrowser for help on using the repository browser.