source: VWGUIRegistration/trunk/VWREGITT.m

Last change on this file was 1806, checked in by Jim B., 22 months ago
File size: 6.3 KB
Line 
1VWREGITT        ;Portland\Jim Bell,  Input Template Management 2016
2        ;2.0**LOCAL** Copyright April 2016 ad infinitum;;;;;Build 4
3        ;*****************************************************************
4        ;* Licensed under GNU 2.0 or greater - see license.txt file      *
5        ;* Program/application is for the management of input templates  *
6        ;* owned by the user (DUZ).                                      *
7        ;* REMINDER: All template fields pertain only to the Patient File*
8        ;*  (#2)!                                                        *
9        ;*****************************************************************
10        Q  ;No fall through
11        ;
12AUTH(TUSER,TNUM)        ;Can user edit or is IT CONTROL
13        N TMO
14        S TMO=$O(^DIC(19,"B","VW REG IT CONTROL",0)) I $D(^VA(200,TUSER,203,"B",TMO)) Q 1
15        S TMO=$O(^DIC(19,"B","VW PATIENT REGISTRATION",0))
16        I TMO,$P(^DIE(TNUM,0),"^",5)=TUSER Q 1
17        Q 0
18        ;
19INR()   Q $O(RESULT(" "),-1)+1
20        ;
21CF(FIELD)       ;If a computed field, 0, else 1
22        I $P($G(^DD(2,FIELD,0)),"^",2)["C" Q 0
23        Q 1
24        ;
25EGF(RESULT,TNAME)       ;Get fields for client editing via TName
26        ;*************************
27        ;* Incoming___TNAME(IEN) *
28        ;*************************
29        K RESULT  ;N TNUM,TNAME,PF,SF
30        S TNUM=+$P(TNAME,"(",2)
31        S TNAME=$P(TNAME,"(")
32        I 'TNUM!('$D(^DIE(TNUM))) S RESULT(0)="Template name or number not found in Template file" Q
33        ;Check for authorization
34        I '$$AUTH(DUZ,TNUM) S RESULT(0)="Sorry, you are not authorized to edit this template." Q
35        S RESULT(0)="Editing "_TNAME_"("_TNUM_")"
36        S PF=$G(^DIE(TNUM,"DR",1,2))
37        F I=1:1:$L(PF,";") D:$P(PF,";",I)
38        . S RESULT($$INR)=$P(^DD(2,$P(PF,";",I),0),"^")_"("_$P(PF,";",I)_")"
39        . S SDD=+$P(^DD(2,$P(PF,";",I),0),"^",2) D:SDD
40        .. S SDN=1 F  S SDN=$O(^DIE(TNUM,"DR",SDN)) Q:'SDN  S:$O(^(SDN,0))=SDD SF=^(SDD) D
41        ... F J=1:1:$L(SF,";") D:$P(SF,";",J)
42        .... S SFF=$P(^DIE(TNUM,"DR",SDN,SDD),";",J)
43        .... S RESULT($$INR)="  SF  "_$P(^DD(SDD,SFF,0),"^")_"("_SFF_";"_SDD_")"
44        Q
45        ;
46SFLDS   ;Get sub-fields and dics
47        K MULT N N,X,I,Y
48        S Y="",N=0 F  S N=$O(TDATA(N)) Q:'+N  D
49        . Q:TDATA(N)'["  SF"  ;Still a major field
50        . F I=N:1:$O(TDATA(" "),-1) S X=TDATA(I) Q:X'["  SF"  S MULT(+$P(X,";",2),+$P(X,"(",2))=""
51        Q
52        ;
53FIELDS()        ;
54        N FLDLIST,N,X,FLD K MULT
55        S FLDLIST=""
56        S N=0 F  S N=$O(TDATA(N)) Q:'+N  D:TDATA(N)'["  SF"
57        . S FLD=+$P(TDATA(N),"(",2)
58        . Q:'$$CF(+$P(TDATA(N),"(",2))  ;Computed field
59        . S FLDLIST=FLDLIST_FLD_";"
60        ;Collate thru for multiple fields:entry looks like "  SF  "
61        S N=0 F  S N=$O(TDATA(N)) Q:'+N  D:TDATA(N)["  SF"
62        . S X=$P(TDATA(N),"  ",3)
63        . S SDD=+$P(X,";",2)
64        . S SFL=+$P(X,"(",2)
65        . S MULT(SDD,SFL)=""
66        S N=0 F  S N=$O(MULT(N)) Q:'+N  D  S SUB(N)=MF
67        . S MF="",N2=0 F  S N2=$O(MULT(N,N2)) Q:'+N2  S MF=MF_N2_";"
68        K MULT
69        Q FLDLIST
70        ;
71RTF(RESULT)     ;Send a refresh of regit.txt to client
72        K AR,RESULT
73        D LTF
74        M RESULT=AR
75        K AR
76        Q
77        ;
78LTF     ;Load the regit.txt file into AR()
79        S HD=$$GET^XPAR("ALL","VW GUI REG TEMPLATE DIRECTORY")
80        S FILE="regit.txt"
81        S P4=1
82        S P5=""
83        S X=$$FTG^%ZISH(HD,FILE,$NA(AR(1)),P4,P5)
84        Q
85        ;
86FTF     ;File the AR() to regit.txt
87        ZSY "cp "_HD_"regit.txt "_HD_"regitbu.txt"
88        S P4=1,P5="",FILE="regit.txt"
89        S X=$$GTF^%ZISH($NA(AR(1)),1,HD,FILE)
90        Q
91        ;
92ITCNTRL(USER)   ;Check for control capability and user authorization
93        N ITCNTRL
94        S ITCNTRL=$O(^DIC(19,"B","VW REG IT CONTROL",0))
95        I 'ITCNTRL D  Q 0
96        . S VAL=0
97        . S RESULT(0)="-1^VW REGISTRATION does not appear to be complete."
98        . S RESULT(1)="Please contact your Supervisor or IT support."
99        . S RESULT(2)="Thank you,"
100        . S RESULT(3)="The Management"
101        I '$D(^VA(200,USER,203,"B",ITCNTRL)) D  Q 0
102        . S RESULT(0)="-1^User does not have authorization to modify/create"
103        . S RESULT(1)="input templates. Please contact your Supervisor or"
104        . S RESULT(2)="IT support. Or, questions can be referred to Jim"
105        . S RESULT(3)="Bell at jbellco65@gmail.com"
106        . S RESULT(4)="Thank you."
107        Q 1
108        ;
109EN(RESULT,TDATA)        ;
110        ;************************************************
111        ;* Call from Client                             *
112        ;* TDATA Array:                                 *
113        ;*   0____Template Name^DUZ^ACTION^WRITEACCESS  *
114        ;*   1-n__Field name(number)                    *
115        ;************************************************
116        ; -- testing --
117        ;M ^DIZ("TDATA",$J)=TDATA
118        ;Q
119        ; -- end testing --
120        ;
121        N TNAME,TNUM,ITCNTRL,ACTION,FIELDS,CALLER
122        S CALLER=""
123        S X="TDATA" F  S X=$Q(@X) Q:X=""  S @X=$$UP^XLFSTR(@X)  ;Upcase everyTHING
124        I '$L($G(HD)) S HD=$$GET^XPAR("ALL","VW GUI REG TEMPLATE DIRECTORY")
125        S WHO=$P(TDATA(0),"^",2)
126        S ITCNTRL=$$ITCNTRL(WHO)  ;1=full action;0=create/edit own template(s)
127        S TNUM=+$P($P(TDATA(0),"^"),"(",2)
128        S TNAME=$P($P(TDATA(0),"^"),"(")
129        I TNAME["Editing" S SPEC("Editing ")="",TNAME=$$REPLACE^XLFSTR(TNAME,.SPEC)
130        S ACTION=$P(TDATA(0),"^",3)
131        S WRITEACC=$S($P(TDATA(0),"^",4)="SELF":$P(^VA(200,DUZ,0),"^",4),1:"")
132        S FIELDS=$$FIELDS
133        I '$L(ACTION) S RESULT(0)="-1^No action sent. I don't know what to do." Q
134        D @ACTION
135        Q
136        ;
137CREATE  ;Create a new input template
138        ;******************************
139        ;* Check for computed fields  *
140        ;******************************
141        K RESULT N %DT,X,Y
142        S %DT="TS",X="NOW" D ^%DT S FDATE=Y
143        S X=TNAME,DIC="^DIE(",DIC(0)="LZ" D FILE^DICN
144        S $P(^DIE(+Y,0),"^",2)=FDATE,$P(^(0),"^",3)="",$P(^(0),"^",4)=2,$P(^(0),"^",5)=DUZ
145        S $P(^DIE(+Y,0),"^",6)=WRITEACC
146C2      S ^DIE(+Y,"DR",1,2)=FIELDS
147        ;Do mult fields here
148        S N=0 F  S N=$O(SUB(N)) Q:'+N  D
149        . S UP=^DD(N,0,"UP")
150        . I UP=2 S ^DIE(+Y,"DR",$O(^DIE(+Y,"DR"," "),-1)+1,N)=SUB(N)
151        . E  S ^DIE(+Y,"DR",$O(^DIE(+Y,"DR"," "),-1),N)=SUB(N)
152        I $P(^DIE(+Y,0),"^")=$P(TDATA(0),"^") S RESULT(0)=$P(Y,"^",2)_" filed"
153        Q:CALLER="EDIT"
154        S TNUM=+Y,TNAME=$P(Y,"^",2)
155        K AR
156        D LTF  ;Get the regit.txt file loaded into AR()
157        S LAST=$O(AR(" "),-1)
158        S AR(LAST)=TNAME_"("_TNUM_")"
159        S AR(LAST+1)="[ID]"
160        ;M ^DIZ("TDATA","AR",$J)=AR  ;Testing
161        D FTF  ;File AR() to regit.txt
162        K ^DIZ("TDATA",$J)
163        Q
164        ;
165EDIT    ;Edit existing. Check for allowability
166        S Y=TNUM_"^"_TNAME
167EL      L -^DIE(TNUM):1 G EL:'$T
168        S S=1 F  S S=$O(^DIE(TNUM,"DR",S)) Q:'+S  D
169        . S SUBD=0 F  S SUBD=$O(^DIE(TNUM,"DR",S,SUBD)) Q:'+SUBD  K ^DIE(TNUM,"DR",S,SUBD)
170        S CALLER="EDIT"
171        D C2
172        L +^DIE(TNUM)
173        S DA=TNUM,DIK="^DIE(" D IX^DIK  ;Re-index record just in case...
174        S RESULT(0)=Y_" modification filed..."
175        Q
176        ;
177DELETE  ;********************************************
178        K AR
179        N I,J,X
180        S X="TDATA" F  S X=$Q(@X) Q:X=""  D
181        . Q:'$L($P(@X,"^",3))  ;No entry
182        . K @X
183        M AR=TDATA K TDATA
184        D FTF
185        I X S RESULT(0)="Template menu list updated."
186        E  S RESULT(0)="Template list not updated. Advise Template manager to manually update "_HD_"regit.txt"
187        Q
188       
Note: See TracBrowser for help on using the repository browser.