EDPWS ;SLC/KCM - Worksheet Calls ;3/2/12 10:43am
;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
;
LOAD(REQ) ; Load Worksheet with Models
D PRESERVE(.REQ) ; save previous worksheet state
N EDPCTXT,WKS,WRKSHT,MODELS,RESULT,NEEDED,SEQ
S EDPCTXT("area")=$G(REQ("area",1))
S EDPCTXT("log")=$G(REQ("log",1))
S EDPCTXT("dfn")=$G(REQ("dfn",1))
S EDPCTXT("role")=$G(REQ("role",1))
I DUZ=20011 S EDPCTXT("role")=573 ; CLERK 4
I DUZ=20014 S EDPCTXT("role")=272 ; NURSE 3
I DUZ=20013 S EDPCTXT("role")=426 ; RESIDENT 2
I DUZ=20015 S EDPCTXT("role")=459 ; PHYSICIAN 1
I 'EDPCTXT("role") S EDPCTXT("role")=459 ; TEMPORARY!!
S WKS=$G(REQ("worksheet",1))
I 'WKS S WKS=$$DFLTWKS(EDPCTXT("role"),EDPCTXT("area"))
I 'WKS D XML^EDPX("<worksheet />") Q ;TODO -- trigger error?
;
; load the worksheet specification
D GETWKS^EDPBWS(WKS,.WRKSHT)
S WRKSHT("dfn")=EDPCTXT("dfn")
D ADDST(.WRKSHT)
; iterate thru the sections and get their models
S SEQ=0 F S SEQ=$O(WRKSHT("section",SEQ)) Q:'SEQ D
. S I=0 F S I=$O(WRKSHT("section",SEQ,"model",I)) Q:'I D
. . S NEEDED(WRKSHT("section",SEQ,"model",I,"id"))=""
D MODELS(.NEEDED,.MODELS)
M RESULTS=MODELS,RESULTS("worksheet",1)=WRKSHT
K MODELS,WRKSHT,NEEDED ; free some memory
D TOXML^EDPXML(.RESULTS,.EDPXML)
K RESULTS,SEC
Q
MODELS(NEEDED,MODELS) ; Build models for section
N MODEL,X0,EDPDATA,LOADCALL
S MODEL=0 F S MODEL=$O(NEEDED(MODEL)) Q:'MODEL D
. ; quit here if model already on the client
. S X0=^EDPB(232.72,MODEL,0)
. S MODELS("model",MODEL,"name")=$P(X0,U,2)_"::"_$P(X0,U)
. S MODELS("model",MODEL,"type")=$S($P(X0,U,4)="V":"visit",1:"reference")
. S EDPCTXT("model")=MODELS("model",MODEL,"name")
. S LOADCALL=$P($G(^EDPB(232.72,MODEL,1)),U,1,2)
. Q:'$L(LOADCALL)
. I $P(^EDPB(232.72,MODEL,1),U,3) D
. . N EDPXML
. . D @(LOADCALL_"(.EDPCTXT)")
. . D TOARR^EDPXML(.EDPXML,.EDPDATA)
. E D @(LOADCALL_"(.EDPCTXT,.EDPDATA)")
. I $D(EDPDATA) M MODELS("model",MODEL,"data",1)=EDPDATA
. K EDPDATA
Q
DFLTWKS(ROLE,AREA) ; Return default worksheet for this role
N IEN S IEN=$O(^EDPB(232.5,"C",EDPSITE,AREA,ROLE,0))
Q:'IEN 0
Q $P(^EDPB(232.5,IEN,0),U,4)
;
PRESERVE(REQ) ; Preserve status of previously selected worksheet
N WXML M WXML=REQ("preserve") K REQ("preserve")
N WSTS D TOARR^EDPXML(.WXML,.WSTS,"preserve")
Q:'$D(WSTS("worksheet",1,"dfn"))
N TREF S TREF="EDPWKS-"_WSTS("worksheet",1,"dfn")_"-"_DUZ
S ^XTMP(TREF,0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"ED Worksheet State"
N WKID S WKID=WSTS("worksheet",1,"id")
K ^XTMP(TREF,"worksheet",WKID)
S ^XTMP(TREF,"worksheet",WKID)=WSTS("worksheet",1,"scroll")
N I S I=0
F S I=$O(WSTS("worksheet",1,"section",I)) Q:'I D
. S SEC=$$SECID(WSTS("worksheet",1,"section",I,"name"))
. S ^XTMP(TREF,"worksheet",WKID,"section",SEC)=WSTS("worksheet",1,"section",I,"open")
Q
SECID(NAME) ; return section IEN given name
Q +$O(^EDPB(232.71,"C",NAME,0))
;
ADDST(WRKSHT) ; add state, if any to the worksheet
N TREF S TREF="EDPWKS-"_WRKSHT("dfn")_"-"_DUZ
N WKID S WKID=WRKSHT("id")
Q:'$D(^XTMP(TREF,"worksheet",WKID))
S WRKSHT("scroll")=+^XTMP(TREF,"worksheet",WKID)
N I,OPEN S I=0
F S I=$O(WRKSHT("section",I)) Q:'I D
. S SEC=+$$SECID(WRKSHT("section",I,"detailPlugin")) Q:'SEC
. S OPEN=$G(^XTMP(TREF,"worksheet",WKID,"section",SEC))
. I $L(OPEN) S WRKSHT("section",I,"initialOpen")=OPEN
Q
PREVIEW(CTXT,RESULT) ; Add XML for a model preview
N MODEL S MODEL=CTXT("model")
I MODEL'=+MODEL S MODEL=$O(^EDPB(232.72,"C",MODEL,0))
Q:'$D(^EDPB(232.72,+MODEL,5))
N XML,I
S I=0 F S I=$O(^EDPB(232.72,+MODEL,5,I)) Q:'I S XML(I)=^(I,0)
D TOARR^EDPXML(.XML,.RESULT,"data")
Q
SVSECT(REQ) ; Save models of the worksheet
N EDPCTXT,EDPDATA
S EDPCTXT("dfn")=REQ("dfn",1)
S EDPCTXT("area")=REQ("area",1)
S EDPCTXT("log")=REQ("log",1)
; put in global so the XML can be converted using Kernel tools
N XMLDATA M XMLDATA=REQ("uncommittedState")
D TOARR^EDPXML(.XMLDATA,.EDPDATA,"data")
S MODEL="" F S MODEL=$O(EDPDATA("model",MODEL)) Q:MODEL=""
Q
SAVE(XML,CTXT,COMMIT) ; Save the worksheet XML
; XML contains all the momentos to be saved
; can either stash the XML in ^XTMP (COMMIT=0)
; or parse and call out to packages to save their models (COMMIT=1)
Q
;
; bwf: 12-19/2011 commenting test code for the time being
;TEST ;
;S EDPSITE=DUZ(2),EDPSTA=$$STA^XUAF4(DUZ(2))
;S REQ("area",1)=1,REQ("log",1)=9,REQ("dfn",1)=229,REQ("role")=459
;D LOAD(.REQ)
;Q
;TESTPASS(AREF) ; Test passing of array
;W !,AREF
;S X=AREF F S X=$Q(@X) Q:$E(X,1,$L(AREF)-1)'=$E(AREF,1,$L(AREF)-1) W !,X
;ZW ARY
;Q
;TV ;
;S EDPCTXT("area")=1,EDPCTXT("log")=6,EDPCTXT("dfn")=229
;D READ^EDPVIT(.EDPCTXT) ZW EDPXML
;Q
;T1(EDPCXT) ; TEST
;W !,"HI"
;Q
;TP ; TEST PRESERVE
;N REQ M REQ=^KEVIN("REQ")
;D PRESERVE(.REQ)
;Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPWS 4880 printed Nov 22, 2024@17:02:42 Page 2
EDPWS ;SLC/KCM - Worksheet Calls ;3/2/12 10:43am
+1 ;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
+2 ;
LOAD(REQ) ; Load Worksheet with Models
+1 ; save previous worksheet state
DO PRESERVE(.REQ)
+2 NEW EDPCTXT,WKS,WRKSHT,MODELS,RESULT,NEEDED,SEQ
+3 SET EDPCTXT("area")=$GET(REQ("area",1))
+4 SET EDPCTXT("log")=$GET(REQ("log",1))
+5 SET EDPCTXT("dfn")=$GET(REQ("dfn",1))
+6 SET EDPCTXT("role")=$GET(REQ("role",1))
+7 ; CLERK 4
IF DUZ=20011
SET EDPCTXT("role")=573
+8 ; NURSE 3
IF DUZ=20014
SET EDPCTXT("role")=272
+9 ; RESIDENT 2
IF DUZ=20013
SET EDPCTXT("role")=426
+10 ; PHYSICIAN 1
IF DUZ=20015
SET EDPCTXT("role")=459
+11 ; TEMPORARY!!
IF 'EDPCTXT("role")
SET EDPCTXT("role")=459
+12 SET WKS=$GET(REQ("worksheet",1))
+13 IF 'WKS
SET WKS=$$DFLTWKS(EDPCTXT("role"),EDPCTXT("area"))
+14 ;TODO -- trigger error?
IF 'WKS
DO XML^EDPX("<worksheet />")
QUIT
+15 ;
+16 ; load the worksheet specification
+17 DO GETWKS^EDPBWS(WKS,.WRKSHT)
+18 SET WRKSHT("dfn")=EDPCTXT("dfn")
+19 DO ADDST(.WRKSHT)
+20 ; iterate thru the sections and get their models
+21 SET SEQ=0
FOR
SET SEQ=$ORDER(WRKSHT("section",SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+22 SET I=0
FOR
SET I=$ORDER(WRKSHT("section",SEQ,"model",I))
if 'I
QUIT
Begin DoDot:2
+23 SET NEEDED(WRKSHT("section",SEQ,"model",I,"id"))=""
End DoDot:2
End DoDot:1
+24 DO MODELS(.NEEDED,.MODELS)
+25 MERGE RESULTS=MODELS,RESULTS("worksheet",1)=WRKSHT
+26 ; free some memory
KILL MODELS,WRKSHT,NEEDED
+27 DO TOXML^EDPXML(.RESULTS,.EDPXML)
+28 KILL RESULTS,SEC
+29 QUIT
MODELS(NEEDED,MODELS) ; Build models for section
+1 NEW MODEL,X0,EDPDATA,LOADCALL
+2 SET MODEL=0
FOR
SET MODEL=$ORDER(NEEDED(MODEL))
if 'MODEL
QUIT
Begin DoDot:1
+3 ; quit here if model already on the client
+4 SET X0=^EDPB(232.72,MODEL,0)
+5 SET MODELS("model",MODEL,"name")=$PIECE(X0,U,2)_"::"_$PIECE(X0,U)
+6 SET MODELS("model",MODEL,"type")=$SELECT($PIECE(X0,U,4)="V":"visit",1:"reference")
+7 SET EDPCTXT("model")=MODELS("model",MODEL,"name")
+8 SET LOADCALL=$PIECE($GET(^EDPB(232.72,MODEL,1)),U,1,2)
+9 if '$LENGTH(LOADCALL)
QUIT
+10 IF $PIECE(^EDPB(232.72,MODEL,1),U,3)
Begin DoDot:2
+11 NEW EDPXML
+12 DO @(LOADCALL_"(.EDPCTXT)")
+13 DO TOARR^EDPXML(.EDPXML,.EDPDATA)
End DoDot:2
+14 IF '$TEST
DO @(LOADCALL_"(.EDPCTXT,.EDPDATA)")
+15 IF $DATA(EDPDATA)
MERGE MODELS("model",MODEL,"data",1)=EDPDATA
+16 KILL EDPDATA
End DoDot:1
+17 QUIT
DFLTWKS(ROLE,AREA) ; Return default worksheet for this role
+1 NEW IEN
SET IEN=$ORDER(^EDPB(232.5,"C",EDPSITE,AREA,ROLE,0))
+2 if 'IEN
QUIT 0
+3 QUIT $PIECE(^EDPB(232.5,IEN,0),U,4)
+4 ;
PRESERVE(REQ) ; Preserve status of previously selected worksheet
+1 NEW WXML
MERGE WXML=REQ("preserve")
KILL REQ("preserve")
+2 NEW WSTS
DO TOARR^EDPXML(.WXML,.WSTS,"preserve")
+3 if '$DATA(WSTS("worksheet",1,"dfn"))
QUIT
+4 NEW TREF
SET TREF="EDPWKS-"_WSTS("worksheet",1,"dfn")_"-"_DUZ
+5 SET ^XTMP(TREF,0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"ED Worksheet State"
+6 NEW WKID
SET WKID=WSTS("worksheet",1,"id")
+7 KILL ^XTMP(TREF,"worksheet",WKID)
+8 SET ^XTMP(TREF,"worksheet",WKID)=WSTS("worksheet",1,"scroll")
+9 NEW I
SET I=0
+10 FOR
SET I=$ORDER(WSTS("worksheet",1,"section",I))
if 'I
QUIT
Begin DoDot:1
+11 SET SEC=$$SECID(WSTS("worksheet",1,"section",I,"name"))
+12 SET ^XTMP(TREF,"worksheet",WKID,"section",SEC)=WSTS("worksheet",1,"section",I,"open")
End DoDot:1
+13 QUIT
SECID(NAME) ; return section IEN given name
+1 QUIT +$ORDER(^EDPB(232.71,"C",NAME,0))
+2 ;
ADDST(WRKSHT) ; add state, if any to the worksheet
+1 NEW TREF
SET TREF="EDPWKS-"_WRKSHT("dfn")_"-"_DUZ
+2 NEW WKID
SET WKID=WRKSHT("id")
+3 if '$DATA(^XTMP(TREF,"worksheet",WKID))
QUIT
+4 SET WRKSHT("scroll")=+^XTMP(TREF,"worksheet",WKID)
+5 NEW I,OPEN
SET I=0
+6 FOR
SET I=$ORDER(WRKSHT("section",I))
if 'I
QUIT
Begin DoDot:1
+7 SET SEC=+$$SECID(WRKSHT("section",I,"detailPlugin"))
if 'SEC
QUIT
+8 SET OPEN=$GET(^XTMP(TREF,"worksheet",WKID,"section",SEC))
+9 IF $LENGTH(OPEN)
SET WRKSHT("section",I,"initialOpen")=OPEN
End DoDot:1
+10 QUIT
PREVIEW(CTXT,RESULT) ; Add XML for a model preview
+1 NEW MODEL
SET MODEL=CTXT("model")
+2 IF MODEL'=+MODEL
SET MODEL=$ORDER(^EDPB(232.72,"C",MODEL,0))
+3 if '$DATA(^EDPB(232.72,+MODEL,5))
QUIT
+4 NEW XML,I
+5 SET I=0
FOR
SET I=$ORDER(^EDPB(232.72,+MODEL,5,I))
if 'I
QUIT
SET XML(I)=^(I,0)
+6 DO TOARR^EDPXML(.XML,.RESULT,"data")
+7 QUIT
SVSECT(REQ) ; Save models of the worksheet
+1 NEW EDPCTXT,EDPDATA
+2 SET EDPCTXT("dfn")=REQ("dfn",1)
+3 SET EDPCTXT("area")=REQ("area",1)
+4 SET EDPCTXT("log")=REQ("log",1)
+5 ; put in global so the XML can be converted using Kernel tools
+6 NEW XMLDATA
MERGE XMLDATA=REQ("uncommittedState")
+7 DO TOARR^EDPXML(.XMLDATA,.EDPDATA,"data")
+8 SET MODEL=""
FOR
SET MODEL=$ORDER(EDPDATA("model",MODEL))
if MODEL=""
QUIT
+9 QUIT
SAVE(XML,CTXT,COMMIT) ; Save the worksheet XML
+1 ; XML contains all the momentos to be saved
+2 ; can either stash the XML in ^XTMP (COMMIT=0)
+3 ; or parse and call out to packages to save their models (COMMIT=1)
+4 QUIT
+5 ;
+6 ; bwf: 12-19/2011 commenting test code for the time being
+7 ;TEST ;
+8 ;S EDPSITE=DUZ(2),EDPSTA=$$STA^XUAF4(DUZ(2))
+9 ;S REQ("area",1)=1,REQ("log",1)=9,REQ("dfn",1)=229,REQ("role")=459
+10 ;D LOAD(.REQ)
+11 ;Q
+12 ;TESTPASS(AREF) ; Test passing of array
+13 ;W !,AREF
+14 ;S X=AREF F S X=$Q(@X) Q:$E(X,1,$L(AREF)-1)'=$E(AREF,1,$L(AREF)-1) W !,X
+15 ;ZW ARY
+16 ;Q
+17 ;TV ;
+18 ;S EDPCTXT("area")=1,EDPCTXT("log")=6,EDPCTXT("dfn")=229
+19 ;D READ^EDPVIT(.EDPCTXT) ZW EDPXML
+20 ;Q
+21 ;T1(EDPCXT) ; TEST
+22 ;W !,"HI"
+23 ;Q
+24 ;TP ; TEST PRESERVE
+25 ;N REQ M REQ=^KEVIN("REQ")
+26 ;D PRESERVE(.REQ)
+27 ;Q
