Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: EDPBWS

EDPBWS.m

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