Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: EDPQLP

EDPQLP.m

Go to the documentation of this file.
  1. EDPQLP ;SLC/KCM - Log Entry Patients ;2/28/12 08:33am
  1. ;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
  1. ;
  1. GET(AREA,TOKEN) ; Return lists for edit context
  1. ;
  1. ; don't rebuild the list if it is unchanged
  1. ;I $G(^EDPB(231.9,AREA,230))=TOKEN D Q
  1. ;. D XML^EDPX("<logEntries status='same' />")
  1. ;
  1. ; build sequence based on bed sequence
  1. N IEN,X0,NAME,SSN,LAST4,BED,SEQ,DUP,LST,DFN
  1. D BLDDUP(.DUP,AREA)
  1. S IEN=0 F S IEN=$O(^EDP(230,"AC",EDPSITE,AREA,IEN)) Q:'IEN D
  1. . S X0=^EDP(230,IEN,0)
  1. . S NAME=$P(X0,U,4),LAST4=$P(X0,U,11),DFN=$P(X0,U,6)
  1. . S SSN="" I DFN S SSN=$P(^DPT(DFN,0),U,9)
  1. . S BED=$P($G(^EDP(230,IEN,3)),U,4)
  1. . S SEQ=0
  1. . I BED S SEQ=$P($G(^EDPB(231.8,BED,0)),U,5)
  1. . I 'SEQ S SEQ=999999
  1. . I BED S BED=$P(^EDPB(231.8,BED,0),U,6)
  1. . S LST(SEQ,IEN)=NAME_U_SSN_U_LAST4_U_BED_U_$$SIM(NAME,LAST4,.DUP)
  1. ;
  1. D XML^EDPX("<logEntries status='new' token='"_$G(^EDPB(231.9,AREA,230))_"' >")
  1. S SEQ=0 F S SEQ=$O(LST(SEQ)) Q:'SEQ D
  1. . S IEN=0 F S IEN=$O(LST(SEQ,IEN)) Q:'IEN D
  1. . . S X("id")=IEN
  1. . . S X("seq")=SEQ
  1. . . S X("name")=$P(LST(SEQ,IEN),U)
  1. . . S X("ssn")=$P(LST(SEQ,IEN),U,2)
  1. . . S X("last4")=$P(LST(SEQ,IEN),U,3)
  1. . . S X("bed")=$P(LST(SEQ,IEN),U,4)
  1. . . S X("same")=$P(LST(SEQ,IEN),U,5)
  1. . . D XML^EDPX($$XMLA^EDPX("log",.X))
  1. D XML^EDPX("</logEntries>")
  1. Q
  1. BLDDUP(DUP,AREA) ; Build duplicate name/last4 counters
  1. ; called from GET^EDPQLP, GET^EDPQDB -- expect EDPSITE
  1. N X,IEN,CNT
  1. S X="" F S X=$O(^EDP(230,"ADUP",EDPSITE,AREA,X)) Q:X="" D
  1. . S IEN=0,CNT=0
  1. . F S IEN=$O(^EDP(230,"ADUP",EDPSITE,AREA,X,IEN)) Q:'IEN S CNT=CNT+1
  1. . S DUP(X)=CNT
  1. Q
  1. SIM(NAME,LAST4,DUP) ; Return true if similar patient name/last4
  1. I $L(LAST4),$G(DUP(LAST4))>1 Q 1
  1. I $L(NAME),$G(DUP($P(NAME,",")))>1 Q 1
  1. Q 0
  1. ;
  1. CLOSED(AREA,PARTIAL) ; find matches on name
  1. S PARTIAL=$$UP^XLFSTR(PARTIAL)
  1. Q:PARTIAL=""
  1. ;
  1. I PARTIAL?1U4N D BS5(PARTIAL) G XCLOSED
  1. I PARTIAL?9N.1U D SSN(PARTIAL) G XCLOSED
  1. I PARTIAL?1.2N1"/"1.2N1"/"2.4N D DAY(PARTIAL) G XCLOSED
  1. I PARTIAL?1"T"1"-"1.4N D DAY(PARTIAL) G XCLOSED
  1. I (PARTIAL="TODAY") D DAY(PARTIAL) ; fall thru LNAM in case TODAY is a name
  1. D LNAM(PARTIAL)
  1. ;
  1. XCLOSED ; exit case statement
  1. Q
  1. ;
  1. BS5(X) ; find matches by last inital, last 4
  1. N DFN,IEN
  1. S DFN=0 F S DFN=$O(^DPT("BS5",X,DFN)) Q:'DFN D
  1. . S IEN=0 F S IEN=$O(^EDP(230,"PDFN",EDPSITE,AREA,DFN,IEN)) Q:'IEN D ADDVST(IEN)
  1. Q
  1. SSN(X) ; find matches by SSN
  1. N DFN,IEN
  1. S DFN=0 F S DFN=$O(^DPT("SSN",X,DFN)) Q:'DFN D
  1. . S IEN=0 F S IEN=$O(^EDP(230,"PDFN",EDPSITE,AREA,DFN,IEN)) Q:'IEN D ADDVST(IEN)
  1. Q
  1. DAY(X) ; find matches by DATE
  1. N %DT,Y,DTOUT,END,INTS
  1. D ^%DT
  1. S INTS=$P(Y,"."),END=INTS_".999999"
  1. Q:INTS'>0
  1. F S INTS=$O(^EDP(230,"ATI",EDPSITE,INTS)) Q:'INTS Q:INTS>END D
  1. . S IEN=0 F S IEN=$O(^EDP(230,"ATI",EDPSITE,INTS,IEN)) Q:'IEN D
  1. . . Q:$P(^EDP(230,IEN,0),U,3)'=AREA
  1. . . D ADDVST(IEN)
  1. Q
  1. LNAM(PARTIAL) ; find matches by name
  1. N IEN,NAME,X,X0
  1. S NAME=$O(^EDP(230,"PN",EDPSITE,AREA,PARTIAL),-1)
  1. F S NAME=$O(^EDP(230,"PN",EDPSITE,AREA,NAME)) Q:$E(NAME,1,$L(PARTIAL))'=PARTIAL Q:NAME="" D
  1. . S IEN=0 F S IEN=$O(^EDP(230,"PN",EDPSITE,AREA,NAME,IEN)) Q:'IEN D ADDVST(IEN)
  1. Q
  1. ADDVST(IEN) ; add node for visit
  1. N X0,X,NAME
  1. S X0=^EDP(230,IEN,0),NAME=$P(X0,U,4)
  1. I '$P(X0,U,7) Q ; not closed
  1. S X("id")=IEN,X("name")=NAME,X("inTS")=$P(X0,U,8)
  1. D XML^EDPX($$XMLA^EDPX("visit",.X))
  1. Q