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

HMPFPTC.m

Go to the documentation of this file.
  1. HMPFPTC ;SLC/MKB,AGP,ASMR/RRB - Patient look-up Utilities at Facility;Nov 04, 2015 18:37:39
  1. ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**2**;Sep 01, 2011;Build 28
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. Q
  1. ;
  1. CHKS(HMPZ,DFN) ; perform patient select checks
  1. ;
  1. N ACCESS,CHKS,CNT,DEATHDT,ERR,I,IEN,STR,X,HMPY
  1. ; check for sensitive record
  1. S STR="patientChecks"
  1. S ACCESS=0
  1. D PTSEC^DGSEC4(.HMPY,DFN) ;IA #3027
  1. S ACCESS=1
  1. I HMPY(1)>0 D
  1. .S CHKS("sensitive","dfn")=DFN
  1. .S ACCESS=(HMPY(1)<3)
  1. .S CHKS("sensitive","mayAccess")=$S(ACCESS=1:"true",1:"false")
  1. .S CHKS("sensitive","logAccess")=$S(HMPY(1)>1:"true",1:"false")
  1. .S CNT=2,X=""
  1. .F S CNT=$O(HMPY(CNT)) Q:CNT'>0 S X=X_$C(13)_$C(10)_$G(HMPY(CNT))
  1. .S CHKS("sensitive","text")=X
  1. ;
  1. ; check for deceased patient, DE2818 changed from direct global reference
  1. D TOP^HMPXGDPT("DEATHDT",DFN,.351,"E")
  1. D:$L($G(DEATHDT(2,DFN,.351,"E")))
  1. . S CHKS("deceased","text")="This patient died on "_DEATHDT(2,DFN,.351,"E")_"."_$C(13)_$C(10)_" Do you wish to continue?"
  1. ;
  1. ; check for similar patients
  1. K HMPY
  1. N MSG,SIM,SIMPAT,TEXT S MSG=0,SIM=0
  1. D GUIBS5A^DPTLK6(.HMPY,DFN) ;IA #3593
  1. I HMPY(1)>0 D
  1. .S TEXT=""
  1. .S I=1 F S I=$O(HMPY(I)) Q:'I S X=HMPY(I) D
  1. .. S SIM=SIM+1
  1. .. I $E(X)=0 S TEXT=$S($L(TEXT):TEXT_$C(13)_$C(10)_$P(X,U,2),1:$P(X,U,2))
  1. .. I $E(X)=1 D
  1. ... ;S CHKS("similar",SIM,"dfn")=$P(X,U,2)
  1. ... ;S CHKS("similar",SIM,"name")=$P(X,U,3)
  1. ... ;S CHKS("similar",SIM,"dob")=$$FMTE^XLFDT($P(X,U,4),"D")
  1. ... ;S CHKS("similar",SIM,"ssn")=$P(X,U,5)
  1. ... S SIMPAT="Patient Name: "_$P(X,U,3)_" Date of Birth: "_$$FMTE^XLFDT($P(X,U,4),"D")_" SSN: "_$P(X,U,5)
  1. ... S TEXT=TEXT_$C(13)_$C(10)_SIMPAT
  1. .S CHKS("similar","text")=TEXT
  1. ;
  1. ; possibly check means test: GUIMTD^DPTLK6
  1. ; possibly check legacy data: I $L($T(HXDATA^A7RDPAGU)...
  1. ;
  1. I ACCESS D PRF(DFN,.CHKS)
  1. S ERR(0)=""
  1. ;S HMP=$$ENCODE^HMPJSON("CHKS","ERR")
  1. D ENCODE^HMPJSON("CHKS","HMPZ","ERR")
  1. Q
  1. ;
  1. PRF(DFN,CHKS) ; get Patient Record Flags
  1. N HMPY,EDI,PRF,N,X
  1. Q:$$GETACT^DGPFAPI(DFN,"HMPY")'>0
  1. S EDI=0 F S EDI=$O(HMPY(EDI)) Q:EDI<1 K PRF D
  1. . S CHKS("patientRecordFlags",EDI,"assignmentStatus")="Active"
  1. . S CHKS("patientRecordFlags",EDI,"assignTS")=$$JSONDT^HMPUTILS($P($G(HMPY(EDI,"ASSIGNDT")),U))
  1. . S CHKS("patientRecordFlags",EDI,"approved")=$P($G(HMPY(EDI,"APPRVBY")),U,2)
  1. . S CHKS("patientRecordFlags",EDI,"nextReviewDT")=$$JSONDT^HMPUTILS($P($G(HMPY(EDI,"REVIEWDT")),U))
  1. . S CHKS("patientRecordFlags",EDI,"name")=$P($G(HMPY(EDI,"FLAG")),U,2)
  1. . S CHKS("patientRecordFlags",EDI,"type")=$P($G(HMPY(EDI,"FLAGTYPE")),U,2)
  1. . S CHKS("patientRecordFlags",EDI,"category")=$P($G(HMPY(EDI,"CATEGORY")),U,2)
  1. . S CHKS("patientRecordFlags",EDI,"ownerSite")=$P($G(HMPY(EDI,"OWNER")),U,2)
  1. . S CHKS("patientRecordFlags",EDI,"originatingSite")=$P($G(HMPY(EDI,"ORIGSITE")),U,2)
  1. . S N=1,X=$G(HMPY(EDI,"NARR",1,0))
  1. . F S N=$O(HMPY(EDI,"NARR",N)) Q:N<1 S X=X_$C(13)_$C(10)_$G(HMPY(EDI,"NARR",N,0))
  1. . S CHKS("patientRecordFlags",EDI,"text")=X
  1. Q
  1. ;
  1. LOG(HMPZ,DFN) ; Make entry in security log for sensitive patient access
  1. N ERR,RESULTS,HMPY,X
  1. D NOTICE^DGSEC4(.HMPY,DFN) ;IA #3027
  1. S X=$S(HMPY:"ok",1:"fail")
  1. S RESULTS("result")=X
  1. ;S HMP=$$ENCODE^HMPJSON("RESULTS","ERR")
  1. D ENCODE^HMPJSON("RESULTS","HMPZ","ERR")
  1. Q
  1. ;
  1. ENROS(HMPZ,DFNARRAY) ;PROCESS PATIENTS FROM A ROSTER
  1. N DFN S DFN=0
  1. F S DFN=$O(DFNARRAY(DFN)) Q:DFN'>0 D CHKS(.HMPZ,DFN)
  1. Q
  1. ;