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