EDPQLP ;SLC/KCM - Log Entry Patients ;2/28/12 08:33am
;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
;
GET(AREA,TOKEN) ; Return lists for edit context
;
; don't rebuild the list if it is unchanged
;I $G(^EDPB(231.9,AREA,230))=TOKEN D Q
;. D XML^EDPX("<logEntries status='same' />")
;
; build sequence based on bed sequence
N IEN,X0,NAME,SSN,LAST4,BED,SEQ,DUP,LST,DFN
D BLDDUP(.DUP,AREA)
S IEN=0 F S IEN=$O(^EDP(230,"AC",EDPSITE,AREA,IEN)) Q:'IEN D
. S X0=^EDP(230,IEN,0)
. S NAME=$P(X0,U,4),LAST4=$P(X0,U,11),DFN=$P(X0,U,6)
. S SSN="" I DFN S SSN=$P(^DPT(DFN,0),U,9)
. S BED=$P($G(^EDP(230,IEN,3)),U,4)
. S SEQ=0
. I BED S SEQ=$P($G(^EDPB(231.8,BED,0)),U,5)
. I 'SEQ S SEQ=999999
. I BED S BED=$P(^EDPB(231.8,BED,0),U,6)
. S LST(SEQ,IEN)=NAME_U_SSN_U_LAST4_U_BED_U_$$SIM(NAME,LAST4,.DUP)
;
D XML^EDPX("<logEntries status='new' token='"_$G(^EDPB(231.9,AREA,230))_"' >")
S SEQ=0 F S SEQ=$O(LST(SEQ)) Q:'SEQ D
. S IEN=0 F S IEN=$O(LST(SEQ,IEN)) Q:'IEN D
. . S X("id")=IEN
. . S X("seq")=SEQ
. . S X("name")=$P(LST(SEQ,IEN),U)
. . S X("ssn")=$P(LST(SEQ,IEN),U,2)
. . S X("last4")=$P(LST(SEQ,IEN),U,3)
. . S X("bed")=$P(LST(SEQ,IEN),U,4)
. . S X("same")=$P(LST(SEQ,IEN),U,5)
. . D XML^EDPX($$XMLA^EDPX("log",.X))
D XML^EDPX("</logEntries>")
Q
BLDDUP(DUP,AREA) ; Build duplicate name/last4 counters
; called from GET^EDPQLP, GET^EDPQDB -- expect EDPSITE
N X,IEN,CNT
S X="" F S X=$O(^EDP(230,"ADUP",EDPSITE,AREA,X)) Q:X="" D
. S IEN=0,CNT=0
. F S IEN=$O(^EDP(230,"ADUP",EDPSITE,AREA,X,IEN)) Q:'IEN S CNT=CNT+1
. S DUP(X)=CNT
Q
SIM(NAME,LAST4,DUP) ; Return true if similar patient name/last4
I $L(LAST4),$G(DUP(LAST4))>1 Q 1
I $L(NAME),$G(DUP($P(NAME,",")))>1 Q 1
Q 0
;
CLOSED(AREA,PARTIAL) ; find matches on name
S PARTIAL=$$UP^XLFSTR(PARTIAL)
Q:PARTIAL=""
;
I PARTIAL?1U4N D BS5(PARTIAL) G XCLOSED
I PARTIAL?9N.1U D SSN(PARTIAL) G XCLOSED
I PARTIAL?1.2N1"/"1.2N1"/"2.4N D DAY(PARTIAL) G XCLOSED
I PARTIAL?1"T"1"-"1.4N D DAY(PARTIAL) G XCLOSED
I (PARTIAL="TODAY") D DAY(PARTIAL) ; fall thru LNAM in case TODAY is a name
D LNAM(PARTIAL)
;
XCLOSED ; exit case statement
Q
;
BS5(X) ; find matches by last inital, last 4
N DFN,IEN
S DFN=0 F S DFN=$O(^DPT("BS5",X,DFN)) Q:'DFN D
. S IEN=0 F S IEN=$O(^EDP(230,"PDFN",EDPSITE,AREA,DFN,IEN)) Q:'IEN D ADDVST(IEN)
Q
SSN(X) ; find matches by SSN
N DFN,IEN
S DFN=0 F S DFN=$O(^DPT("SSN",X,DFN)) Q:'DFN D
. S IEN=0 F S IEN=$O(^EDP(230,"PDFN",EDPSITE,AREA,DFN,IEN)) Q:'IEN D ADDVST(IEN)
Q
DAY(X) ; find matches by DATE
N %DT,Y,DTOUT,END,INTS
D ^%DT
S INTS=$P(Y,"."),END=INTS_".999999"
Q:INTS'>0
F S INTS=$O(^EDP(230,"ATI",EDPSITE,INTS)) Q:'INTS Q:INTS>END D
. S IEN=0 F S IEN=$O(^EDP(230,"ATI",EDPSITE,INTS,IEN)) Q:'IEN D
. . Q:$P(^EDP(230,IEN,0),U,3)'=AREA
. . D ADDVST(IEN)
Q
LNAM(PARTIAL) ; find matches by name
N IEN,NAME,X,X0
S NAME=$O(^EDP(230,"PN",EDPSITE,AREA,PARTIAL),-1)
F S NAME=$O(^EDP(230,"PN",EDPSITE,AREA,NAME)) Q:$E(NAME,1,$L(PARTIAL))'=PARTIAL Q:NAME="" D
. S IEN=0 F S IEN=$O(^EDP(230,"PN",EDPSITE,AREA,NAME,IEN)) Q:'IEN D ADDVST(IEN)
Q
ADDVST(IEN) ; add node for visit
N X0,X,NAME
S X0=^EDP(230,IEN,0),NAME=$P(X0,U,4)
I '$P(X0,U,7) Q ; not closed
S X("id")=IEN,X("name")=NAME,X("inTS")=$P(X0,U,8)
D XML^EDPX($$XMLA^EDPX("visit",.X))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPQLP 3398 printed Oct 16, 2024@17:53 Page 2
EDPQLP ;SLC/KCM - Log Entry Patients ;2/28/12 08:33am
+1 ;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
+2 ;
GET(AREA,TOKEN) ; Return lists for edit context
+1 ;
+2 ; don't rebuild the list if it is unchanged
+3 ;I $G(^EDPB(231.9,AREA,230))=TOKEN D Q
+4 ;. D XML^EDPX("<logEntries status='same' />")
+5 ;
+6 ; build sequence based on bed sequence
+7 NEW IEN,X0,NAME,SSN,LAST4,BED,SEQ,DUP,LST,DFN
+8 DO BLDDUP(.DUP,AREA)
+9 SET IEN=0
FOR
SET IEN=$ORDER(^EDP(230,"AC",EDPSITE,AREA,IEN))
if 'IEN
QUIT
Begin DoDot:1
+10 SET X0=^EDP(230,IEN,0)
+11 SET NAME=$PIECE(X0,U,4)
SET LAST4=$PIECE(X0,U,11)
SET DFN=$PIECE(X0,U,6)
+12 SET SSN=""
IF DFN
SET SSN=$PIECE(^DPT(DFN,0),U,9)
+13 SET BED=$PIECE($GET(^EDP(230,IEN,3)),U,4)
+14 SET SEQ=0
+15 IF BED
SET SEQ=$PIECE($GET(^EDPB(231.8,BED,0)),U,5)
+16 IF 'SEQ
SET SEQ=999999
+17 IF BED
SET BED=$PIECE(^EDPB(231.8,BED,0),U,6)
+18 SET LST(SEQ,IEN)=NAME_U_SSN_U_LAST4_U_BED_U_$$SIM(NAME,LAST4,.DUP)
End DoDot:1
+19 ;
+20 DO XML^EDPX("<logEntries status='new' token='"_$GET(^EDPB(231.9,AREA,230))_"' >")
+21 SET SEQ=0
FOR
SET SEQ=$ORDER(LST(SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+22 SET IEN=0
FOR
SET IEN=$ORDER(LST(SEQ,IEN))
if 'IEN
QUIT
Begin DoDot:2
+23 SET X("id")=IEN
+24 SET X("seq")=SEQ
+25 SET X("name")=$PIECE(LST(SEQ,IEN),U)
+26 SET X("ssn")=$PIECE(LST(SEQ,IEN),U,2)
+27 SET X("last4")=$PIECE(LST(SEQ,IEN),U,3)
+28 SET X("bed")=$PIECE(LST(SEQ,IEN),U,4)
+29 SET X("same")=$PIECE(LST(SEQ,IEN),U,5)
+30 DO XML^EDPX($$XMLA^EDPX("log",.X))
End DoDot:2
End DoDot:1
+31 DO XML^EDPX("</logEntries>")
+32 QUIT
BLDDUP(DUP,AREA) ; Build duplicate name/last4 counters
+1 ; called from GET^EDPQLP, GET^EDPQDB -- expect EDPSITE
+2 NEW X,IEN,CNT
+3 SET X=""
FOR
SET X=$ORDER(^EDP(230,"ADUP",EDPSITE,AREA,X))
if X=""
QUIT
Begin DoDot:1
+4 SET IEN=0
SET CNT=0
+5 FOR
SET IEN=$ORDER(^EDP(230,"ADUP",EDPSITE,AREA,X,IEN))
if 'IEN
QUIT
SET CNT=CNT+1
+6 SET DUP(X)=CNT
End DoDot:1
+7 QUIT
SIM(NAME,LAST4,DUP) ; Return true if similar patient name/last4
+1 IF $LENGTH(LAST4)
IF $GET(DUP(LAST4))>1
QUIT 1
+2 IF $LENGTH(NAME)
IF $GET(DUP($PIECE(NAME,",")))>1
QUIT 1
+3 QUIT 0
+4 ;
CLOSED(AREA,PARTIAL) ; find matches on name
+1 SET PARTIAL=$$UP^XLFSTR(PARTIAL)
+2 if PARTIAL=""
QUIT
+3 ;
+4 IF PARTIAL?1U4N
DO BS5(PARTIAL)
GOTO XCLOSED
+5 IF PARTIAL?9N.1U
DO SSN(PARTIAL)
GOTO XCLOSED
+6 IF PARTIAL?1.2N1"/"1.2N1"/"2.4N
DO DAY(PARTIAL)
GOTO XCLOSED
+7 IF PARTIAL?1"T"1"-"1.4N
DO DAY(PARTIAL)
GOTO XCLOSED
+8 ; fall thru LNAM in case TODAY is a name
IF (PARTIAL="TODAY")
DO DAY(PARTIAL)
+9 DO LNAM(PARTIAL)
+10 ;
XCLOSED ; exit case statement
+1 QUIT
+2 ;
BS5(X) ; find matches by last inital, last 4
+1 NEW DFN,IEN
+2 SET DFN=0
FOR
SET DFN=$ORDER(^DPT("BS5",X,DFN))
if 'DFN
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^EDP(230,"PDFN",EDPSITE,AREA,DFN,IEN))
if 'IEN
QUIT
DO ADDVST(IEN)
End DoDot:1
+4 QUIT
SSN(X) ; find matches by SSN
+1 NEW DFN,IEN
+2 SET DFN=0
FOR
SET DFN=$ORDER(^DPT("SSN",X,DFN))
if 'DFN
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^EDP(230,"PDFN",EDPSITE,AREA,DFN,IEN))
if 'IEN
QUIT
DO ADDVST(IEN)
End DoDot:1
+4 QUIT
DAY(X) ; find matches by DATE
+1 NEW %DT,Y,DTOUT,END,INTS
+2 DO ^%DT
+3 SET INTS=$PIECE(Y,".")
SET END=INTS_".999999"
+4 if INTS'>0
QUIT
+5 FOR
SET INTS=$ORDER(^EDP(230,"ATI",EDPSITE,INTS))
if 'INTS
QUIT
if INTS>END
QUIT
Begin DoDot:1
+6 SET IEN=0
FOR
SET IEN=$ORDER(^EDP(230,"ATI",EDPSITE,INTS,IEN))
if 'IEN
QUIT
Begin DoDot:2
+7 if $PIECE(^EDP(230,IEN,0),U,3)'=AREA
QUIT
+8 DO ADDVST(IEN)
End DoDot:2
End DoDot:1
+9 QUIT
LNAM(PARTIAL) ; find matches by name
+1 NEW IEN,NAME,X,X0
+2 SET NAME=$ORDER(^EDP(230,"PN",EDPSITE,AREA,PARTIAL),-1)
+3 FOR
SET NAME=$ORDER(^EDP(230,"PN",EDPSITE,AREA,NAME))
if $EXTRACT(NAME,1,$LENGTH(PARTIAL))'=PARTIAL
QUIT
if NAME=""
QUIT
Begin DoDot:1
+4 SET IEN=0
FOR
SET IEN=$ORDER(^EDP(230,"PN",EDPSITE,AREA,NAME,IEN))
if 'IEN
QUIT
DO ADDVST(IEN)
End DoDot:1
+5 QUIT
ADDVST(IEN) ; add node for visit
+1 NEW X0,X,NAME
+2 SET X0=^EDP(230,IEN,0)
SET NAME=$PIECE(X0,U,4)
+3 ; not closed
IF '$PIECE(X0,U,7)
QUIT
+4 SET X("id")=IEN
SET X("name")=NAME
SET X("inTS")=$PIECE(X0,U,8)
+5 DO XML^EDPX($$XMLA^EDPX("visit",.X))
+6 QUIT
