EDPARPT ;SLC/BWF - Ad Hoc Reports ;5/16/2012 11:51am
;;2.0;EMERGENCY DEPARTMENT;**6**;Feb 24, 2012;Build 200
;
GETREPL(EDPXML,P1,P2) ; get report list
N IEN,CNT,ARRAY,EDPRES
S EDPRES=$NA(^TMP("EDPARPT",$J)) K @EDPRES
S ARRAY=$NA(^TMP("EDPARPT",$J,"reports",1)) K @ARRAY
S IEN=$G(P1("id")) I 'IEN S IEN=$G(P1("id",1))
I IEN D Q
.D BLDRITEM(1,IEN,ARRAY,.P1)
.D TOXMLG^EDPXML(EDPRES,EDPXML) K @ARRAY,@EDPRES
S (IEN,CNT)=0 F S IEN=$O(^EDPB(232.1,IEN)) Q:'IEN D
.S CNT=CNT+1
.D BLDRITEM(CNT,IEN,ARRAY,.P1)
D TOXMLG^EDPXML(EDPRES,EDPXML)
K @ARRAY,@EDPRES
Q
BLDRITEM(CNT,IEN,ARRAY,PARAM) ;
N X0,RIEN,RID,RNAME,RABBR,EIEN,ESEQ,EPTR,E0
S X0=$G(^EDPB(232.1,IEN,0))
S @ARRAY@("report",CNT,"name")=$P(X0,U,1)
S @ARRAY@("report",CNT,"id")=IEN
S @ARRAY@("report",CNT,"inactive")=$S($P(X0,U,2)>0:"true",1:"false")
S RIEN=0 F S RIEN=$O(^EDPB(232.1,IEN,2,RIEN)) Q:'RIEN D
.S RID=+$G(^EDPB(232.1,IEN,2,RIEN,0))
.S RNAME=$$GET1^DIQ(232.5,RID,.01,"E")
.S RABBR=$$GET1^DIQ(232.5,RID,.02,"E")
.S @ARRAY@("report",CNT,"role",RID,"id")=RID
.S @ARRAY@("report",CNT,"role",RID,"name")=RNAME
.S @ARRAY@("report",CNT,"role",RID,"abbreviation")=RABBR
I $G(PARAM("elements"))="true"!($G(PARAM("id"))>0) D
.S EIEN=0 F S EIEN=$O(^EDPB(232.1,IEN,1,EIEN)) Q:'EIEN D
..S E0=$G(^EDPB(232.1,IEN,1,EIEN,0))
..S ESEQ=$P(E0,U),EPTR=$P(E0,U,2)
..S @ARRAY@("report",CNT,"element",EIEN,"sequence")=ESEQ
..S @ARRAY@("report",CNT,"element",EIEN,"id")=EPTR
..S @ARRAY@("report",CNT,"element",EIEN,"name")=$$GET1^DIQ(232.11,EPTR,.01,"E")
Q
SAVE(EDPXML,P1,P2) ; save report definition
N X,ID,NAME,REMOVE,IENS,INACTIVE,EDITABLE,ELEM,EIENS,ROLE,RIENS,ERR,NEWIEN,NIEN
I '$D(P1) Q
S ID=$G(P1("id")),NAME=$G(P1("name"))
S REMOVE=$G(P1("remove")),REMOVE=$S(REMOVE="true":1,1:0)
; convert inactive and editable values to internal
S INACTIVE=$G(P1("inactive")),INACTIVE=$S(INACTIVE="true":1,1:0)
S EDITABLE=$G(P1("editable")),EDITABLE=$S(INACTIVE="true":1,1:0)
; if remove and an id is sent, delete the entry and quit
I ID'="",REMOVE S FDA(232.1,ID_",",.01)="@" D FILE^DIE(,"FDA") K FDA D SUCCESS(EDPXML,"<status>deleted</status>") Q
S IENS=$S(ID="":"+1,",1:ID_",")
K FDA
S FDA(232.1,IENS,.01)=NAME
S FDA(232.1,IENS,.02)=INACTIVE
S FDA(232.1,IENS,.03)=EDITABLE
; if there is no id, then we are adding a new entry
I 'ID D Q
.D UPDATE^DIE(,"FDA","NEWIEN","ERR")
.I $D(ERR) D WSERR^EDPBWS("An error occured while filing a new entry.") Q
.S NIEN=$O(NEWIEN(0)),NIEN=$G(NEWIEN(NIEN))
.D REPMULTS(NIEN,.P2)
.S P1("id")=NIEN,P1("elements")="true" D GETREPL(EDPXML,.P1)
; if editing an entry (ID is defined), loop through the multiples and clear them out so they can be rebuilt
S ELEM=0 F S ELEM=$O(^EDPB(232.1,ID,1,ELEM)) Q:'ELEM D
.S EIENS=ELEM_","_ID_","
.S FDA(232.12,EIENS,.01)="@" D FILE^DIE(,"FDA") K FDA
S ROLE=0 F S ROLE=$O(^EDPB(232.1,ID,1,ROLE)) Q:'ROLE D
.S RIENS=ROLE_","_ID_","
.S FDA(232.13,RIENS,.01)="@" D FILE^DIE(,"FDA") K FDA
; now file the data for 232.1 main file
D FILE^DIE(,"FDA") K FDA
D REPMULTS(NIEN,.P2)
S P1("id")=NIEN,P1("elements")="true" D GETREPL(EDPXML,.P1)
Q
REPMULTS(IEN,PARAMS) ; update the 'display elements' and 'roles multiples
N ROLES,ELEMS,SEQ,LSEQ,ID,X,RLOOP
; loop through elements and order them in an array
S X=0 F S X=$O(PARAMS("element",X)) Q:'X D
.S ID=$P(PARAMS("element",X),U),SEQ=$P(PARAMS("element",X),U,2)
.S ELEMS(SEQ)=ID
S LSEQ=0 F S LSEQ=$O(ELEMS(LSEQ)) Q:'LSEQ D
.S FDA(232.12,"+1,"_IEN_",",.01)=LSEQ
.S FDA(232.12,"+1,"_IEN_",",.02)=$G(ELEMS(LSEQ))
.D UPDATE^DIE(,"FDA") K FDA
; order of the roles are not important, we can just file them
S RLOOP=0 F S RLOOP=$O(PARAMS("role",RLOOP)) Q:'RLOOP D
.S FDA(232.13,"+1,"_IEN_",",.01)=$G(PARAMS("role",RLOOP))
.D UPDATE^DIE(,"FDA") K FDA
Q
SUCCESS(EDPXML,DATA) ;
N EDPCNT
S EDPCNT=0 D XMLG^EDPX(DATA,EDPCNT,EDPXML)
Q
GETELM(EDPXML,P1,P2) ; get report element list
N IEN,EDPRES,ARRAY,CNT
S EDPRES=$NA(^TMP("EDPARPT",$J)) K @EDPRES
S ARRAY=$NA(^TMP("EDPARPT",$J,"reportElements",1)) K @ARRAY
S (IEN,CNT)=0 F S IEN=$O(^EDPB(232.11,IEN)) Q:'IEN D
.S CNT=CNT+1
.S @ARRAY@("element",CNT,"id")=IEN
.S @ARRAY@("element",CNT,"name")=$$GET1^DIQ(232.11,IEN,.01,"E")
D TOXMLG^EDPXML(EDPRES,EDPXML)
Q
TESTEXE ;
S P1("start")=2980101
S P1("id")=1
S EDPSITE=807
S EDPXML=$NA(^TMP("EDPGLOB",$J)) K @EDPXML
D EXE^EDPARPT(EDPXML,.P1)
Q
; input
; EDPXML - $NA of global array where XML will be stored
; P1 - single diminsional array that contains top level data
; P2 - multiple diminsion array that contains 'custom' report structure
EXE(EDPXML,P1,P2) ; execute a report
N RID,EDPRES,ARRAY,EID,E0,ESEQ,EPTR,EARRY,CSV,CSVARRY,ELOOP
S EDPRES=$NA(^TMP("EDPARPT",$J)) K @EDPRES
S ARRAY=$NA(^TMP("EDPARPT",$J,"records",1)) K @ARRAY
S XMLARRY=$NA(^TMP("EDPARPT",$J,"logEntries",1)) K @XMLARRY
S CSVARRY=$NA(^TMP("EDPARPT",$J,"CSV")) K @CSVARRY
S RID=$G(P1("id")) ; set report id
S CSV=$G(P1("csv")),CSV=$S(CSV="true":1,1:0),CNT=0
; if report 'id' is passed in, build the sequence and definition information
I RID D
.S EID=0 F S EID=$O(^EDPB(232.1,RID,1,EID)) Q:'EID D
..S E0=$G(^EDPB(232.1,RID,1,EID,0)),ESEQ=$P(E0,U),EPTR=$P(E0,U,2)
..S EARRY(ESEQ)=EPTR_U_$$EDAT(EPTR)
; loop through 'custom' definition (P2) and build EARRY(SEQ)
I 'RID D
.S ELOOP=0 F S ELOOP=$O(P2("element",ELOOP)) Q:'ELOOP D
..S EPTR=$P(P2("element",ELOOP),U)
..S ESEQ=$P(P2("element",ELOOP),U,2)
..S EARRY(ESEQ)=EPTR_U_$$EDAT(EPTR)
D SRCH(EDPXML,XMLARRY,CSVARRY,EDPRES,ARRAY,.EARRY,.P1,CSV)
I '$G(CSV) D TOXMLG^EDPXML(XMLARRY,EDPXML)
;I $G(CSV) D TOXMLG^EDPXML(CSVARRY,EDPXML)
K @EDPRES,@ARRAY,@XMLARRY,@CSVARRY
Q
; using search criteria (from parameters), search the ED log entries.
SRCH(EDPXML,XMLARRY,CSVARRY,EDPRES,ARRAY,EARRY,P1,CSV) ;
N LOGTIME,LOGID,START,STOP,RES,PROV,PAT,CNT,AREA
; check for parameters
;S CSV=$G(P1,"csv"),CSV=$S(CSV="true":1,1:0),CNT=0
; if no start date is passed, look back 30 days???
S START=$G(P1("start")) I 'START S START=$$FMADD^XLFDT(DT,-30)
; if no stop date is passed, set the stop to NOW
S STOP=$G(P1("stop")) I 'STOP S STOP=$$NOW^XLFDT
S RES=$G(P1("resident")),PROV=$G(P1("provider")),PAT=$G(P1("patient"))
S AREA=$G(P1("area"))
; loop through the ED LOG file to get the needed data
S LOGTIME=START-.000001 F S LOGTIME=$O(^EDP(230,"ATI",EDPSITE,LOGTIME)) Q:'LOGTIME D
.S LOGID=0 F S LOGID=$O(^EDP(230,"ATI",EDPSITE,LOGTIME,LOGID)) Q:'LOGID D
..; if patient is passed as a parameter, and it doesn't match, quit
..I PAT,PAT'=$$GET1^DIQ(230,LOGID,.06,"I") Q
..; if provider or resident are passed and this entry is not for the provider/resident, quit
..;I PROV,'$$CHKHLOG(LOGID,3.5,PROV) Q
..;I RES,'$$CHKHLOG(LOGID,3.7,RES) Q
..S CNT=$G(CNT)+1
..D BUILD(EDPXML,XMLARRY,CSVARRY,LOGID,CNT,EDPRES,ARRAY,.EARRY,CSV,AREA)
Q
BUILD(EDPXML,XMLARRY,CSVARRY,LOGID,CNT,EDPRES,ARRAY,EARRY,CSV,AREA) ; Output requested fields from log ID.
N ESEQ,EPTR,LFIL,HFIL,LFLD,HFLD,TAB,SARRY,E0,LOOP,ICNT,EXE,IARRY,VAL,XHDR,DCNT,XMLLINE,XMLCNT,FHDR,DCNT,HDR,LOGIEN,FORMAT
; if there is a reportID, grab the structure for the EDP REPORT TEMPLATE file and process
S LFIL=230,HFIL=230.1,TAB=$C(9),CSVCNT=0
; create temporary storage array for data. this will be used to aggregate the data
S SARRY=$NA(^TMP("EDPARPT",$J,"BUILD")) K @SARRY
; get the main ED LOG (#230) ien
I $G(CSV) S $P(FHDR,TAB,1)="logID"
S ESEQ=0 F S ESEQ=$O(EARRY(ESEQ)) Q:'ESEQ D
.S E0=$G(EARRY(ESEQ))
.S EIEN=$P(E0,U),LFLD=$P(E0,U,4),HFLD=$P(E0,U,5),HDR=$P(E0,U,6)
.S EXE=$$GET1^DIQ(232.11,EIEN,2,"E"),EXE=$TR(EXE,"|","^")
.S FORMAT=$$GET1^DIQ(232.11,EIEN,1,"E"),FORMAT=$TR(FORMAT,"|","^")
.I $G(CSV) S $P(FHDR,TAB,ESEQ+1)=HDR ; set up header if CSV
.; if EXE is defined, use it. If it is not defined for this element, a simple $$GET1^DIQ will suffice
.; EXE is intended for complex elements, such as data that can be a multiple or needs to be calculated.
.; EXE has two values that can be potentially returned. VAL and IARRAY
.; after EXE has been executed, FORMAT may be used (if available and applicable) to properly format the data for display to the UI.
.I '$L(EXE) D
..S VAL=$$GET1^DIQ(230,LOGID,LFLD,"E")
..I $L(FORMAT) X FORMAT
..S @SARRY@(LOGID,EIEN,ESEQ,1)=$$ESC^EDPX(VAL) K VAL
.; if there is executable logic, run it and process results
.I $L(EXE) D
..K IARRY,VAL X EXE
..I $D(VAL) D Q
...; format the data if there is formatting logic
...I $L(FORMAT) X FORMAT
...S @SARRY@(LOGID,EIEN,ESEQ,1)=$$ESC^EDPX($G(VAL)) K VAL
..I $O(IARRY(0)) D
...S ICNT=0,LOOP=0 F S LOOP=$O(IARRY(LOOP)) Q:'LOOP D
....S ICNT=ICNT+1
....; format the data if there is formatting logic
....S VAL=$G(IARRY(LOOP)) I $L(FORMAT) X FORMAT
....S @SARRY@(LOGID,EIEN,ESEQ,ICNT)=$$ESC^EDPX(VAL) K VAL
..; if no data is returned, we need to at least set the 1 node to null so the header will appear
..I '$O(IARRY(0)) S @SARRY@(LOGID,EIEN,ESEQ,1)=""
..K IARRY
; if CSV, build it, clean up and quit
I $G(CSV) D BLDCSV(EDPXML,SARRY,CSVARRY,TAB,FHDR) K @SARRY Q
; if not CSV, build XML
S LOGIEN=0 F S LOGIEN=$O(@SARRY@(LOGIEN)) Q:'LOGIEN D
.;I $G(CSV) S CSVCNT=$G(CSVCNT)+1
.S EIEN=0 F S EIEN=$O(@SARRY@(LOGIEN,EIEN)) Q:'EIEN D
..S ESEQ=0 F S ESEQ=$O(@SARRY@(LOGIEN,EIEN,ESEQ)) Q:'ESEQ D
...S XHDR=$P(EARRY(ESEQ),U,6)
...S @XMLARRY@("logEntries",1,"logEntry",LOGIEN,"id")=LOGIEN
...S @XMLARRY@("logEntries",1,"logEntry",LOGIEN,"elements",1,"element",ESEQ,"sequence")=ESEQ
...S @XMLARRY@("logEntries",1,"logEntry",LOGIEN,"elements",1,"element",ESEQ,"header")=XHDR
...S DCNT=0 F S DCNT=$O(@SARRY@(LOGIEN,EIEN,ESEQ,DCNT)) Q:'DCNT D
....S @XMLARRY@("logEntries",1,"logEntry",LOGIEN,"elements",1,"element",ESEQ,"data",DCNT,"value")=$G(@SARRY@(LOGIEN,EIEN,ESEQ,DCNT))
; kill off the aggregation global array
K @SARRY
Q
;
BLDCSV(EDPXML,SARRY,CSVARRY,TAB,FHDR) ;
N LIEN,EIEN,ESEQ,CSVCNT,ECNT
S CSVCNT=0
D ADDG^EDPCSV(FHDR_$C(13)_$C(10),.CSVCNT,EDPXML) ; build the header and include CR/LF
S LIEN=0 F S LIEN=$O(@SARRY@(LIEN)) Q:'LIEN D
.S EIEN=0 F S EIEN=$O(@SARRY@(LIEN,EIEN)) Q:'EIEN D
..S ESEQ=0 F S ESEQ=$O(@SARRY@(LIEN,EIEN,ESEQ)) Q:'ESEQ D
...S ECNT=0 F S ECNT=$O(@SARRY@(LIEN,EIEN,ESEQ,ECNT)) Q:'ECNT D
....S $P(@CSVARRY@(LIEN,ECNT),TAB,1)=LIEN
....S $P(@CSVARRY@(LIEN,ECNT),TAB,ESEQ+1)=$G(@SARRY@(LIEN,EIEN,ESEQ,ECNT))
S LIEN=0 F S LIEN=$O(@CSVARRY@(LIEN)) Q:'LIEN D
.S ECNT=0 F S ECNT=$O(@CSVARRY@(LIEN,ECNT)) Q:'ECNT D
..D ADDG^EDPCSV($G(@CSVARRY@(LIEN,ECNT))_$C(13)_$C(10),.CSVCNT,EDPXML) ; build the line and include CR/LF
Q
;
; check to see if a resident or provider has ever been assigned to this patient
; input
; LOGID - log entry id from file 230
; FLD - cooresponding field to check data against.
; VAL - value to test for
CHKHLOG(LOGID,FLD,VAL) ;
N LTIME,FOUND,HLID
S FOUND=0
S LTIME=0 F S LTIME=$O(^EDP(230.1,"ADF",LOGID,LTIME)) Q:'LTIME D
.S HLID=0 F S HLID=$O(^EDP(230.1,"ADF",LOGID,LTIME,HLID)) Q:'HLID D
..I $$GET1^DIQ(230.1,HLID,FLD,"I")=VAL S FOUND=1
Q FOUND
;
EDAT(IEN) ; return element zero node data
Q:'IEN ""
Q $G(^EDPB(232.11,IEN,0))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPARPT 11378 printed Apr 09, 2024@20:56:41 Page 2
EDPARPT ;SLC/BWF - Ad Hoc Reports ;5/16/2012 11:51am
+1 ;;2.0;EMERGENCY DEPARTMENT;**6**;Feb 24, 2012;Build 200
+2 ;
GETREPL(EDPXML,P1,P2) ; get report list
+1 NEW IEN,CNT,ARRAY,EDPRES
+2 SET EDPRES=$NAME(^TMP("EDPARPT",$JOB))
KILL @EDPRES
+3 SET ARRAY=$NAME(^TMP("EDPARPT",$JOB,"reports",1))
KILL @ARRAY
+4 SET IEN=$GET(P1("id"))
IF 'IEN
SET IEN=$GET(P1("id",1))
+5 IF IEN
Begin DoDot:1
+6 DO BLDRITEM(1,IEN,ARRAY,.P1)
+7 DO TOXMLG^EDPXML(EDPRES,EDPXML)
KILL @ARRAY,@EDPRES
End DoDot:1
QUIT
+8 SET (IEN,CNT)=0
FOR
SET IEN=$ORDER(^EDPB(232.1,IEN))
if 'IEN
QUIT
Begin DoDot:1
+9 SET CNT=CNT+1
+10 DO BLDRITEM(CNT,IEN,ARRAY,.P1)
End DoDot:1
+11 DO TOXMLG^EDPXML(EDPRES,EDPXML)
+12 KILL @ARRAY,@EDPRES
+13 QUIT
BLDRITEM(CNT,IEN,ARRAY,PARAM) ;
+1 NEW X0,RIEN,RID,RNAME,RABBR,EIEN,ESEQ,EPTR,E0
+2 SET X0=$GET(^EDPB(232.1,IEN,0))
+3 SET @ARRAY@("report",CNT,"name")=$PIECE(X0,U,1)
+4 SET @ARRAY@("report",CNT,"id")=IEN
+5 SET @ARRAY@("report",CNT,"inactive")=$SELECT($PIECE(X0,U,2)>0:"true",1:"false")
+6 SET RIEN=0
FOR
SET RIEN=$ORDER(^EDPB(232.1,IEN,2,RIEN))
if 'RIEN
QUIT
Begin DoDot:1
+7 SET RID=+$GET(^EDPB(232.1,IEN,2,RIEN,0))
+8 SET RNAME=$$GET1^DIQ(232.5,RID,.01,"E")
+9 SET RABBR=$$GET1^DIQ(232.5,RID,.02,"E")
+10 SET @ARRAY@("report",CNT,"role",RID,"id")=RID
+11 SET @ARRAY@("report",CNT,"role",RID,"name")=RNAME
+12 SET @ARRAY@("report",CNT,"role",RID,"abbreviation")=RABBR
End DoDot:1
+13 IF $GET(PARAM("elements"))="true"!($GET(PARAM("id"))>0)
Begin DoDot:1
+14 SET EIEN=0
FOR
SET EIEN=$ORDER(^EDPB(232.1,IEN,1,EIEN))
if 'EIEN
QUIT
Begin DoDot:2
+15 SET E0=$GET(^EDPB(232.1,IEN,1,EIEN,0))
+16 SET ESEQ=$PIECE(E0,U)
SET EPTR=$PIECE(E0,U,2)
+17 SET @ARRAY@("report",CNT,"element",EIEN,"sequence")=ESEQ
+18 SET @ARRAY@("report",CNT,"element",EIEN,"id")=EPTR
+19 SET @ARRAY@("report",CNT,"element",EIEN,"name")=$$GET1^DIQ(232.11,EPTR,.01,"E")
End DoDot:2
End DoDot:1
+20 QUIT
SAVE(EDPXML,P1,P2) ; save report definition
+1 NEW X,ID,NAME,REMOVE,IENS,INACTIVE,EDITABLE,ELEM,EIENS,ROLE,RIENS,ERR,NEWIEN,NIEN
+2 IF '$DATA(P1)
QUIT
+3 SET ID=$GET(P1("id"))
SET NAME=$GET(P1("name"))
+4 SET REMOVE=$GET(P1("remove"))
SET REMOVE=$SELECT(REMOVE="true":1,1:0)
+5 ; convert inactive and editable values to internal
+6 SET INACTIVE=$GET(P1("inactive"))
SET INACTIVE=$SELECT(INACTIVE="true":1,1:0)
+7 SET EDITABLE=$GET(P1("editable"))
SET EDITABLE=$SELECT(INACTIVE="true":1,1:0)
+8 ; if remove and an id is sent, delete the entry and quit
+9 IF ID'=""
IF REMOVE
SET FDA(232.1,ID_",",.01)="@"
DO FILE^DIE(,"FDA")
KILL FDA
DO SUCCESS(EDPXML,"<status>deleted</status>")
QUIT
+10 SET IENS=$SELECT(ID="":"+1,",1:ID_",")
+11 KILL FDA
+12 SET FDA(232.1,IENS,.01)=NAME
+13 SET FDA(232.1,IENS,.02)=INACTIVE
+14 SET FDA(232.1,IENS,.03)=EDITABLE
+15 ; if there is no id, then we are adding a new entry
+16 IF 'ID
Begin DoDot:1
+17 DO UPDATE^DIE(,"FDA","NEWIEN","ERR")
+18 IF $DATA(ERR)
DO WSERR^EDPBWS("An error occured while filing a new entry.")
QUIT
+19 SET NIEN=$ORDER(NEWIEN(0))
SET NIEN=$GET(NEWIEN(NIEN))
+20 DO REPMULTS(NIEN,.P2)
+21 SET P1("id")=NIEN
SET P1("elements")="true"
DO GETREPL(EDPXML,.P1)
End DoDot:1
QUIT
+22 ; if editing an entry (ID is defined), loop through the multiples and clear them out so they can be rebuilt
+23 SET ELEM=0
FOR
SET ELEM=$ORDER(^EDPB(232.1,ID,1,ELEM))
if 'ELEM
QUIT
Begin DoDot:1
+24 SET EIENS=ELEM_","_ID_","
+25 SET FDA(232.12,EIENS,.01)="@"
DO FILE^DIE(,"FDA")
KILL FDA
End DoDot:1
+26 SET ROLE=0
FOR
SET ROLE=$ORDER(^EDPB(232.1,ID,1,ROLE))
if 'ROLE
QUIT
Begin DoDot:1
+27 SET RIENS=ROLE_","_ID_","
+28 SET FDA(232.13,RIENS,.01)="@"
DO FILE^DIE(,"FDA")
KILL FDA
End DoDot:1
+29 ; now file the data for 232.1 main file
+30 DO FILE^DIE(,"FDA")
KILL FDA
+31 DO REPMULTS(NIEN,.P2)
+32 SET P1("id")=NIEN
SET P1("elements")="true"
DO GETREPL(EDPXML,.P1)
+33 QUIT
REPMULTS(IEN,PARAMS) ; update the 'display elements' and 'roles multiples
+1 NEW ROLES,ELEMS,SEQ,LSEQ,ID,X,RLOOP
+2 ; loop through elements and order them in an array
+3 SET X=0
FOR
SET X=$ORDER(PARAMS("element",X))
if 'X
QUIT
Begin DoDot:1
+4 SET ID=$PIECE(PARAMS("element",X),U)
SET SEQ=$PIECE(PARAMS("element",X),U,2)
+5 SET ELEMS(SEQ)=ID
End DoDot:1
+6 SET LSEQ=0
FOR
SET LSEQ=$ORDER(ELEMS(LSEQ))
if 'LSEQ
QUIT
Begin DoDot:1
+7 SET FDA(232.12,"+1,"_IEN_",",.01)=LSEQ
+8 SET FDA(232.12,"+1,"_IEN_",",.02)=$GET(ELEMS(LSEQ))
+9 DO UPDATE^DIE(,"FDA")
KILL FDA
End DoDot:1
+10 ; order of the roles are not important, we can just file them
+11 SET RLOOP=0
FOR
SET RLOOP=$ORDER(PARAMS("role",RLOOP))
if 'RLOOP
QUIT
Begin DoDot:1
+12 SET FDA(232.13,"+1,"_IEN_",",.01)=$GET(PARAMS("role",RLOOP))
+13 DO UPDATE^DIE(,"FDA")
KILL FDA
End DoDot:1
+14 QUIT
SUCCESS(EDPXML,DATA) ;
+1 NEW EDPCNT
+2 SET EDPCNT=0
DO XMLG^EDPX(DATA,EDPCNT,EDPXML)
+3 QUIT
GETELM(EDPXML,P1,P2) ; get report element list
+1 NEW IEN,EDPRES,ARRAY,CNT
+2 SET EDPRES=$NAME(^TMP("EDPARPT",$JOB))
KILL @EDPRES
+3 SET ARRAY=$NAME(^TMP("EDPARPT",$JOB,"reportElements",1))
KILL @ARRAY
+4 SET (IEN,CNT)=0
FOR
SET IEN=$ORDER(^EDPB(232.11,IEN))
if 'IEN
QUIT
Begin DoDot:1
+5 SET CNT=CNT+1
+6 SET @ARRAY@("element",CNT,"id")=IEN
+7 SET @ARRAY@("element",CNT,"name")=$$GET1^DIQ(232.11,IEN,.01,"E")
End DoDot:1
+8 DO TOXMLG^EDPXML(EDPRES,EDPXML)
+9 QUIT
TESTEXE ;
+1 SET P1("start")=2980101
+2 SET P1("id")=1
+3 SET EDPSITE=807
+4 SET EDPXML=$NAME(^TMP("EDPGLOB",$JOB))
KILL @EDPXML
+5 DO EXE^EDPARPT(EDPXML,.P1)
+6 QUIT
+7 ; input
+8 ; EDPXML - $NA of global array where XML will be stored
+9 ; P1 - single diminsional array that contains top level data
+10 ; P2 - multiple diminsion array that contains 'custom' report structure
EXE(EDPXML,P1,P2) ; execute a report
+1 NEW RID,EDPRES,ARRAY,EID,E0,ESEQ,EPTR,EARRY,CSV,CSVARRY,ELOOP
+2 SET EDPRES=$NAME(^TMP("EDPARPT",$JOB))
KILL @EDPRES
+3 SET ARRAY=$NAME(^TMP("EDPARPT",$JOB,"records",1))
KILL @ARRAY
+4 SET XMLARRY=$NAME(^TMP("EDPARPT",$JOB,"logEntries",1))
KILL @XMLARRY
+5 SET CSVARRY=$NAME(^TMP("EDPARPT",$JOB,"CSV"))
KILL @CSVARRY
+6 ; set report id
SET RID=$GET(P1("id"))
+7 SET CSV=$GET(P1("csv"))
SET CSV=$SELECT(CSV="true":1,1:0)
SET CNT=0
+8 ; if report 'id' is passed in, build the sequence and definition information
+9 IF RID
Begin DoDot:1
+10 SET EID=0
FOR
SET EID=$ORDER(^EDPB(232.1,RID,1,EID))
if 'EID
QUIT
Begin DoDot:2
+11 SET E0=$GET(^EDPB(232.1,RID,1,EID,0))
SET ESEQ=$PIECE(E0,U)
SET EPTR=$PIECE(E0,U,2)
+12 SET EARRY(ESEQ)=EPTR_U_$$EDAT(EPTR)
End DoDot:2
End DoDot:1
+13 ; loop through 'custom' definition (P2) and build EARRY(SEQ)
+14 IF 'RID
Begin DoDot:1
+15 SET ELOOP=0
FOR
SET ELOOP=$ORDER(P2("element",ELOOP))
if 'ELOOP
QUIT
Begin DoDot:2
+16 SET EPTR=$PIECE(P2("element",ELOOP),U)
+17 SET ESEQ=$PIECE(P2("element",ELOOP),U,2)
+18 SET EARRY(ESEQ)=EPTR_U_$$EDAT(EPTR)
End DoDot:2
End DoDot:1
+19 DO SRCH(EDPXML,XMLARRY,CSVARRY,EDPRES,ARRAY,.EARRY,.P1,CSV)
+20 IF '$GET(CSV)
DO TOXMLG^EDPXML(XMLARRY,EDPXML)
+21 ;I $G(CSV) D TOXMLG^EDPXML(CSVARRY,EDPXML)
+22 KILL @EDPRES,@ARRAY,@XMLARRY,@CSVARRY
+23 QUIT
+24 ; using search criteria (from parameters), search the ED log entries.
SRCH(EDPXML,XMLARRY,CSVARRY,EDPRES,ARRAY,EARRY,P1,CSV) ;
+1 NEW LOGTIME,LOGID,START,STOP,RES,PROV,PAT,CNT,AREA
+2 ; check for parameters
+3 ;S CSV=$G(P1,"csv"),CSV=$S(CSV="true":1,1:0),CNT=0
+4 ; if no start date is passed, look back 30 days???
+5 SET START=$GET(P1("start"))
IF 'START
SET START=$$FMADD^XLFDT(DT,-30)
+6 ; if no stop date is passed, set the stop to NOW
+7 SET STOP=$GET(P1("stop"))
IF 'STOP
SET STOP=$$NOW^XLFDT
+8 SET RES=$GET(P1("resident"))
SET PROV=$GET(P1("provider"))
SET PAT=$GET(P1("patient"))
+9 SET AREA=$GET(P1("area"))
+10 ; loop through the ED LOG file to get the needed data
+11 SET LOGTIME=START-.000001
FOR
SET LOGTIME=$ORDER(^EDP(230,"ATI",EDPSITE,LOGTIME))
if 'LOGTIME
QUIT
Begin DoDot:1
+12 SET LOGID=0
FOR
SET LOGID=$ORDER(^EDP(230,"ATI",EDPSITE,LOGTIME,LOGID))
if 'LOGID
QUIT
Begin DoDot:2
+13 ; if patient is passed as a parameter, and it doesn't match, quit
+14 IF PAT
IF PAT'=$$GET1^DIQ(230,LOGID,.06,"I")
QUIT
+15 ; if provider or resident are passed and this entry is not for the provider/resident, quit
+16 ;I PROV,'$$CHKHLOG(LOGID,3.5,PROV) Q
+17 ;I RES,'$$CHKHLOG(LOGID,3.7,RES) Q
+18 SET CNT=$GET(CNT)+1
+19 DO BUILD(EDPXML,XMLARRY,CSVARRY,LOGID,CNT,EDPRES,ARRAY,.EARRY,CSV,AREA)
End DoDot:2
End DoDot:1
+20 QUIT
BUILD(EDPXML,XMLARRY,CSVARRY,LOGID,CNT,EDPRES,ARRAY,EARRY,CSV,AREA) ; Output requested fields from log ID.
+1 NEW ESEQ,EPTR,LFIL,HFIL,LFLD,HFLD,TAB,SARRY,E0,LOOP,ICNT,EXE,IARRY,VAL,XHDR,DCNT,XMLLINE,XMLCNT,FHDR,DCNT,HDR,LOGIEN,FORMAT
+2 ; if there is a reportID, grab the structure for the EDP REPORT TEMPLATE file and process
+3 SET LFIL=230
SET HFIL=230.1
SET TAB=$CHAR(9)
SET CSVCNT=0
+4 ; create temporary storage array for data. this will be used to aggregate the data
+5 SET SARRY=$NAME(^TMP("EDPARPT",$JOB,"BUILD"))
KILL @SARRY
+6 ; get the main ED LOG (#230) ien
+7 IF $GET(CSV)
SET $PIECE(FHDR,TAB,1)="logID"
+8 SET ESEQ=0
FOR
SET ESEQ=$ORDER(EARRY(ESEQ))
if 'ESEQ
QUIT
Begin DoDot:1
+9 SET E0=$GET(EARRY(ESEQ))
+10 SET EIEN=$PIECE(E0,U)
SET LFLD=$PIECE(E0,U,4)
SET HFLD=$PIECE(E0,U,5)
SET HDR=$PIECE(E0,U,6)
+11 SET EXE=$$GET1^DIQ(232.11,EIEN,2,"E")
SET EXE=$TRANSLATE(EXE,"|","^")
+12 SET FORMAT=$$GET1^DIQ(232.11,EIEN,1,"E")
SET FORMAT=$TRANSLATE(FORMAT,"|","^")
+13 ; set up header if CSV
IF $GET(CSV)
SET $PIECE(FHDR,TAB,ESEQ+1)=HDR
+14 ; if EXE is defined, use it. If it is not defined for this element, a simple $$GET1^DIQ will suffice
+15 ; EXE is intended for complex elements, such as data that can be a multiple or needs to be calculated.
+16 ; EXE has two values that can be potentially returned. VAL and IARRAY
+17 ; after EXE has been executed, FORMAT may be used (if available and applicable) to properly format the data for display to the UI.
+18 IF '$LENGTH(EXE)
Begin DoDot:2
+19 SET VAL=$$GET1^DIQ(230,LOGID,LFLD,"E")
+20 IF $LENGTH(FORMAT)
XECUTE FORMAT
+21 SET @SARRY@(LOGID,EIEN,ESEQ,1)=$$ESC^EDPX(VAL)
KILL VAL
End DoDot:2
+22 ; if there is executable logic, run it and process results
+23 IF $LENGTH(EXE)
Begin DoDot:2
+24 KILL IARRY,VAL
XECUTE EXE
+25 IF $DATA(VAL)
Begin DoDot:3
+26 ; format the data if there is formatting logic
+27 IF $LENGTH(FORMAT)
XECUTE FORMAT
+28 SET @SARRY@(LOGID,EIEN,ESEQ,1)=$$ESC^EDPX($GET(VAL))
KILL VAL
End DoDot:3
QUIT
+29 IF $ORDER(IARRY(0))
Begin DoDot:3
+30 SET ICNT=0
SET LOOP=0
FOR
SET LOOP=$ORDER(IARRY(LOOP))
if 'LOOP
QUIT
Begin DoDot:4
+31 SET ICNT=ICNT+1
+32 ; format the data if there is formatting logic
+33 SET VAL=$GET(IARRY(LOOP))
IF $LENGTH(FORMAT)
XECUTE FORMAT
+34 SET @SARRY@(LOGID,EIEN,ESEQ,ICNT)=$$ESC^EDPX(VAL)
KILL VAL
End DoDot:4
End DoDot:3
+35 ; if no data is returned, we need to at least set the 1 node to null so the header will appear
+36 IF '$ORDER(IARRY(0))
SET @SARRY@(LOGID,EIEN,ESEQ,1)=""
+37 KILL IARRY
End DoDot:2
End DoDot:1
+38 ; if CSV, build it, clean up and quit
+39 IF $GET(CSV)
DO BLDCSV(EDPXML,SARRY,CSVARRY,TAB,FHDR)
KILL @SARRY
QUIT
+40 ; if not CSV, build XML
+41 SET LOGIEN=0
FOR
SET LOGIEN=$ORDER(@SARRY@(LOGIEN))
if 'LOGIEN
QUIT
Begin DoDot:1
+42 ;I $G(CSV) S CSVCNT=$G(CSVCNT)+1
+43 SET EIEN=0
FOR
SET EIEN=$ORDER(@SARRY@(LOGIEN,EIEN))
if 'EIEN
QUIT
Begin DoDot:2
+44 SET ESEQ=0
FOR
SET ESEQ=$ORDER(@SARRY@(LOGIEN,EIEN,ESEQ))
if 'ESEQ
QUIT
Begin DoDot:3
+45 SET XHDR=$PIECE(EARRY(ESEQ),U,6)
+46 SET @XMLARRY@("logEntries",1,"logEntry",LOGIEN,"id")=LOGIEN
+47 SET @XMLARRY@("logEntries",1,"logEntry",LOGIEN,"elements",1,"element",ESEQ,"sequence")=ESEQ
+48 SET @XMLARRY@("logEntries",1,"logEntry",LOGIEN,"elements",1,"element",ESEQ,"header")=XHDR
+49 SET DCNT=0
FOR
SET DCNT=$ORDER(@SARRY@(LOGIEN,EIEN,ESEQ,DCNT))
if 'DCNT
QUIT
Begin DoDot:4
+50 SET @XMLARRY@("logEntries",1,"logEntry",LOGIEN,"elements",1,"element",ESEQ,"data",DCNT,"value")=$GET(@SARRY@(LOGIEN,EIEN,ESEQ,DCNT))
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+51 ; kill off the aggregation global array
+52 KILL @SARRY
+53 QUIT
+54 ;
BLDCSV(EDPXML,SARRY,CSVARRY,TAB,FHDR) ;
+1 NEW LIEN,EIEN,ESEQ,CSVCNT,ECNT
+2 SET CSVCNT=0
+3 ; build the header and include CR/LF
DO ADDG^EDPCSV(FHDR_$CHAR(13)_$CHAR(10),.CSVCNT,EDPXML)
+4 SET LIEN=0
FOR
SET LIEN=$ORDER(@SARRY@(LIEN))
if 'LIEN
QUIT
Begin DoDot:1
+5 SET EIEN=0
FOR
SET EIEN=$ORDER(@SARRY@(LIEN,EIEN))
if 'EIEN
QUIT
Begin DoDot:2
+6 SET ESEQ=0
FOR
SET ESEQ=$ORDER(@SARRY@(LIEN,EIEN,ESEQ))
if 'ESEQ
QUIT
Begin DoDot:3
+7 SET ECNT=0
FOR
SET ECNT=$ORDER(@SARRY@(LIEN,EIEN,ESEQ,ECNT))
if 'ECNT
QUIT
Begin DoDot:4
+8 SET $PIECE(@CSVARRY@(LIEN,ECNT),TAB,1)=LIEN
+9 SET $PIECE(@CSVARRY@(LIEN,ECNT),TAB,ESEQ+1)=$GET(@SARRY@(LIEN,EIEN,ESEQ,ECNT))
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+10 SET LIEN=0
FOR
SET LIEN=$ORDER(@CSVARRY@(LIEN))
if 'LIEN
QUIT
Begin DoDot:1
+11 SET ECNT=0
FOR
SET ECNT=$ORDER(@CSVARRY@(LIEN,ECNT))
if 'ECNT
QUIT
Begin DoDot:2
+12 ; build the line and include CR/LF
DO ADDG^EDPCSV($GET(@CSVARRY@(LIEN,ECNT))_$CHAR(13)_$CHAR(10),.CSVCNT,EDPXML)
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
+15 ; check to see if a resident or provider has ever been assigned to this patient
+16 ; input
+17 ; LOGID - log entry id from file 230
+18 ; FLD - cooresponding field to check data against.
+19 ; VAL - value to test for
CHKHLOG(LOGID,FLD,VAL) ;
+1 NEW LTIME,FOUND,HLID
+2 SET FOUND=0
+3 SET LTIME=0
FOR
SET LTIME=$ORDER(^EDP(230.1,"ADF",LOGID,LTIME))
if 'LTIME
QUIT
Begin DoDot:1
+4 SET HLID=0
FOR
SET HLID=$ORDER(^EDP(230.1,"ADF",LOGID,LTIME,HLID))
if 'HLID
QUIT
Begin DoDot:2
+5 IF $$GET1^DIQ(230.1,HLID,FLD,"I")=VAL
SET FOUND=1
End DoDot:2
End DoDot:1
+6 QUIT FOUND
+7 ;
EDAT(IEN) ; return element zero node data
+1 if 'IEN
QUIT ""
+2 QUIT $GET(^EDPB(232.11,IEN,0))
