- 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 Feb 18, 2025@23:18:57 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