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