EDPBWS ;SLC/KCM - Worksheet Configuration Calls ;7/27/12 4:22pm
;;2.0;EMERGENCY DEPARTMENT;**6,7**;Feb 24, 2012;Build 18
;
;DBIA SECTION
;2053 - FILE^DIE,UPDATE^DIE
;2056 - $$GET1^DIQ
;
LOADALL(EDPSITE,AREA,EDPROLE) ; load all worksheet configurations for an area
N ROLES,SECTIONS,WORKSHTS,COMPNTS,RESULTS
;D LSTROLES(AREA,.ROLES) M RESULTS("roles",1)=ROLES
;D LSTROLES(.ROLES) M RESULTS("roles",1)=ROLES
;D LSTCMPTS(AREA,.COMPNTS) M RESULTS("components")=COMPNTS
;D LSTSECTS(AREA,.SECTIONS) M RESULTS("sections",1)=SECTIONS
D LSTWKS(EDPSITE,AREA,.WORKSHTS) M RESULTS("worksheets")=WORKSHTS
D TOXML^EDPXML(.RESULTS,.EDPXML)
Q
GETROLES(EDPSITE,AREA) ; get list of roles
N ROLES
D XML^EDPX("<roles>")
D LSTROLES(AREA,.ROLES)
D XML^EDPX("</roles>")
Q
GETSECTS(AREA,EDPXML,ROLE) ; get list of sections
N RESULTS,SECTIONS
D LSTSECTS(AREA,.SECTIONS,ROLE) M RESULTS("sections",1)=SECTIONS
D TOXML^EDPXML(.RESULTS,.EDPXML)
Q
GETCMPTS(AREA,EDPXML,IEN,ROLE) ; get list of components
N RESULTS,COMPNTS
S IEN=$G(IEN,"")
D LSTCMPTS(AREA,.COMPNTS,IEN,ROLE) M RESULTS("components",1)=COMPNTS
D TOXML^EDPXML(.RESULTS,.EDPXML)
Q
GETWORKS(EDPSITE,IEN,REQ,EDPXML) ; get worksheet given IEN
N WKSSPEC,RESULTS
D GETWKS(EDPSITE,IEN,.REQ,.WKSSPEC) M RESULTS("worksheet",IEN)=WKSSPEC
D TOXML^EDPXML(.RESULTS,.EDPXML)
Q
LDWSLIST(EDPSITE,AREA,ROLE) ; load brief worksheet list
; ROLE (optional) - If no role is passed, all worksheets for an AREA/SITE will be returned.
N WSIEN,X0,X,WSNAME,RIEN,TYPE,WSLIST
D XML^EDPX("<worksheets>")
S RIEN=0 F S RIEN=$O(^EDPB(232.6,"D",RIEN)) Q:'RIEN D
.; quit if this is not the role we are looking for
.I $G(ROLE) Q:RIEN'=ROLE
.D XML^EDPX("<role id="_""""_RIEN_""""_" >")
.S WSIEN=0 F S WSIEN=$O(^EDPB(232.6,"D",RIEN,WSIEN)) Q:'WSIEN D
..Q:$G(WSLIST(WSIEN))
..S WSLIST(WSIEN)=1 ;Don't send the same list twice
..S X0=$G(^EDPB(232.6,WSIEN,0))
..S WSNAME=$P(X0,U),TYPE=$P(X0,U,4)
..S X("id")=WSIEN,X("worksheetName")=WSNAME,X("type")=TYPE
..S X("name")=$P(X0,U),X("id")=WSIEN
..S X("institution")=$P(X0,U,2)
..S X("area")=$P(X0,U,3)
..S X("disabled")=$S($P(X0,U,6):"true",1:"false")
..S X("editable")=$S($P(X0,U,7):"true",1:"false")
..I $$GET1^DIQ(232.5,RIEN,.06,"I")=WSIEN S X("default")="true"
..D XML^EDPX($$XMLA^EDPX("worksheet",.X)) K X
.D XML^EDPX("</role>")
D XML^EDPX("</worksheets>")
Q
LSTROLES(AREA,ARRAY) ; list roles for an area
N RIEN,X0,ROLEIEN,ROLENM,WKS,CNT,EDAC,RABBR
S CNT=0
S RABBR="" F S RABBR=$O(^EDPB(232.5,"C",RABBR)) Q:RABBR="" D
.S RIEN="" F S RIEN=$O(^EDPB(232.5,"C",RABBR,RIEN)) Q:'RIEN D
..S CNT=CNT+1
..S X0=$G(^EDPB(232.5,RIEN,0)),ROLENM=$P(X0,U),WKS=$P(X0,U,4),EDAC=$P(X0,U,6)
..S X("id")=RIEN
..S X("abbr")=RABBR
..S X("displayName")=ROLENM
..S X("defaultWorksheet")=WKS
..S X("editAcuity")=$S(+EDAC:"true",1:"false")
..D XML^EDPX($$XMLA^EDPX("role",.X))
Q
LSTCMPTS(AREA,ARRAY,IEN,ROLE) ; list components for an area
N CNT
I $G(IEN) D BLDCMPTS(IEN,1,1,.ARRAY) Q
S IEN=0 F S IEN=$O(^EDPB(232.72,IEN)) Q:'IEN D
.I $G(ROLE) Q:'$D(^EDPB(232.72,IEN,8,"B",ROLE))
.S CNT=$G(CNT)+1
.D BLDCMPTS(IEN,CNT,,.ARRAY)
Q
BLDCMPTS(IEN,CNT,MOREDAT,ARRAY) ;
; IEN - component IEN
; CNT - simple counter
; MOREDAT - If MOREDAT is passed, return more information
; This is used to differentiate between a 'list'
; style of call, versus a full 'get' on a specific entry
;
N NAME,X0,X1,X2,X3,X6,PIEN,P0,RCNT,RIEN,ROLE,V0,X10,DEP,DEPCNT
S X0=$G(^EDPB(232.72,IEN,0)),NAME=$P(X0,U)
S MOREDAT=$G(MOREDAT,0)
S ARRAY("component",CNT,"id")=IEN
S ARRAY("component",CNT,"name")=NAME
S ARRAY("component",CNT,"label")=$P(X0,U,2)
S X1=$G(^EDPB(232.72,IEN,1)),X2=$G(^EDPB(232.72,IEN,2)),X3=$G(^EDPB(232.72,IEN,3))
S X6=$G(^EDPB(232.72,IEN,6)),X10=$G(^EDPB(232.72,IEN,10))
S ARRAY("component",CNT,"dataProvider")=$P(X0,U,3)
S ARRAY("component",CNT,"moniker")=$P(X0,U,5)
S ARRAY("component",CNT,"type")=$$GET1^DIQ(232.73,$P(X0,U,6),.01,"E")
S ARRAY("component",CNT,"defaultValue")=$P(X6,U)
S ARRAY("component",CNT,"value")=$P(X10,U)
S ARRAY("component",CNT,"summaryLabel")=$P(X10,U,2)
S ARRAY("component",CNT,"summaryOrder")=$P(X10,U,3)
S ARRAY("component",CNT,"available")=$P(X10,U,3)
S ARRAY("component",CNT,"loadEvent",1,"name")=$P(X1,U,3)
; for now there can be only 1 dependency
S (DEP,DEPCNT)=0 F S DEP=$O(^EDPB(232.72,IEN,7,DEP)) Q:'DEP!(DEPCNT>1) D
.S DEPCNT=DEPCNT+1 Q:DEPCNT>1
.S ARRAY("component",CNT,"dependentOn")=$$GET1^DIQ(232.727,DEP_","_IEN_",",.01,"E")
; get the list of parameters
S PIEN=0 F S PIEN=$O(^EDPB(232.72,IEN,5,PIEN)) Q:'PIEN D
.S P0=$G(^EDPB(232.72,IEN,5,PIEN,0))
.S ARRAY("component",CNT,"param",PIEN,"name")=$P(P0,U)
.S ARRAY("component",CNT,"param",PIEN,"type")=$P(P0,U,2)
.S ARRAY("component",CNT,"param",PIEN,"function")=$P(P0,U,3)
Q
LSTSECTS(AREA,ARRAY,ROLE) ; list sections for an area
N IEN,IEN1,X0,X1,CNT,CMPCNT,CMPNT,RIEN
S IEN=0,CNT=0
F S IEN=$O(^EDPB(232.71,IEN)) Q:'IEN D
.; if role is passed in, and this 'section' doesn't contain the role, quit
.I $G(ROLE) Q:'$D(^EDPB(232.71,IEN,2,"B",ROLE))
.S X0=^EDPB(232.71,IEN,0),CNT=CNT+1
.S ARRAY("section",CNT,"id")=IEN
.S ARRAY("section",CNT,"name")=$P(X0,U)
.S ARRAY("section",CNT,"displayName")=$P(X0,U,4)
.S IEN1=0,CMPCNT=0
.F S IEN1=$O(^EDPB(232.71,IEN,1,IEN1)) Q:'IEN1 D
..S CMPNT=$P(^EDPB(232.71,IEN,1,IEN1,0),U)
..S X1=^EDPB(232.72,CMPNT,0)
..S CMPCNT=CMPCNT+1
..S ARRAY("section",CNT,"component",CMPCNT,"name")=$P(X1,U)
..S ARRAY("section",CNT,"component",CMPCNT,"id")=CMPNT
.; now build the roles into the array
;.S RIEN=0 F S RIEN=$O(^EDPB(232.71,IEN,2,RIEN)) Q:'RIEN D
;..S ARRAY("section",CNT,"role",RIEN,"id")=$P(^EDPB(232.71,IEN,2,RIEN,0),U)
;
; consider moving these calls to prevent jumping 2 subroutines during the calls
; this will require results to be newed in this function and ARRAY to be used
; instead of SECTIONS on the merge. EDPXML will then have to be configured differently.
; It is currently being cofigured in the calling routine.
Q
LSTWKS(EDPSITE,AREA,ARRAY) ; list worksheet configurations for an area
N IEN,CNT,WKSSPEC
S IEN=0,CNT=0
S IEN=0 F S IEN=$O(^EDPB(232.6,"C",EDPSITE,AREA,IEN)) Q:'IEN D
. S CNT=CNT+1
. D GETWKS(EDPSITE,IEN,,.WKSSPEC)
. M ARRAY(CNT)=WKSSPEC
. K WKSSPEC
Q
GETWKS(EDPSITE,WKS,REQ,ARRAY) ;
; if REQ("data") is passed, build component data along with definition
;
N X0,XS,XM,SEQ,SEC,MIEN,I,ROLE,RCNT,CSEQ,COMP,C0,CIEN,CVAL,PNAME,PARVAL,VIEN,V0,PIEN
S X0=$G(^EDPB(232.6,WKS,0)),DATA=$G(DATA,0)
S ARRAY("name")=$P(X0,U),ARRAY("id")=WKS
S ARRAY("institution")=$P(X0,U,2)
S ARRAY("area")=$P(X0,U,3)
S ARRAY("disabled")=$S($P(X0,U,6):"true",1:"false")
S ARRAY("editable")=$S($P(X0,U,7):"true",1:"false")
; build roles associated with this worksheet
S (ROLE,RCNT)=0 F S ROLE=$O(^EDPB(232.6,WKS,3,"B",ROLE)) Q:'ROLE D
.S RCNT=RCNT+1,ARRAY("role",RCNT,"id")=ROLE
; build section information
S SEQ=0 F S SEQ=$O(^EDPB(232.6,WKS,2,"B",SEQ)) Q:'SEQ D
.S SEC=0 F S SEC=$O(^EDPB(232.6,WKS,2,"B",SEQ,SEC)) Q:'SEC D
..S X0=^EDPB(232.6,WKS,2,SEC,0),XS=^EDPB(232.71,$P(X0,U,2),0)
..S ARRAY("section",SEQ,"id")=$P(X0,U,2)
..S ARRAY("section",SEQ,"name")=$P(XS,U)
..S ARRAY("section",SEQ,"displayName")=$P(XS,U,4)
..S ARRAY("section",SEQ,"initialOpen")=$S($P(X0,U,3):"true",1:"false")
..S ARRAY("section",SEQ,"sequence")=$P(X0,U)
..; build component information
..S CSEQ=0 F S CSEQ=$O(^EDPB(232.6,WKS,2,SEC,2,"B",CSEQ)) Q:'CSEQ D
...S COMP=0 F S COMP=$O(^EDPB(232.6,WKS,2,SEC,2,"B",CSEQ,COMP)) Q:'COMP D
....S C0=$G(^EDPB(232.6,WKS,2,SEC,2,COMP,0)),CIEN=$P(C0,U,2)
....S ARRAY("section",SEQ,"component",CSEQ,"id")=CIEN
....S ARRAY("section",SEQ,"component",CSEQ,"name")=$$GET1^DIQ(232.72,CIEN,.01,"E")
....S ARRAY("section",SEQ,"component",CSEQ,"label")=$$GET1^DIQ(232.72,CIEN,.02,"E")
....S ARRAY("section",SEQ,"component",CSEQ,"sequence")=CSEQ
....S ARRAY("section",SEQ,"component",CSEQ,"editable")=$S($P(C0,U,3):"true",1:"false")
....S ARRAY("section",SEQ,"component",CSEQ,"visibilityTrigger")=$$GET1^DIQ(232.72,CIEN,.12,"E")
....S ARRAY("section",SEQ,"component",CSEQ,"includeInSummary")=$S($P(C0,U,5):"true",1:"false")
....S ARRAY("section",SEQ,"component",CSEQ,"dataProvider")=$$GET1^DIQ(232.72,CIEN,.03,"E")
....S ARRAY("section",SEQ,"component",CSEQ,"summaryLabel")=$$GET1^DIQ(232.72,CIEN,.09,"E")
....S ARRAY("section",SEQ,"component",CSEQ,"summaryOrder")=$$GET1^DIQ(232.72,CIEN,.1,"E")
....S ARRAY("section",SEQ,"component",CSEQ,"value")=$$GET1^DIQ(232.72,CIEN,.08,"E")
....S ARRAY("section",SEQ,"component",CSEQ,"type")=$$GET1^DIQ(232.72,CIEN,.06,"E")
....S ARRAY("section",SEQ,"component",CSEQ,"available")=$$GET1^DIQ(232.72,CIEN,.11,"E")
....S ARRAY("section",SEQ,"component",CSEQ,"loadAPI")=$$GET1^DIQ(232.72,CIEN,2.1,"E")
....S ARRAY("section",SEQ,"component",CSEQ,"saveAPI")=$$GET1^DIQ(232.72,CIEN,2.2,"E")
....S ARRAY("section",SEQ,"component",CSEQ,"loadEvent",1,"name")=$$GET1^DIQ(232.72,CIEN,1.3,"E")
....S PIEN=0 F S PIEN=$O(^EDPB(232.72,CIEN,5,PIEN)) Q:'PIEN D
.....; below will be needed for future enhancements
.....;S ARRAY("section",SEQ,"component",CSEQ,"loadEvent",1,"name")=$$GET1^DIQ(232.72,CIEN,1.3,"E")
.....;S ARRAY("section",SEQ,"component",CSEQ,"loadEvent",PIEN,"paramName")=$$GET1^DIQ(232.725,PIEN,.01,"E")
.....;S ARRAY("section",SEQ,"component",CSEQ,"loadEvent",PIEN,"dataType")=$$GET1^DIQ(232.725,PIEN,1,"E")
.....;S ARRAY("section",SEQ,"component",CSEQ,"loadEvent",PIEN,"saveloadType")=$$GET1^DIQ(232.725,PIEN,2,"E")
....S VIEN=0 F S VIEN=$O(^EDPB(232.72,CIEN,9,VIEN)) Q:'VIEN D
.....S V0=$G(^EDPB(232.72,CIEN,9,VIEN,0))
.....S ARRAY("section",SEQ,"component",CSEQ,"validator",VIEN,"type")=$$GET1^DIQ(232.74,$P(V0,U),.01,"E")
.....S ARRAY("section",SEQ,"component",CSEQ,"validator",VIEN,"property")=$P(V0,U,2)
.....S ARRAY("section",SEQ,"component",CSEQ,"validator",VIEN,"maxLength")=$P(V0,U,3)
.....S ARRAY("section",SEQ,"component",CSEQ,"validator",VIEN,"required")=$S($P(V0,U,4)=1:"true",1:"false")
.....S ARRAY("section",SEQ,"component",CSEQ,"validator",VIEN,"minValue")=$P(V0,U,5)
.....S ARRAY("section",SEQ,"component",CSEQ,"validator",VIEN,"lowerThanMinError")=$G(^EDPB(232.72,CIEN,9,VIEN,1))
....; if 'data' is passed in, get the data for the component. Parameters for component must be passed in as well
....; for data to be retrieved.
....I '$$VAL(.REQ,"data") Q
....; below will be needed for future enhancement
....;S COMDATA=$$BLDCDATA(CIEN,.REQ,.ARRAY)
....;S CVAL=$P(COMDATA,U),PNAME=$P(COMDATA,U,2),PARVAL=$P(COMDATA,U,3)
....;S ARRAY("section",SEQ,"component",CSEQ,"dataValue")=CVAL
....;
....;S ARRAY("section",SEQ,"component",CSEQ,"parameterName")=PNAME
....;S ARRAY("section",SEQ,"component",CSEQ,"parameterValue")=PARVAL
....;D BLDCDATA(CIEN,SEQ,CSEQ,.REQ,.ARRAY)
Q
BLDCDATA(IEN,REQ,ARRAY) ;
; IEN - IEN of the component, from file 232.72
; REQ - Parameter list from call in EDPCTRL
; ARRAY - XML ARRAY to continue building XML
N PNAME,PIEN,P0,PDTYPE,LSTYPE,LOADERR,PARVAL,CVAL,PARRAY,RET,C0,C1,CFILE,CFIELD,LALT,LAPI
S RET=""
S C0=$G(^EDPB(232.72,IEN,0))
S C1=$G(^EDPB(232.72,IEN,1))
; get associated file/field
S CFILE=$P(C1,U),CFIELD=$P(C1,U,2)
; build parameter list from component
S LOADERR=0
S PIEN=0 F S PIEN=$O(^EDPB(232.72,IEN,5,PIEN)) Q:'PIEN!(LOADERR) D
.S P0=$G(^EDPB(232.72,IEN,5,PIEN,0))
.; gather name, data type, and load/save type
.S PNAME=$P(P0,U),PDTYPE=$P(P0,U,2),LSTYPE=$P(P0,U,3)
.I PDTYPE="L",'$D(REQ(PNAME)) D LOADERR(.REQ,SEQ,CSEQ,.ARRAY) S LOADERR=1 Q
.S PARVAL=$$VAL(.REQ,PNAME)
.I PARVAL="" D LOADERR(.REQ,SEQ,CSEQ,.ARRAY) S LOADERR=1 Q
.S PARRAY(PNAME)=PARVAL
I $G(LOADERR) S RET="LOAD ERROR" Q RET
S CVAL="" ; initialize to prevent undefined
; if file/field exists, get the 'TYPE' from FIELD^DID and utilize that for the call???
I CFILE,CFIELD D
.S CVAL=$$GET1^DIQ(CFILE,PARVAL,CFIELD,"E")
; if loadapi exists??
;S LAPI=$$GET1^DIQ(CFILE,PARVAL,2.1,"E") I $L(LAPI) D
;.D @LAPI
; if alternate load logic exists??
;S LALT=$$GET1^DIQ(CFILE,PARVAL,2.2,"E") I $L(LALT) D
;.D @LALT
S RET=CVAL_U_PNAME_U_PARVAL
;S ARRAY("section",SEQ,"component",CSEQ,"value")=CVAL
;S ARRAY("section",SEQ,"component",CSEQ,"parameterName")=PNAME
;S ARRAY("section",SEQ,"component",CSEQ,"parameterValue")=PARVAL
Q RET
LOADERR(PARAM,SEQ,CSEQ,ARRAY) ;
S ARRAY("section",SEQ,"component",CSEQ,"error")="Parameter invalid or missing for this component."
Q
; REQ1("param",1)=value
; REQ2("worksheet",counter)=sectionID^Sequence (for section)^InitiallyOpen^componentID^Sequence (for component)^Editable^IncludeInSummary
SAVEWORK(REQ1,REQ2,EDPSITE,AREA) ; save worksheet configuration
N WSID,WSNAME,WSINST,WSAREA,WSTYPE,WSROLES,ROLESTR,I,DONE,FIL,WSIENS,NWSIEN,ROLE,SECIEN,SECID,SECIENS,WSINACT
N ROLE,WSERR,DEL,SECIEN,SECIENS,EDITABLE
S WSID=$$VAL(.REQ1,"id"),WSIENS=$S(WSID>0:WSID_",",1:"+1,")
S DEL=$$VAL(.REQ1,"remove"),DEL=$S(DEL="true":1,1:0)
; if we are deleting the worksheet, do it, then quit
I 'WSID,DEL D WSERR("Missing worksheet ID.") Q
I WSID,'$$GET1^DIQ(232.6,WSID,.07,"I") D WSERR("This is a standard worksheet and is not editable.") Q
I WSID,DEL S FDA(232.6,WSIENS,.01)="@" D FILE^DIE(,"FDA") K FDA Q
S WSNAME=$$VAL(.REQ1,"name") I '$L(WSNAME)!$L(WSNAME)>30 D WSERR("Worksheet name missing or invalid.") Q
I 'WSID,$D(^EDPB(232.6,"B",WSNAME)) D WSERR("Worksheet with this name already exists. Please choose another name and save again.") Q
I 'WSID,WSNAME="" D WSERR("No worksheet ID or NAME was passed to VistA. Can not perform actions on this worksheet") Q
S WSINST=EDPSITE,WSAREA=AREA
S WSTYPE=$$VAL(.REQ1,"type")
S ROLESTR=$$VAL(.REQ1,"role")
S WSINACT=$$VAL(.REQ1,"disabled"),WSINACT=$S(WSINACT="true":1,1:0)
; get the list of roles appropriate for this worksheet
S DONE=0
F I=1:1 D Q:DONE
.S ROLE=$P(ROLESTR,U,I) I 'ROLE S DONE=1 Q
.S WSROLES(ROLE)=""
; setup main worksheet fields
S FIL=232.6 K FDA
D SETFDA(FIL,WSIENS,.01,WSNAME)
D SETFDA(FIL,WSIENS,.02,WSINST)
D SETFDA(FIL,WSIENS,.03,WSAREA)
D SETFDA(FIL,WSIENS,.04,WSTYPE)
D SETFDA(FIL,WSIENS,.06,WSINACT)
; force all worksheets created by a facility to be editable
D SETFDA(FIL,WSIENS,.07,1)
; no id means we are creating a NEW worksheet
I '$G(WSID) D Q
.; add the worksheet to the database
.D UPDATE^DIE(,"FDA","NWSIEN","WSERR") K FDA
.I $D(WSERR) D WSERR("Filing Error") Q
.S WSID=$O(NWSIEN(0)),WSID=$G(NWSIEN(WSID))
.; now add roles to the entry
.S ROLE=0 F S ROLE=$O(WSROLES(ROLE)) Q:'ROLE D
..K FDA
..D SETFDA(232.63,"+1,"_WSID_",",.01,ROLE)
..D UPDATE^DIE(,"FDA",,"WSERR") K FDA
.; now add sections and components
.D SECCOMP(WSID,.REQ2)
; updating a worksheet.
D FILE^DIE(,"FDA") K FDA
; first clear out the sections and components, so we completely rebuild them
S SECIEN=0 F S SECID=$O(^EDPB(232.6,WSID,2,SECIEN)) Q:'SECIEN D
.S SECIENS=SECIEN_","_WSID_","
.S FDA(232.62,SECIENS,.01)="@"
; now we can place the sections and components back in
D SECCOMP(WSID,.REQ2)
Q
SECCOMP(WSID,DATA) ; adds/updates sections and components in a given worksheet
; REQ2("worksheet",counter)=sectionID^Sequence (for section)^InitiallyOpen^componentID^Sequence (for component)^Editable^IncludeInSummary^VisibilityTrigger
N CNT,ARY,SECDATA,SID,CID,COMP,SECT,I,SFIL,CFIL,SUPDERR,SADDERR,PFLD,CID,INITOPEN
N SSEQ,CSEC,SECIEN,SIENS,CIENS,SECTION,SOK,COK,COMPIEN,COMDATA,EDITABLE
N VISIBLE,CVIS,SUMMARY,CSUM
S ARY=$NA(DATA("worksheet"))
S CNT=0 F S CNT=$O(@ARY@(CNT)) Q:'CNT D
.S SECDATA=$G(@ARY@(CNT)) Q:'$L(SECDATA)
.S SID=$P(SECDATA,U),SSEQ=$P(SECDATA,U,2),INITOPEN=$P(SECDATA,U,3),INITOPEN=$S(INITOPEN="true":1,INITOPEN="false":0,1:"")
.S CID=$P(SECDATA,U,4),CSEQ=$P(SECDATA,U,5),EDITABLE=$P(SECDATA,U,6),SUMMARY=$P(SECDATA,U,7),VISIBLE=$P(SECDATA,U,8)
.S EDITABLE=$S(EDITABLE="true":1,EDITABLE="false":0,1:"")
.S SUMMARY=$S(SUMMARY="true":1,SUMMARY="false":0,1:"")
.I CSEQ S COMP(SSEQ,CSEQ)=CID_U_EDITABLE_U_SUMMARY_U_VISIBLE
.I SSEQ,'CSEQ S SECT(SSEQ)=SID_U_INITOPEN
;
; first file the sections
K SECDATA
S SFIL=232.62
S SSEQ=0 F S SSEQ=$O(SECT(SSEQ)) Q:'SSEQ D
.; first check to see if the section already exists in this worksheet
.S SOK=0
.S SECDATA=$G(SECT(SSEQ)),SID=$P(SECDATA,U),INITOPEN=$P(SECDATA,U,2)
.I $D(^EDPB(232.6,WSID,2,"B",SSEQ)) D Q
..S SECIEN=$O(^EDPB(232.6,WSID,2,"B",SSEQ,0)) Q:'SECIEN
..S SIENS=SECIEN_","_WSID_","
..S SOK=$$FILEDAT(SFIL,SIENS,SSEQ,SID,INITOPEN,0)
..I SOK Q
..; process error (OK was returned as -1 (indicating error))
.; build FDA to add a new section
.S SIENS="+1,"_WSID_","
.S SOK=$$FILEDAT(SFIL,SIENS,SSEQ,SID,INITOPEN,1)
;
; now file the components
S CFIL=232.622
S SSEQ=0 F S SSEQ=$O(COMP(SSEQ)) Q:'SSEQ D
.; for some reason this section does not exist (possible filing error)
.I '$D(^EDPB(232.6,WSID,2,"B",SSEQ)) Q
.S SECIEN=$O(^EDPB(232.6,WSID,2,"B",SSEQ,0)) Q:'SECIEN
.S CSEQ=0 F S CSEQ=$O(COMP(SSEQ,CSEQ)) Q:'CSEQ D
..S COK=0
..S COMDATA=$G(COMP(SSEQ,CSEQ)),CID=$P(COMDATA,U),EDITABLE=$P(COMDATA,U,2),CSUM=$P(COMDATA,U,3),CVIS=$P(COMDATA,U,4)
..I $D(^EDPB(232.6,WSID,2,SECIEN,2,"B",CSEQ)) D Q
...S COMPIEN=$O(^EDPB(232.6,WSID,2,SECIEN,2,"B",CSEQ,0)) Q:'COMPIEN
...S CIENS=COMPIEN_","_SECIEN_","_WSID_","
...S COK=$$FILEDAT(CFIL,CIENS,CSEQ,CID,EDITABLE,0,CSUM,CVIS)
..;
..; build FDA for adding a 'new' component to a section
..S CIENS="+1,"_SECIEN_","_WSID_","
..S COK=$$FILEDAT(CFIL,CIENS,CSEQ,CID,EDITABLE,1,CSUM,CVIS)
Q
FILEDAT(FIL,IENS,SEQ,ID,P03,NEW,CSUM,CVIS) ; filer for section and component data
; this can be used for both section and component due to the similarities in the file structures
N ERR,RET
S RET=1
; if deleting a section or component
I ID="@" D Q RET
.D SETFDA(FIL,IENS,.01,"@")
.; lock record
.L +^EDPB(232.6,WSID):3 Q:'$T
.D FILE^DIE(,"FDA") S RET=1
.L -^EDPB(232.6,WSID)
.; unlock record
D SETFDA(FIL,IENS,.01,SEQ)
D SETFDA(FIL,IENS,.02,ID)
D SETFDA(FIL,IENS,.03,P03)
; two additional fields need to be handled for components
I FIL=232.622 D
.D SETFDA(FIL,IENS,.04,CVIS)
.D SETFDA(FIL,IENS,.05,CSUM)
; if this is a new entry, file it, then quit
I $G(NEW) K ERR D UPDATE^DIE(,"FDA",,"ERR") K FDA S RET=$S($D(ERR):-1,1:1) Q RET
; if this is meant to update an entry, lock, update, unlock
; lock
L +^EDPB(232.6,WSID):3 Q:'$T 0
D FILE^DIE(,"FDA","ERR")
L -^EDPB(232.6,WSID)
; unlock
I $D(ERR) S RET=-1
Q RET
SETFDA(F,IENS,FD,VAL) ;
S FDA(F,IENS,FD)=VAL
Q
WSERR(ERRTXT) ;
D XML^EDPX("<error>")
D XML^EDPX($G(ERRTXT))
D XML^EDPX("</error>")
Q
VAL(ARRY,ITEM) ;return value from array, given ARRY (array name), and ITEM (subscript)
I $D(ARRY(ITEM)),$G(ARRY(ITEM))'="" Q $G(ARRY(ITEM))
Q $G(ARRY(ITEM,1))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPBWS 19095 printed Dec 13, 2024@01:51:39 Page 2
EDPBWS ;SLC/KCM - Worksheet Configuration Calls ;7/27/12 4:22pm
+1 ;;2.0;EMERGENCY DEPARTMENT;**6,7**;Feb 24, 2012;Build 18
+2 ;
+3 ;DBIA SECTION
+4 ;2053 - FILE^DIE,UPDATE^DIE
+5 ;2056 - $$GET1^DIQ
+6 ;
LOADALL(EDPSITE,AREA,EDPROLE) ; load all worksheet configurations for an area
+1 NEW ROLES,SECTIONS,WORKSHTS,COMPNTS,RESULTS
+2 ;D LSTROLES(AREA,.ROLES) M RESULTS("roles",1)=ROLES
+3 ;D LSTROLES(.ROLES) M RESULTS("roles",1)=ROLES
+4 ;D LSTCMPTS(AREA,.COMPNTS) M RESULTS("components")=COMPNTS
+5 ;D LSTSECTS(AREA,.SECTIONS) M RESULTS("sections",1)=SECTIONS
+6 DO LSTWKS(EDPSITE,AREA,.WORKSHTS)
MERGE RESULTS("worksheets")=WORKSHTS
+7 DO TOXML^EDPXML(.RESULTS,.EDPXML)
+8 QUIT
GETROLES(EDPSITE,AREA) ; get list of roles
+1 NEW ROLES
+2 DO XML^EDPX("<roles>")
+3 DO LSTROLES(AREA,.ROLES)
+4 DO XML^EDPX("</roles>")
+5 QUIT
GETSECTS(AREA,EDPXML,ROLE) ; get list of sections
+1 NEW RESULTS,SECTIONS
+2 DO LSTSECTS(AREA,.SECTIONS,ROLE)
MERGE RESULTS("sections",1)=SECTIONS
+3 DO TOXML^EDPXML(.RESULTS,.EDPXML)
+4 QUIT
GETCMPTS(AREA,EDPXML,IEN,ROLE) ; get list of components
+1 NEW RESULTS,COMPNTS
+2 SET IEN=$GET(IEN,"")
+3 DO LSTCMPTS(AREA,.COMPNTS,IEN,ROLE)
MERGE RESULTS("components",1)=COMPNTS
+4 DO TOXML^EDPXML(.RESULTS,.EDPXML)
+5 QUIT
GETWORKS(EDPSITE,IEN,REQ,EDPXML) ; get worksheet given IEN
+1 NEW WKSSPEC,RESULTS
+2 DO GETWKS(EDPSITE,IEN,.REQ,.WKSSPEC)
MERGE RESULTS("worksheet",IEN)=WKSSPEC
+3 DO TOXML^EDPXML(.RESULTS,.EDPXML)
+4 QUIT
LDWSLIST(EDPSITE,AREA,ROLE) ; load brief worksheet list
+1 ; ROLE (optional) - If no role is passed, all worksheets for an AREA/SITE will be returned.
+2 NEW WSIEN,X0,X,WSNAME,RIEN,TYPE,WSLIST
+3 DO XML^EDPX("<worksheets>")
+4 SET RIEN=0
FOR
SET RIEN=$ORDER(^EDPB(232.6,"D",RIEN))
if 'RIEN
QUIT
Begin DoDot:1
+5 ; quit if this is not the role we are looking for
+6 IF $GET(ROLE)
if RIEN'=ROLE
QUIT
+7 DO XML^EDPX("<role id="_""""_RIEN_""""_" >")
+8 SET WSIEN=0
FOR
SET WSIEN=$ORDER(^EDPB(232.6,"D",RIEN,WSIEN))
if 'WSIEN
QUIT
Begin DoDot:2
+9 if $GET(WSLIST(WSIEN))
QUIT
+10 ;Don't send the same list twice
SET WSLIST(WSIEN)=1
+11 SET X0=$GET(^EDPB(232.6,WSIEN,0))
+12 SET WSNAME=$PIECE(X0,U)
SET TYPE=$PIECE(X0,U,4)
+13 SET X("id")=WSIEN
SET X("worksheetName")=WSNAME
SET X("type")=TYPE
+14 SET X("name")=$PIECE(X0,U)
SET X("id")=WSIEN
+15 SET X("institution")=$PIECE(X0,U,2)
+16 SET X("area")=$PIECE(X0,U,3)
+17 SET X("disabled")=$SELECT($PIECE(X0,U,6):"true",1:"false")
+18 SET X("editable")=$SELECT($PIECE(X0,U,7):"true",1:"false")
+19 IF $$GET1^DIQ(232.5,RIEN,.06,"I")=WSIEN
SET X("default")="true"
+20 DO XML^EDPX($$XMLA^EDPX("worksheet",.X))
KILL X
End DoDot:2
+21 DO XML^EDPX("</role>")
End DoDot:1
+22 DO XML^EDPX("</worksheets>")
+23 QUIT
LSTROLES(AREA,ARRAY) ; list roles for an area
+1 NEW RIEN,X0,ROLEIEN,ROLENM,WKS,CNT,EDAC,RABBR
+2 SET CNT=0
+3 SET RABBR=""
FOR
SET RABBR=$ORDER(^EDPB(232.5,"C",RABBR))
if RABBR=""
QUIT
Begin DoDot:1
+4 SET RIEN=""
FOR
SET RIEN=$ORDER(^EDPB(232.5,"C",RABBR,RIEN))
if 'RIEN
QUIT
Begin DoDot:2
+5 SET CNT=CNT+1
+6 SET X0=$GET(^EDPB(232.5,RIEN,0))
SET ROLENM=$PIECE(X0,U)
SET WKS=$PIECE(X0,U,4)
SET EDAC=$PIECE(X0,U,6)
+7 SET X("id")=RIEN
+8 SET X("abbr")=RABBR
+9 SET X("displayName")=ROLENM
+10 SET X("defaultWorksheet")=WKS
+11 SET X("editAcuity")=$SELECT(+EDAC:"true",1:"false")
+12 DO XML^EDPX($$XMLA^EDPX("role",.X))
End DoDot:2
End DoDot:1
+13 QUIT
LSTCMPTS(AREA,ARRAY,IEN,ROLE) ; list components for an area
+1 NEW CNT
+2 IF $GET(IEN)
DO BLDCMPTS(IEN,1,1,.ARRAY)
QUIT
+3 SET IEN=0
FOR
SET IEN=$ORDER(^EDPB(232.72,IEN))
if 'IEN
QUIT
Begin DoDot:1
+4 IF $GET(ROLE)
if '$DATA(^EDPB(232.72,IEN,8,"B",ROLE))
QUIT
+5 SET CNT=$GET(CNT)+1
+6 DO BLDCMPTS(IEN,CNT,,.ARRAY)
End DoDot:1
+7 QUIT
BLDCMPTS(IEN,CNT,MOREDAT,ARRAY) ;
+1 ; IEN - component IEN
+2 ; CNT - simple counter
+3 ; MOREDAT - If MOREDAT is passed, return more information
+4 ; This is used to differentiate between a 'list'
+5 ; style of call, versus a full 'get' on a specific entry
+6 ;
+7 NEW NAME,X0,X1,X2,X3,X6,PIEN,P0,RCNT,RIEN,ROLE,V0,X10,DEP,DEPCNT
+8 SET X0=$GET(^EDPB(232.72,IEN,0))
SET NAME=$PIECE(X0,U)
+9 SET MOREDAT=$GET(MOREDAT,0)
+10 SET ARRAY("component",CNT,"id")=IEN
+11 SET ARRAY("component",CNT,"name")=NAME
+12 SET ARRAY("component",CNT,"label")=$PIECE(X0,U,2)
+13 SET X1=$GET(^EDPB(232.72,IEN,1))
SET X2=$GET(^EDPB(232.72,IEN,2))
SET X3=$GET(^EDPB(232.72,IEN,3))
+14 SET X6=$GET(^EDPB(232.72,IEN,6))
SET X10=$GET(^EDPB(232.72,IEN,10))
+15 SET ARRAY("component",CNT,"dataProvider")=$PIECE(X0,U,3)
+16 SET ARRAY("component",CNT,"moniker")=$PIECE(X0,U,5)
+17 SET ARRAY("component",CNT,"type")=$$GET1^DIQ(232.73,$PIECE(X0,U,6),.01,"E")
+18 SET ARRAY("component",CNT,"defaultValue")=$PIECE(X6,U)
+19 SET ARRAY("component",CNT,"value")=$PIECE(X10,U)
+20 SET ARRAY("component",CNT,"summaryLabel")=$PIECE(X10,U,2)
+21 SET ARRAY("component",CNT,"summaryOrder")=$PIECE(X10,U,3)
+22 SET ARRAY("component",CNT,"available")=$PIECE(X10,U,3)
+23 SET ARRAY("component",CNT,"loadEvent",1,"name")=$PIECE(X1,U,3)
+24 ; for now there can be only 1 dependency
+25 SET (DEP,DEPCNT)=0
FOR
SET DEP=$ORDER(^EDPB(232.72,IEN,7,DEP))
if 'DEP!(DEPCNT>1)
QUIT
Begin DoDot:1
+26 SET DEPCNT=DEPCNT+1
if DEPCNT>1
QUIT
+27 SET ARRAY("component",CNT,"dependentOn")=$$GET1^DIQ(232.727,DEP_","_IEN_",",.01,"E")
End DoDot:1
+28 ; get the list of parameters
+29 SET PIEN=0
FOR
SET PIEN=$ORDER(^EDPB(232.72,IEN,5,PIEN))
if 'PIEN
QUIT
Begin DoDot:1
+30 SET P0=$GET(^EDPB(232.72,IEN,5,PIEN,0))
+31 SET ARRAY("component",CNT,"param",PIEN,"name")=$PIECE(P0,U)
+32 SET ARRAY("component",CNT,"param",PIEN,"type")=$PIECE(P0,U,2)
+33 SET ARRAY("component",CNT,"param",PIEN,"function")=$PIECE(P0,U,3)
End DoDot:1
+34 QUIT
LSTSECTS(AREA,ARRAY,ROLE) ; list sections for an area
+1 NEW IEN,IEN1,X0,X1,CNT,CMPCNT,CMPNT,RIEN
+2 SET IEN=0
SET CNT=0
+3 FOR
SET IEN=$ORDER(^EDPB(232.71,IEN))
if 'IEN
QUIT
Begin DoDot:1
+4 ; if role is passed in, and this 'section' doesn't contain the role, quit
+5 IF $GET(ROLE)
if '$DATA(^EDPB(232.71,IEN,2,"B",ROLE))
QUIT
+6 SET X0=^EDPB(232.71,IEN,0)
SET CNT=CNT+1
+7 SET ARRAY("section",CNT,"id")=IEN
+8 SET ARRAY("section",CNT,"name")=$PIECE(X0,U)
+9 SET ARRAY("section",CNT,"displayName")=$PIECE(X0,U,4)
+10 SET IEN1=0
SET CMPCNT=0
+11 FOR
SET IEN1=$ORDER(^EDPB(232.71,IEN,1,IEN1))
if 'IEN1
QUIT
Begin DoDot:2
+12 SET CMPNT=$PIECE(^EDPB(232.71,IEN,1,IEN1,0),U)
+13 SET X1=^EDPB(232.72,CMPNT,0)
+14 SET CMPCNT=CMPCNT+1
+15 SET ARRAY("section",CNT,"component",CMPCNT,"name")=$PIECE(X1,U)
+16 SET ARRAY("section",CNT,"component",CMPCNT,"id")=CMPNT
End DoDot:2
+17 ; now build the roles into the array
End DoDot:1
+18 ;.S RIEN=0 F S RIEN=$O(^EDPB(232.71,IEN,2,RIEN)) Q:'RIEN D
+19 ;..S ARRAY("section",CNT,"role",RIEN,"id")=$P(^EDPB(232.71,IEN,2,RIEN,0),U)
+20 ;
+21 ; consider moving these calls to prevent jumping 2 subroutines during the calls
+22 ; this will require results to be newed in this function and ARRAY to be used
+23 ; instead of SECTIONS on the merge. EDPXML will then have to be configured differently.
+24 ; It is currently being cofigured in the calling routine.
+25 QUIT
LSTWKS(EDPSITE,AREA,ARRAY) ; list worksheet configurations for an area
+1 NEW IEN,CNT,WKSSPEC
+2 SET IEN=0
SET CNT=0
+3 SET IEN=0
FOR
SET IEN=$ORDER(^EDPB(232.6,"C",EDPSITE,AREA,IEN))
if 'IEN
QUIT
Begin DoDot:1
+4 SET CNT=CNT+1
+5 DO GETWKS(EDPSITE,IEN,,.WKSSPEC)
+6 MERGE ARRAY(CNT)=WKSSPEC
+7 KILL WKSSPEC
End DoDot:1
+8 QUIT
GETWKS(EDPSITE,WKS,REQ,ARRAY) ;
+1 ; if REQ("data") is passed, build component data along with definition
+2 ;
+3 NEW X0,XS,XM,SEQ,SEC,MIEN,I,ROLE,RCNT,CSEQ,COMP,C0,CIEN,CVAL,PNAME,PARVAL,VIEN,V0,PIEN
+4 SET X0=$GET(^EDPB(232.6,WKS,0))
SET DATA=$GET(DATA,0)
+5 SET ARRAY("name")=$PIECE(X0,U)
SET ARRAY("id")=WKS
+6 SET ARRAY("institution")=$PIECE(X0,U,2)
+7 SET ARRAY("area")=$PIECE(X0,U,3)
+8 SET ARRAY("disabled")=$SELECT($PIECE(X0,U,6):"true",1:"false")
+9 SET ARRAY("editable")=$SELECT($PIECE(X0,U,7):"true",1:"false")
+10 ; build roles associated with this worksheet
+11 SET (ROLE,RCNT)=0
FOR
SET ROLE=$ORDER(^EDPB(232.6,WKS,3,"B",ROLE))
if 'ROLE
QUIT
Begin DoDot:1
+12 SET RCNT=RCNT+1
SET ARRAY("role",RCNT,"id")=ROLE
End DoDot:1
+13 ; build section information
+14 SET SEQ=0
FOR
SET SEQ=$ORDER(^EDPB(232.6,WKS,2,"B",SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+15 SET SEC=0
FOR
SET SEC=$ORDER(^EDPB(232.6,WKS,2,"B",SEQ,SEC))
if 'SEC
QUIT
Begin DoDot:2
+16 SET X0=^EDPB(232.6,WKS,2,SEC,0)
SET XS=^EDPB(232.71,$PIECE(X0,U,2),0)
+17 SET ARRAY("section",SEQ,"id")=$PIECE(X0,U,2)
+18 SET ARRAY("section",SEQ,"name")=$PIECE(XS,U)
+19 SET ARRAY("section",SEQ,"displayName")=$PIECE(XS,U,4)
+20 SET ARRAY("section",SEQ,"initialOpen")=$SELECT($PIECE(X0,U,3):"true",1:"false")
+21 SET ARRAY("section",SEQ,"sequence")=$PIECE(X0,U)
+22 ; build component information
+23 SET CSEQ=0
FOR
SET CSEQ=$ORDER(^EDPB(232.6,WKS,2,SEC,2,"B",CSEQ))
if 'CSEQ
QUIT
Begin DoDot:3
+24 SET COMP=0
FOR
SET COMP=$ORDER(^EDPB(232.6,WKS,2,SEC,2,"B",CSEQ,COMP))
if 'COMP
QUIT
Begin DoDot:4
+25 SET C0=$GET(^EDPB(232.6,WKS,2,SEC,2,COMP,0))
SET CIEN=$PIECE(C0,U,2)
+26 SET ARRAY("section",SEQ,"component",CSEQ,"id")=CIEN
+27 SET ARRAY("section",SEQ,"component",CSEQ,"name")=$$GET1^DIQ(232.72,CIEN,.01,"E")
+28 SET ARRAY("section",SEQ,"component",CSEQ,"label")=$$GET1^DIQ(232.72,CIEN,.02,"E")
+29 SET ARRAY("section",SEQ,"component",CSEQ,"sequence")=CSEQ
+30 SET ARRAY("section",SEQ,"component",CSEQ,"editable")=$SELECT($PIECE(C0,U,3):"true",1:"false")
+31 SET ARRAY("section",SEQ,"component",CSEQ,"visibilityTrigger")=$$GET1^DIQ(232.72,CIEN,.12,"E")
+32 SET ARRAY("section",SEQ,"component",CSEQ,"includeInSummary")=$SELECT($PIECE(C0,U,5):"true",1:"false")
+33 SET ARRAY("section",SEQ,"component",CSEQ,"dataProvider")=$$GET1^DIQ(232.72,CIEN,.03,"E")
+34 SET ARRAY("section",SEQ,"component",CSEQ,"summaryLabel")=$$GET1^DIQ(232.72,CIEN,.09,"E")
+35 SET ARRAY("section",SEQ,"component",CSEQ,"summaryOrder")=$$GET1^DIQ(232.72,CIEN,.1,"E")
+36 SET ARRAY("section",SEQ,"component",CSEQ,"value")=$$GET1^DIQ(232.72,CIEN,.08,"E")
+37 SET ARRAY("section",SEQ,"component",CSEQ,"type")=$$GET1^DIQ(232.72,CIEN,.06,"E")
+38 SET ARRAY("section",SEQ,"component",CSEQ,"available")=$$GET1^DIQ(232.72,CIEN,.11,"E")
+39 SET ARRAY("section",SEQ,"component",CSEQ,"loadAPI")=$$GET1^DIQ(232.72,CIEN,2.1,"E")
+40 SET ARRAY("section",SEQ,"component",CSEQ,"saveAPI")=$$GET1^DIQ(232.72,CIEN,2.2,"E")
+41 SET ARRAY("section",SEQ,"component",CSEQ,"loadEvent",1,"name")=$$GET1^DIQ(232.72,CIEN,1.3,"E")
+42 SET PIEN=0
FOR
SET PIEN=$ORDER(^EDPB(232.72,CIEN,5,PIEN))
if 'PIEN
QUIT
Begin DoDot:5
+43 ; below will be needed for future enhancements
+44 ;S ARRAY("section",SEQ,"component",CSEQ,"loadEvent",1,"name")=$$GET1^DIQ(232.72,CIEN,1.3,"E")
+45 ;S ARRAY("section",SEQ,"component",CSEQ,"loadEvent",PIEN,"paramName")=$$GET1^DIQ(232.725,PIEN,.01,"E")
+46 ;S ARRAY("section",SEQ,"component",CSEQ,"loadEvent",PIEN,"dataType")=$$GET1^DIQ(232.725,PIEN,1,"E")
+47 ;S ARRAY("section",SEQ,"component",CSEQ,"loadEvent",PIEN,"saveloadType")=$$GET1^DIQ(232.725,PIEN,2,"E")
End DoDot:5
+48 SET VIEN=0
FOR
SET VIEN=$ORDER(^EDPB(232.72,CIEN,9,VIEN))
if 'VIEN
QUIT
Begin DoDot:5
+49 SET V0=$GET(^EDPB(232.72,CIEN,9,VIEN,0))
+50 SET ARRAY("section",SEQ,"component",CSEQ,"validator",VIEN,"type")=$$GET1^DIQ(232.74,$PIECE(V0,U),.01,"E")
+51 SET ARRAY("section",SEQ,"component",CSEQ,"validator",VIEN,"property")=$PIECE(V0,U,2)
+52 SET ARRAY("section",SEQ,"component",CSEQ,"validator",VIEN,"maxLength")=$PIECE(V0,U,3)
+53 SET ARRAY("section",SEQ,"component",CSEQ,"validator",VIEN,"required")=$SELECT($PIECE(V0,U,4)=1:"true",1:"false")
+54 SET ARRAY("section",SEQ,"component",CSEQ,"validator",VIEN,"minValue")=$PIECE(V0,U,5)
+55 SET ARRAY("section",SEQ,"component",CSEQ,"validator",VIEN,"lowerThanMinError")=$GET(^EDPB(232.72,CIEN,9,VIEN,1))
End DoDot:5
+56 ; if 'data' is passed in, get the data for the component. Parameters for component must be passed in as well
+57 ; for data to be retrieved.
+58 IF '$$VAL(.REQ,"data")
QUIT
+59 ; below will be needed for future enhancement
+60 ;S COMDATA=$$BLDCDATA(CIEN,.REQ,.ARRAY)
+61 ;S CVAL=$P(COMDATA,U),PNAME=$P(COMDATA,U,2),PARVAL=$P(COMDATA,U,3)
+62 ;S ARRAY("section",SEQ,"component",CSEQ,"dataValue")=CVAL
+63 ;
+64 ;S ARRAY("section",SEQ,"component",CSEQ,"parameterName")=PNAME
+65 ;S ARRAY("section",SEQ,"component",CSEQ,"parameterValue")=PARVAL
+66 ;D BLDCDATA(CIEN,SEQ,CSEQ,.REQ,.ARRAY)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+67 QUIT
BLDCDATA(IEN,REQ,ARRAY) ;
+1 ; IEN - IEN of the component, from file 232.72
+2 ; REQ - Parameter list from call in EDPCTRL
+3 ; ARRAY - XML ARRAY to continue building XML
+4 NEW PNAME,PIEN,P0,PDTYPE,LSTYPE,LOADERR,PARVAL,CVAL,PARRAY,RET,C0,C1,CFILE,CFIELD,LALT,LAPI
+5 SET RET=""
+6 SET C0=$GET(^EDPB(232.72,IEN,0))
+7 SET C1=$GET(^EDPB(232.72,IEN,1))
+8 ; get associated file/field
+9 SET CFILE=$PIECE(C1,U)
SET CFIELD=$PIECE(C1,U,2)
+10 ; build parameter list from component
+11 SET LOADERR=0
+12 SET PIEN=0
FOR
SET PIEN=$ORDER(^EDPB(232.72,IEN,5,PIEN))
if 'PIEN!(LOADERR)
QUIT
Begin DoDot:1
+13 SET P0=$GET(^EDPB(232.72,IEN,5,PIEN,0))
+14 ; gather name, data type, and load/save type
+15 SET PNAME=$PIECE(P0,U)
SET PDTYPE=$PIECE(P0,U,2)
SET LSTYPE=$PIECE(P0,U,3)
+16 IF PDTYPE="L"
IF '$DATA(REQ(PNAME))
DO LOADERR(.REQ,SEQ,CSEQ,.ARRAY)
SET LOADERR=1
QUIT
+17 SET PARVAL=$$VAL(.REQ,PNAME)
+18 IF PARVAL=""
DO LOADERR(.REQ,SEQ,CSEQ,.ARRAY)
SET LOADERR=1
QUIT
+19 SET PARRAY(PNAME)=PARVAL
End DoDot:1
+20 IF $GET(LOADERR)
SET RET="LOAD ERROR"
QUIT RET
+21 ; initialize to prevent undefined
SET CVAL=""
+22 ; if file/field exists, get the 'TYPE' from FIELD^DID and utilize that for the call???
+23 IF CFILE
IF CFIELD
Begin DoDot:1
+24 SET CVAL=$$GET1^DIQ(CFILE,PARVAL,CFIELD,"E")
End DoDot:1
+25 ; if loadapi exists??
+26 ;S LAPI=$$GET1^DIQ(CFILE,PARVAL,2.1,"E") I $L(LAPI) D
+27 ;.D @LAPI
+28 ; if alternate load logic exists??
+29 ;S LALT=$$GET1^DIQ(CFILE,PARVAL,2.2,"E") I $L(LALT) D
+30 ;.D @LALT
+31 SET RET=CVAL_U_PNAME_U_PARVAL
+32 ;S ARRAY("section",SEQ,"component",CSEQ,"value")=CVAL
+33 ;S ARRAY("section",SEQ,"component",CSEQ,"parameterName")=PNAME
+34 ;S ARRAY("section",SEQ,"component",CSEQ,"parameterValue")=PARVAL
+35 QUIT RET
LOADERR(PARAM,SEQ,CSEQ,ARRAY) ;
+1 SET ARRAY("section",SEQ,"component",CSEQ,"error")="Parameter invalid or missing for this component."
+2 QUIT
+3 ; REQ1("param",1)=value
+4 ; REQ2("worksheet",counter)=sectionID^Sequence (for section)^InitiallyOpen^componentID^Sequence (for component)^Editable^IncludeInSummary
SAVEWORK(REQ1,REQ2,EDPSITE,AREA) ; save worksheet configuration
+1 NEW WSID,WSNAME,WSINST,WSAREA,WSTYPE,WSROLES,ROLESTR,I,DONE,FIL,WSIENS,NWSIEN,ROLE,SECIEN,SECID,SECIENS,WSINACT
+2 NEW ROLE,WSERR,DEL,SECIEN,SECIENS,EDITABLE
+3 SET WSID=$$VAL(.REQ1,"id")
SET WSIENS=$SELECT(WSID>0:WSID_",",1:"+1,")
+4 SET DEL=$$VAL(.REQ1,"remove")
SET DEL=$SELECT(DEL="true":1,1:0)
+5 ; if we are deleting the worksheet, do it, then quit
+6 IF 'WSID
IF DEL
DO WSERR("Missing worksheet ID.")
QUIT
+7 IF WSID
IF '$$GET1^DIQ(232.6,WSID,.07,"I")
DO WSERR("This is a standard worksheet and is not editable.")
QUIT
+8 IF WSID
IF DEL
SET FDA(232.6,WSIENS,.01)="@"
DO FILE^DIE(,"FDA")
KILL FDA
QUIT
+9 SET WSNAME=$$VAL(.REQ1,"name")
IF '$LENGTH(WSNAME)!$LENGTH(WSNAME)>30
DO WSERR("Worksheet name missing or invalid.")
QUIT
+10 IF 'WSID
IF $DATA(^EDPB(232.6,"B",WSNAME))
DO WSERR("Worksheet with this name already exists. Please choose another name and save again.")
QUIT
+11 IF 'WSID
IF WSNAME=""
DO WSERR("No worksheet ID or NAME was passed to VistA. Can not perform actions on this worksheet")
QUIT
+12 SET WSINST=EDPSITE
SET WSAREA=AREA
+13 SET WSTYPE=$$VAL(.REQ1,"type")
+14 SET ROLESTR=$$VAL(.REQ1,"role")
+15 SET WSINACT=$$VAL(.REQ1,"disabled")
SET WSINACT=$SELECT(WSINACT="true":1,1:0)
+16 ; get the list of roles appropriate for this worksheet
+17 SET DONE=0
+18 FOR I=1:1
Begin DoDot:1
+19 SET ROLE=$PIECE(ROLESTR,U,I)
IF 'ROLE
SET DONE=1
QUIT
+20 SET WSROLES(ROLE)=""
End DoDot:1
if DONE
QUIT
+21 ; setup main worksheet fields
+22 SET FIL=232.6
KILL FDA
+23 DO SETFDA(FIL,WSIENS,.01,WSNAME)
+24 DO SETFDA(FIL,WSIENS,.02,WSINST)
+25 DO SETFDA(FIL,WSIENS,.03,WSAREA)
+26 DO SETFDA(FIL,WSIENS,.04,WSTYPE)
+27 DO SETFDA(FIL,WSIENS,.06,WSINACT)
+28 ; force all worksheets created by a facility to be editable
+29 DO SETFDA(FIL,WSIENS,.07,1)
+30 ; no id means we are creating a NEW worksheet
+31 IF '$GET(WSID)
Begin DoDot:1
+32 ; add the worksheet to the database
+33 DO UPDATE^DIE(,"FDA","NWSIEN","WSERR")
KILL FDA
+34 IF $DATA(WSERR)
DO WSERR("Filing Error")
QUIT
+35 SET WSID=$ORDER(NWSIEN(0))
SET WSID=$GET(NWSIEN(WSID))
+36 ; now add roles to the entry
+37 SET ROLE=0
FOR
SET ROLE=$ORDER(WSROLES(ROLE))
if 'ROLE
QUIT
Begin DoDot:2
+38 KILL FDA
+39 DO SETFDA(232.63,"+1,"_WSID_",",.01,ROLE)
+40 DO UPDATE^DIE(,"FDA",,"WSERR")
KILL FDA
End DoDot:2
+41 ; now add sections and components
+42 DO SECCOMP(WSID,.REQ2)
End DoDot:1
QUIT
+43 ; updating a worksheet.
+44 DO FILE^DIE(,"FDA")
KILL FDA
+45 ; first clear out the sections and components, so we completely rebuild them
+46 SET SECIEN=0
FOR
SET SECID=$ORDER(^EDPB(232.6,WSID,2,SECIEN))
if 'SECIEN
QUIT
Begin DoDot:1
+47 SET SECIENS=SECIEN_","_WSID_","
+48 SET FDA(232.62,SECIENS,.01)="@"
End DoDot:1
+49 ; now we can place the sections and components back in
+50 DO SECCOMP(WSID,.REQ2)
+51 QUIT
SECCOMP(WSID,DATA) ; adds/updates sections and components in a given worksheet
+1 ; REQ2("worksheet",counter)=sectionID^Sequence (for section)^InitiallyOpen^componentID^Sequence (for component)^Editable^IncludeInSummary^VisibilityTrigger
+2 NEW CNT,ARY,SECDATA,SID,CID,COMP,SECT,I,SFIL,CFIL,SUPDERR,SADDERR,PFLD,CID,INITOPEN
+3 NEW SSEQ,CSEC,SECIEN,SIENS,CIENS,SECTION,SOK,COK,COMPIEN,COMDATA,EDITABLE
+4 NEW VISIBLE,CVIS,SUMMARY,CSUM
+5 SET ARY=$NAME(DATA("worksheet"))
+6 SET CNT=0
FOR
SET CNT=$ORDER(@ARY@(CNT))
if 'CNT
QUIT
Begin DoDot:1
+7 SET SECDATA=$GET(@ARY@(CNT))
if '$LENGTH(SECDATA)
QUIT
+8 SET SID=$PIECE(SECDATA,U)
SET SSEQ=$PIECE(SECDATA,U,2)
SET INITOPEN=$PIECE(SECDATA,U,3)
SET INITOPEN=$SELECT(INITOPEN="true":1,INITOPEN="false":0,1:"")
+9 SET CID=$PIECE(SECDATA,U,4)
SET CSEQ=$PIECE(SECDATA,U,5)
SET EDITABLE=$PIECE(SECDATA,U,6)
SET SUMMARY=$PIECE(SECDATA,U,7)
SET VISIBLE=$PIECE(SECDATA,U,8)
+10 SET EDITABLE=$SELECT(EDITABLE="true":1,EDITABLE="false":0,1:"")
+11 SET SUMMARY=$SELECT(SUMMARY="true":1,SUMMARY="false":0,1:"")
+12 IF CSEQ
SET COMP(SSEQ,CSEQ)=CID_U_EDITABLE_U_SUMMARY_U_VISIBLE
+13 IF SSEQ
IF 'CSEQ
SET SECT(SSEQ)=SID_U_INITOPEN
End DoDot:1
+14 ;
+15 ; first file the sections
+16 KILL SECDATA
+17 SET SFIL=232.62
+18 SET SSEQ=0
FOR
SET SSEQ=$ORDER(SECT(SSEQ))
if 'SSEQ
QUIT
Begin DoDot:1
+19 ; first check to see if the section already exists in this worksheet
+20 SET SOK=0
+21 SET SECDATA=$GET(SECT(SSEQ))
SET SID=$PIECE(SECDATA,U)
SET INITOPEN=$PIECE(SECDATA,U,2)
+22 IF $DATA(^EDPB(232.6,WSID,2,"B",SSEQ))
Begin DoDot:2
+23 SET SECIEN=$ORDER(^EDPB(232.6,WSID,2,"B",SSEQ,0))
if 'SECIEN
QUIT
+24 SET SIENS=SECIEN_","_WSID_","
+25 SET SOK=$$FILEDAT(SFIL,SIENS,SSEQ,SID,INITOPEN,0)
+26 IF SOK
QUIT
+27 ; process error (OK was returned as -1 (indicating error))
End DoDot:2
QUIT
+28 ; build FDA to add a new section
+29 SET SIENS="+1,"_WSID_","
+30 SET SOK=$$FILEDAT(SFIL,SIENS,SSEQ,SID,INITOPEN,1)
End DoDot:1
+31 ;
+32 ; now file the components
+33 SET CFIL=232.622
+34 SET SSEQ=0
FOR
SET SSEQ=$ORDER(COMP(SSEQ))
if 'SSEQ
QUIT
Begin DoDot:1
+35 ; for some reason this section does not exist (possible filing error)
+36 IF '$DATA(^EDPB(232.6,WSID,2,"B",SSEQ))
QUIT
+37 SET SECIEN=$ORDER(^EDPB(232.6,WSID,2,"B",SSEQ,0))
if 'SECIEN
QUIT
+38 SET CSEQ=0
FOR
SET CSEQ=$ORDER(COMP(SSEQ,CSEQ))
if 'CSEQ
QUIT
Begin DoDot:2
+39 SET COK=0
+40 SET COMDATA=$GET(COMP(SSEQ,CSEQ))
SET CID=$PIECE(COMDATA,U)
SET EDITABLE=$PIECE(COMDATA,U,2)
SET CSUM=$PIECE(COMDATA,U,3)
SET CVIS=$PIECE(COMDATA,U,4)
+41 IF $DATA(^EDPB(232.6,WSID,2,SECIEN,2,"B",CSEQ))
Begin DoDot:3
+42 SET COMPIEN=$ORDER(^EDPB(232.6,WSID,2,SECIEN,2,"B",CSEQ,0))
if 'COMPIEN
QUIT
+43 SET CIENS=COMPIEN_","_SECIEN_","_WSID_","
+44 SET COK=$$FILEDAT(CFIL,CIENS,CSEQ,CID,EDITABLE,0,CSUM,CVIS)
End DoDot:3
QUIT
+45 ;
+46 ; build FDA for adding a 'new' component to a section
+47 SET CIENS="+1,"_SECIEN_","_WSID_","
+48 SET COK=$$FILEDAT(CFIL,CIENS,CSEQ,CID,EDITABLE,1,CSUM,CVIS)
End DoDot:2
End DoDot:1
+49 QUIT
FILEDAT(FIL,IENS,SEQ,ID,P03,NEW,CSUM,CVIS) ; filer for section and component data
+1 ; this can be used for both section and component due to the similarities in the file structures
+2 NEW ERR,RET
+3 SET RET=1
+4 ; if deleting a section or component
+5 IF ID="@"
Begin DoDot:1
+6 DO SETFDA(FIL,IENS,.01,"@")
+7 ; lock record
+8 LOCK +^EDPB(232.6,WSID):3
if '$TEST
QUIT
+9 DO FILE^DIE(,"FDA")
SET RET=1
+10 LOCK -^EDPB(232.6,WSID)
+11 ; unlock record
End DoDot:1
QUIT RET
+12 DO SETFDA(FIL,IENS,.01,SEQ)
+13 DO SETFDA(FIL,IENS,.02,ID)
+14 DO SETFDA(FIL,IENS,.03,P03)
+15 ; two additional fields need to be handled for components
+16 IF FIL=232.622
Begin DoDot:1
+17 DO SETFDA(FIL,IENS,.04,CVIS)
+18 DO SETFDA(FIL,IENS,.05,CSUM)
End DoDot:1
+19 ; if this is a new entry, file it, then quit
+20 IF $GET(NEW)
KILL ERR
DO UPDATE^DIE(,"FDA",,"ERR")
KILL FDA
SET RET=$SELECT($DATA(ERR):-1,1:1)
QUIT RET
+21 ; if this is meant to update an entry, lock, update, unlock
+22 ; lock
+23 LOCK +^EDPB(232.6,WSID):3
if '$TEST
QUIT 0
+24 DO FILE^DIE(,"FDA","ERR")
+25 LOCK -^EDPB(232.6,WSID)
+26 ; unlock
+27 IF $DATA(ERR)
SET RET=-1
+28 QUIT RET
SETFDA(F,IENS,FD,VAL) ;
+1 SET FDA(F,IENS,FD)=VAL
+2 QUIT
WSERR(ERRTXT) ;
+1 DO XML^EDPX("<error>")
+2 DO XML^EDPX($GET(ERRTXT))
+3 DO XML^EDPX("</error>")
+4 QUIT
VAL(ARRY,ITEM) ;return value from array, given ARRY (array name), and ITEM (subscript)
+1 IF $DATA(ARRY(ITEM))
IF $GET(ARRY(ITEM))'=""
QUIT $GET(ARRY(ITEM))
+2 QUIT $GET(ARRY(ITEM,1))
