EDPQAR ;SLC/KCM - Log Area Information ;2/28/12 08:33am
;;2.0;EMERGENCY DEPARTMENT;**6**;Feb 24, 2012;Build 200
;
PARAM(AREA) ; return parameters for area
N X,X1
S X1=$G(^EDPB(231.9,AREA,1))
S X("reqDiag")=+$P(X1,U,1)
S X("codedDiag")=+$P(X1,U,2)
S X("reqDisp")=+$P(X1,U,3)
S X("reqDelay")=+$P(X1,U,4)
S X("minDelay")=+$P(X1,U,5)
S X("residents")=+$P(X1,U,8)
S X("clinics")=+$P(X1,U,9)
S X("emptyIEN")=+$O(^EDPB(233.1,"B","edp.reserved.novalue",0))
S X("errorIEN")=+$O(^EDPB(233.1,"B","edp.disposition.error",0))
S X("evalIEN")=+$O(^EDPB(233.1,"B","edp.disposition.nec",0))
S X("leftIEN")=+$O(^EDPB(233.1,"B","edp.disposition.left",0))
D XML^EDPX($$XMLA^EDPX("params",.X))
Q
; BYPASS & LSTIENS not implemented yet, perhaps in T25?
; This would require changing the params VO to have a list
; of IEN's that would be checked when enabling the remove from
; board button. EDPLOG would also need to check the flags of
; the disposition when validating in RDY2RMV
BYPASS(AREA) ; list IEN's for bypass dispositions
N ROOT
D XML^EDPX("<bypassRemoveChecks>")
S ROOT="edp.disposition" D LSTIENS(ROOT)
S ROOT=EDPSTA_".disposition" D LSTIENS(ROOT)
D XML^EDPX("</bypassRemoveChecks>")
Q
LSTIENS(ROOT) ; list IEN's that should bypass remove-from-board checks
N X,IEN,FLAGS
S X=ROOT F S X=$O(^EDPB(233.1,"B",X)) Q:$E(X,1,$L(ROOT))'=ROOT D
. S IEN=0 F S IEN=$O(^EDPB(233.1,"B",X,IEN)) Q:'IEN D
.. S FLAGS=$P(^EDPB(233.1,IEN,0),U,5) Q:FLAGS'["B"
.. D XML^EDPX("<ien>"_IEN_"</ien>")
Q
BRDUSER(AREA) ; set XML for anonymous board user
N X,DFLTROOM
S X("area")=$$DFLTAREA(AREA)
I X("area") S X("areaNm")=$P(^EDPB(231.9,X("area"),0),U)
S X("version")=$$VERSRV
; bwf patch 6 - 4/25/2013 adding defaultRoom to XML return
I X("area") D
.S DFLTROOM=$$GET1^DIQ(231.9,X("area"),1.12,"I")
.S X("defaultRoom")=$S(DFLTROOM:"true",1:"false")
D XML^EDPX($$XMLA^EDPX("user",.X))
Q
DFLTAREA(AREA) ; return the default area for a site
N X,DFLT
I $L($G(AREA)),(+AREA'=AREA) D
. S AREA=$O(^EDPB(231.9,"B",AREA,0))
. ; need to check for matching site!!
S DFLT=$S($G(AREA):AREA,1:$O(^EDPB(231.9,"C",EDPSITE,0)))
;
I 'DFLT D ADDAREA S DFLT=$O(^EDPB(231.9,"C",EDPSITE,0))
Q DFLT
ADDAREA ; add area if none is defined for this site
N FDA,FDAIEN,DIERR,ERR
S FDA(231.9,"+1,",.01)="Emergency Department"
S FDA(231.9,"+1,",.02)=EDPSITE
D UPDATE^DIE("","FDA","FDAIEN","ERR")
Q:$D(DIERR)
;
N AREA S AREA=FDAIEN(1)
D RESET^EDPBRS(AREA)
Q
VERSRV() ; Return server version of option name
N EDPLST,VAL
D FIND^DIC(19,"",1,"X","EDPF TRACKING SYSTEM",1,,,,"EDPLST")
S VAL=$G(EDPLST("DILIST","ID",1,1))
S VAL=$P(VAL,"version ",2)
I 'VAL Q "1.0T?"
Q VAL
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPQAR 2747 printed Oct 16, 2024@17:52:55 Page 2
EDPQAR ;SLC/KCM - Log Area Information ;2/28/12 08:33am
+1 ;;2.0;EMERGENCY DEPARTMENT;**6**;Feb 24, 2012;Build 200
+2 ;
PARAM(AREA) ; return parameters for area
+1 NEW X,X1
+2 SET X1=$GET(^EDPB(231.9,AREA,1))
+3 SET X("reqDiag")=+$PIECE(X1,U,1)
+4 SET X("codedDiag")=+$PIECE(X1,U,2)
+5 SET X("reqDisp")=+$PIECE(X1,U,3)
+6 SET X("reqDelay")=+$PIECE(X1,U,4)
+7 SET X("minDelay")=+$PIECE(X1,U,5)
+8 SET X("residents")=+$PIECE(X1,U,8)
+9 SET X("clinics")=+$PIECE(X1,U,9)
+10 SET X("emptyIEN")=+$ORDER(^EDPB(233.1,"B","edp.reserved.novalue",0))
+11 SET X("errorIEN")=+$ORDER(^EDPB(233.1,"B","edp.disposition.error",0))
+12 SET X("evalIEN")=+$ORDER(^EDPB(233.1,"B","edp.disposition.nec",0))
+13 SET X("leftIEN")=+$ORDER(^EDPB(233.1,"B","edp.disposition.left",0))
+14 DO XML^EDPX($$XMLA^EDPX("params",.X))
+15 QUIT
+16 ; BYPASS & LSTIENS not implemented yet, perhaps in T25?
+17 ; This would require changing the params VO to have a list
+18 ; of IEN's that would be checked when enabling the remove from
+19 ; board button. EDPLOG would also need to check the flags of
+20 ; the disposition when validating in RDY2RMV
BYPASS(AREA) ; list IEN's for bypass dispositions
+1 NEW ROOT
+2 DO XML^EDPX("<bypassRemoveChecks>")
+3 SET ROOT="edp.disposition"
DO LSTIENS(ROOT)
+4 SET ROOT=EDPSTA_".disposition"
DO LSTIENS(ROOT)
+5 DO XML^EDPX("</bypassRemoveChecks>")
+6 QUIT
LSTIENS(ROOT) ; list IEN's that should bypass remove-from-board checks
+1 NEW X,IEN,FLAGS
+2 SET X=ROOT
FOR
SET X=$ORDER(^EDPB(233.1,"B",X))
if $EXTRACT(X,1,$LENGTH(ROOT))'=ROOT
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^EDPB(233.1,"B",X,IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 SET FLAGS=$PIECE(^EDPB(233.1,IEN,0),U,5)
if FLAGS'["B"
QUIT
+5 DO XML^EDPX("<ien>"_IEN_"</ien>")
End DoDot:2
End DoDot:1
+6 QUIT
BRDUSER(AREA) ; set XML for anonymous board user
+1 NEW X,DFLTROOM
+2 SET X("area")=$$DFLTAREA(AREA)
+3 IF X("area")
SET X("areaNm")=$PIECE(^EDPB(231.9,X("area"),0),U)
+4 SET X("version")=$$VERSRV
+5 ; bwf patch 6 - 4/25/2013 adding defaultRoom to XML return
+6 IF X("area")
Begin DoDot:1
+7 SET DFLTROOM=$$GET1^DIQ(231.9,X("area"),1.12,"I")
+8 SET X("defaultRoom")=$SELECT(DFLTROOM:"true",1:"false")
End DoDot:1
+9 DO XML^EDPX($$XMLA^EDPX("user",.X))
+10 QUIT
DFLTAREA(AREA) ; return the default area for a site
+1 NEW X,DFLT
+2 IF $LENGTH($GET(AREA))
IF (+AREA'=AREA)
Begin DoDot:1
+3 SET AREA=$ORDER(^EDPB(231.9,"B",AREA,0))
+4 ; need to check for matching site!!
End DoDot:1
+5 SET DFLT=$SELECT($GET(AREA):AREA,1:$ORDER(^EDPB(231.9,"C",EDPSITE,0)))
+6 ;
+7 IF 'DFLT
DO ADDAREA
SET DFLT=$ORDER(^EDPB(231.9,"C",EDPSITE,0))
+8 QUIT DFLT
ADDAREA ; add area if none is defined for this site
+1 NEW FDA,FDAIEN,DIERR,ERR
+2 SET FDA(231.9,"+1,",.01)="Emergency Department"
+3 SET FDA(231.9,"+1,",.02)=EDPSITE
+4 DO UPDATE^DIE("","FDA","FDAIEN","ERR")
+5 if $DATA(DIERR)
QUIT
+6 ;
+7 NEW AREA
SET AREA=FDAIEN(1)
+8 DO RESET^EDPBRS(AREA)
+9 QUIT
VERSRV() ; Return server version of option name
+1 NEW EDPLST,VAL
+2 DO FIND^DIC(19,"",1,"X","EDPF TRACKING SYSTEM",1,,,,"EDPLST")
+3 SET VAL=$GET(EDPLST("DILIST","ID",1,1))
+4 SET VAL=$PIECE(VAL,"version ",2)
+5 IF 'VAL
QUIT "1.0T?"
+6 QUIT VAL
