- 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 Jan 18, 2025@02:52:54 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))