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

EDPFPTC.m

Go to the documentation of this file.
  1. EDPFPTC ;SLC/MKB - Patient look-up Utilities at Facility ;4/16/13 12:24pm
  1. ;;2.0;EMERGENCY DEPARTMENT;**5**;May 2, 2012;Build 18
  1. ;
  1. CHK(AREA,DFN,NAME) ; perform patient select checks
  1. ;
  1. ; check for active on board
  1. N IEN,X0,CHK S NAME=$$UP^XLFSTR(NAME)
  1. S IEN=0 F S IEN=$O(^EDP(230,"AC",EDPSITE,AREA,IEN)) Q:'IEN D Q:$D(CHK("onBoard"))
  1. . S X0=^EDP(230,IEN,0)
  1. . I DFN,($P(X0,U,6)=DFN) S CHK("onBoard")=$P(^DPT(DFN,0),U)
  1. . I 'DFN,($E(NAME,1,10)'="(AMBULANCE"),($$UP^XLFSTR($P(X0,U,4))=NAME) S CHK("onBoard")=NAME
  1. ;
  1. ; stop here if no DFN
  1. I 'DFN D Q
  1. . S CHK("sensitive")=0,CHK("mayAccess")=1,CHK("logAccess")=0
  1. . D XML^EDPX($$XMLA^EDPX("checks",.CHK,"/"))
  1. ;
  1. ; check for sensitive record
  1. N EDPY,WARN,I,X
  1. D PTSEC^DGSEC4(.EDPY,DFN,1) ;IA #3027
  1. S CHK("dfn")=DFN
  1. S CHK("sensitive")=(EDPY(1)>0)
  1. S CHK("mayAccess")=(EDPY(1)<3)
  1. S CHK("logAccess")=(EDPY(1)>1)
  1. M WARN=EDPY K WARN(1)
  1. ;
  1. ; check for deceased patient
  1. N DIED S DIED=0
  1. I +$G(^DPT(DFN,.35)) D
  1. . S DIED(1)="This patient died on "_$$FMTE^XLFDT(^DPT(DFN,.35),"D")_"."
  1. . S DIED(2)="Do you wish to continue?"
  1. ;
  1. ; check for similar patients
  1. K EDPY
  1. N MSG,SIM S MSG=0,SIM=0
  1. D GUIBS5A^DPTLK6(.EDPY,DFN) ;IA #3593
  1. S CHK("similar")=(EDPY(1)>0)
  1. S I=1 F S I=$O(EDPY(I)) Q:'I S X=EDPY(I) D
  1. . I $E(X)=0 S MSG=MSG+1,MSG(MSG)=$P(X,U,2)
  1. . I $E(X)=1 D
  1. .. S X("dfn")=$P(X,U,2)
  1. .. S X("name")=$P(X,U,3)
  1. .. S X("dob")=$$FMTE^XLFDT($P(X,U,4),"D")
  1. .. S X("ssn")=$P(X,U,5)
  1. .. S SIM=SIM+1,SIM(SIM)=$$XMLA^EDPX("similar",.X,"/")
  1. ;
  1. ; possibly check means test: GUIMTD^DPTLK6
  1. ; possibly check legacy data: I $L($T(HXDATA^A7RDPAGU)...
  1. ;
  1. ; put it all together
  1. D XML^EDPX($$XMLA^EDPX("checks",.CHK,"/"))
  1. I $D(WARN) D
  1. . D XML^EDPX("<warning>")
  1. . S I=0 F S I=$O(WARN(I)) Q:'I D XML^EDPX(WARN(I))
  1. . I CHK("logAccess"),CHK("mayAccess") D XML^EDPX("Are you sure you wish to continue?")
  1. . D XML^EDPX("</warning>")
  1. S I=0 F S I=$O(SIM(I)) Q:'I D XML^EDPX(SIM(I))
  1. I $D(MSG) D
  1. . D XML^EDPX("<warnSimilar>")
  1. . S I=0 F S I=$O(MSG(I)) Q:'I D XML^EDPX(MSG(I))
  1. . D XML^EDPX("</warnSimilar>")
  1. I $D(DIED) D
  1. . D XML^EDPX("<died>")
  1. . S I=0 F S I=$O(DIED(I)) Q:'I D XML^EDPX(DIED(I))
  1. . D XML^EDPX("</died>")
  1. I CHK("mayAccess") D PRF(DFN)
  1. Q
  1. PRF(DFN) ; get Patient Record Flags
  1. N EDPY,EDI,PRF,N,X
  1. Q:$$GETACT^DGPFAPI(DFN,"EDPY")'>0
  1. D XML^EDPX("<patientRecordFlags>")
  1. S EDI=0 F S EDI=$O(EDPY(EDI)) Q:EDI<1 K PRF D
  1. . S PRF("assignmentStatus")="Active"
  1. . S PRF("assignTS")=$P($G(EDPY(EDI,"ASSIGNDT")),U)
  1. . S PRF("approved")=$P($G(EDPY(EDI,"APPRVBY")),U,2)
  1. . S PRF("nextReviewDT")=$P($G(EDPY(EDI,"REVIEWDT")),U)
  1. . S PRF("name")=$P($G(EDPY(EDI,"FLAG")),U,2)
  1. . S PRF("type")=$P($G(EDPY(EDI,"FLAGTYPE")),U,2)
  1. . S PRF("category")=$P($G(EDPY(EDI,"CATEGORY")),U,2)
  1. . S PRF("ownerSite")=$P($G(EDPY(EDI,"OWNER")),U,2)
  1. . S PRF("originatingSite")=$P($G(EDPY(EDI,"ORIGSITE")),U,2)
  1. . D XML^EDPX($$XMLA^EDPX("flag",.PRF,""))
  1. . D XML^EDPX("<text>")
  1. . S N=1,X=$G(EDPY(EDI,"NARR",1,0))
  1. . ;bwf - 4/16/2013 - replaced next line with one that follows to fix multiple flag/multiple line issues
  1. . ;F S N=$O(EDPY(EDI,"NARR",N)) Q:N<1 S X=X_$C(13,10)_$G(EDPY(EDI,"NARR",N,0))
  1. . F S N=$O(EDPY(EDI,"NARR",N)) Q:N<1 S X=$G(EDPY(EDI,"NARR",N,0)) D XML^EDPX($$ESC^EDPX(X))
  1. . ;bwf - 4/16/2013 - removed line due to multiple flag issues
  1. . ;D XML^EDPX("<text>"_$$ESC^EDPX(X)_"</text>")
  1. . ;bwf 4/16/2013 - added following line to build footer for patient record flag issues.
  1. . D XML^EDPX("</text>")
  1. . D XML^EDPX("</flag>")
  1. D XML^EDPX("</patientRecordFlags>")
  1. Q
  1. ;
  1. LOG(DFN) ; Make entry in security log for sensitive patient access
  1. N EDPY,X
  1. D NOTICE^DGSEC4(.EDPY,DFN) ;IA #3027
  1. S X=$S(EDPY:"ok",1:"fail")
  1. D XML^EDPX("<save status='"_X_"' />")
  1. Q
  1. ;
  1. TEST ;
  1. S EDPSITE=$$IEN^XUAF4(442),NAME="doe,john"
  1. D CHK(1,"",NAME)
  1. ;N PID S EDPSITE=$$IEN^XUAF4(442)
  1. ;R "DFN:",PID Q:PID="" W !
  1. ;D CHK(1,PID,$P(^DPT(PID,0),U))
  1. N I S I=0 F S I=$O(EDPXML(I)) Q:'I W !,EDPXML(I)
  1. K EDPXML
  1. Q
  1. TEST1 ;
  1. S EDPSITE=$$IEN^XUAF4(442),NAME="doe,john"
  1. D CHK(1,"",NAME)
  1. ;
  1. ;DO LATER? -- linked progress notes
  1. ;D GETTITLE^TIUPRF2(.EDPT,DFN,EDI),GETNOTES^TIUPRF2(.EDPN,DFN,EDPT,1)
  1. ;I $O(EDPN(0)) D
  1. ;. D XML^EDPX("<notes>")
  1. ;. S N=0 F S N=$O(EDPN(N)) Q:N<1 K PN S X=EDPN(N) D
  1. ;.. S PN("id")=+X,PN("action")=$P(X,U,2),PN("author")=$P(X,U,4)
  1. ;.. S PN("noteTS")=9999999-N
  1. ;.. D TGET^TIUSRVR1(.EDPX,+X)
  1. ;.. S X=$$XMLA^EDPX("note",.PN),X=$TR(X,"/") D XML^EDPX(X)
  1. ;.. S I=1,X=$G(@EDPX@(1))
  1. ;.. F S I=$O(@EDPX@(I)) Q:I<1 S X=X_$C(13,10)_$G(@EDPX@(I))
  1. ;.. S X="<text>"_$$ESC^EDPX(X)_"</text>" D XML^EDPX(X)
  1. ;.. D XML^EDPX("</note>")
  1. ;. D XML^EDPX("</notes>")