HMPFPTC ;SLC/MKB,AGP,ASMR/RRB - Patient look-up Utilities at Facility;Nov 04, 2015 18:37:39
;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**2**;Sep 01, 2011;Build 28
;Per VA Directive 6402, this routine should not be modified.
;
Q
;
CHKS(HMPZ,DFN) ; perform patient select checks
;
N ACCESS,CHKS,CNT,DEATHDT,ERR,I,IEN,STR,X,HMPY
; check for sensitive record
S STR="patientChecks"
S ACCESS=0
D PTSEC^DGSEC4(.HMPY,DFN) ;IA #3027
S ACCESS=1
I HMPY(1)>0 D
.S CHKS("sensitive","dfn")=DFN
.S ACCESS=(HMPY(1)<3)
.S CHKS("sensitive","mayAccess")=$S(ACCESS=1:"true",1:"false")
.S CHKS("sensitive","logAccess")=$S(HMPY(1)>1:"true",1:"false")
.S CNT=2,X=""
.F S CNT=$O(HMPY(CNT)) Q:CNT'>0 S X=X_$C(13)_$C(10)_$G(HMPY(CNT))
.S CHKS("sensitive","text")=X
;
; check for deceased patient, DE2818 changed from direct global reference
D TOP^HMPXGDPT("DEATHDT",DFN,.351,"E")
D:$L($G(DEATHDT(2,DFN,.351,"E")))
. S CHKS("deceased","text")="This patient died on "_DEATHDT(2,DFN,.351,"E")_"."_$C(13)_$C(10)_" Do you wish to continue?"
;
; check for similar patients
K HMPY
N MSG,SIM,SIMPAT,TEXT S MSG=0,SIM=0
D GUIBS5A^DPTLK6(.HMPY,DFN) ;IA #3593
I HMPY(1)>0 D
.S TEXT=""
.S I=1 F S I=$O(HMPY(I)) Q:'I S X=HMPY(I) D
.. S SIM=SIM+1
.. I $E(X)=0 S TEXT=$S($L(TEXT):TEXT_$C(13)_$C(10)_$P(X,U,2),1:$P(X,U,2))
.. I $E(X)=1 D
... ;S CHKS("similar",SIM,"dfn")=$P(X,U,2)
... ;S CHKS("similar",SIM,"name")=$P(X,U,3)
... ;S CHKS("similar",SIM,"dob")=$$FMTE^XLFDT($P(X,U,4),"D")
... ;S CHKS("similar",SIM,"ssn")=$P(X,U,5)
... S SIMPAT="Patient Name: "_$P(X,U,3)_" Date of Birth: "_$$FMTE^XLFDT($P(X,U,4),"D")_" SSN: "_$P(X,U,5)
... S TEXT=TEXT_$C(13)_$C(10)_SIMPAT
.S CHKS("similar","text")=TEXT
;
; possibly check means test: GUIMTD^DPTLK6
; possibly check legacy data: I $L($T(HXDATA^A7RDPAGU)...
;
I ACCESS D PRF(DFN,.CHKS)
S ERR(0)=""
;S HMP=$$ENCODE^HMPJSON("CHKS","ERR")
D ENCODE^HMPJSON("CHKS","HMPZ","ERR")
Q
;
PRF(DFN,CHKS) ; get Patient Record Flags
N HMPY,EDI,PRF,N,X
Q:$$GETACT^DGPFAPI(DFN,"HMPY")'>0
S EDI=0 F S EDI=$O(HMPY(EDI)) Q:EDI<1 K PRF D
. S CHKS("patientRecordFlags",EDI,"assignmentStatus")="Active"
. S CHKS("patientRecordFlags",EDI,"assignTS")=$$JSONDT^HMPUTILS($P($G(HMPY(EDI,"ASSIGNDT")),U))
. S CHKS("patientRecordFlags",EDI,"approved")=$P($G(HMPY(EDI,"APPRVBY")),U,2)
. S CHKS("patientRecordFlags",EDI,"nextReviewDT")=$$JSONDT^HMPUTILS($P($G(HMPY(EDI,"REVIEWDT")),U))
. S CHKS("patientRecordFlags",EDI,"name")=$P($G(HMPY(EDI,"FLAG")),U,2)
. S CHKS("patientRecordFlags",EDI,"type")=$P($G(HMPY(EDI,"FLAGTYPE")),U,2)
. S CHKS("patientRecordFlags",EDI,"category")=$P($G(HMPY(EDI,"CATEGORY")),U,2)
. S CHKS("patientRecordFlags",EDI,"ownerSite")=$P($G(HMPY(EDI,"OWNER")),U,2)
. S CHKS("patientRecordFlags",EDI,"originatingSite")=$P($G(HMPY(EDI,"ORIGSITE")),U,2)
. S N=1,X=$G(HMPY(EDI,"NARR",1,0))
. F S N=$O(HMPY(EDI,"NARR",N)) Q:N<1 S X=X_$C(13)_$C(10)_$G(HMPY(EDI,"NARR",N,0))
. S CHKS("patientRecordFlags",EDI,"text")=X
Q
;
LOG(HMPZ,DFN) ; Make entry in security log for sensitive patient access
N ERR,RESULTS,HMPY,X
D NOTICE^DGSEC4(.HMPY,DFN) ;IA #3027
S X=$S(HMPY:"ok",1:"fail")
S RESULTS("result")=X
;S HMP=$$ENCODE^HMPJSON("RESULTS","ERR")
D ENCODE^HMPJSON("RESULTS","HMPZ","ERR")
Q
;
ENROS(HMPZ,DFNARRAY) ;PROCESS PATIENTS FROM A ROSTER
N DFN S DFN=0
F S DFN=$O(DFNARRAY(DFN)) Q:DFN'>0 D CHKS(.HMPZ,DFN)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPFPTC 3484 printed Dec 13, 2024@01:54 Page 2
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
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
CHKS(HMPZ,DFN) ; perform patient select checks
+1 ;
+2 NEW ACCESS,CHKS,CNT,DEATHDT,ERR,I,IEN,STR,X,HMPY
+3 ; check for sensitive record
+4 SET STR="patientChecks"
+5 SET ACCESS=0
+6 ;IA #3027
DO PTSEC^DGSEC4(.HMPY,DFN)
+7 SET ACCESS=1
+8 IF HMPY(1)>0
Begin DoDot:1
+9 SET CHKS("sensitive","dfn")=DFN
+10 SET ACCESS=(HMPY(1)<3)
+11 SET CHKS("sensitive","mayAccess")=$SELECT(ACCESS=1:"true",1:"false")
+12 SET CHKS("sensitive","logAccess")=$SELECT(HMPY(1)>1:"true",1:"false")
+13 SET CNT=2
SET X=""
+14 FOR
SET CNT=$ORDER(HMPY(CNT))
if CNT'>0
QUIT
SET X=X_$CHAR(13)_$CHAR(10)_$GET(HMPY(CNT))
+15 SET CHKS("sensitive","text")=X
End DoDot:1
+16 ;
+17 ; check for deceased patient, DE2818 changed from direct global reference
+18 DO TOP^HMPXGDPT("DEATHDT",DFN,.351,"E")
+19 if $LENGTH($GET(DEATHDT(2,DFN,.351,"E")))
Begin DoDot:1
+20 SET CHKS("deceased","text")="This patient died on "_DEATHDT(2,DFN,.351,"E")_"."_$CHAR(13)_$CHAR(10)_" Do you wish to continue?"
End DoDot:1
+21 ;
+22 ; check for similar patients
+23 KILL HMPY
+24 NEW MSG,SIM,SIMPAT,TEXT
SET MSG=0
SET SIM=0
+25 ;IA #3593
DO GUIBS5A^DPTLK6(.HMPY,DFN)
+26 IF HMPY(1)>0
Begin DoDot:1
+27 SET TEXT=""
+28 SET I=1
FOR
SET I=$ORDER(HMPY(I))
if 'I
QUIT
SET X=HMPY(I)
Begin DoDot:2
+29 SET SIM=SIM+1
+30 IF $EXTRACT(X)=0
SET TEXT=$SELECT($LENGTH(TEXT):TEXT_$CHAR(13)_$CHAR(10)_$PIECE(X,U,2),1:$PIECE(X,U,2))
+31 IF $EXTRACT(X)=1
Begin DoDot:3
+32 ;S CHKS("similar",SIM,"dfn")=$P(X,U,2)
+33 ;S CHKS("similar",SIM,"name")=$P(X,U,3)
+34 ;S CHKS("similar",SIM,"dob")=$$FMTE^XLFDT($P(X,U,4),"D")
+35 ;S CHKS("similar",SIM,"ssn")=$P(X,U,5)
+36 SET SIMPAT="Patient Name: "_$PIECE(X,U,3)_" Date of Birth: "_$$FMTE^XLFDT($PIECE(X,U,4),"D")_" SSN: "_$PIECE(X,U,5)
+37 SET TEXT=TEXT_$CHAR(13)_$CHAR(10)_SIMPAT
End DoDot:3
End DoDot:2
+38 SET CHKS("similar","text")=TEXT
End DoDot:1
+39 ;
+40 ; possibly check means test: GUIMTD^DPTLK6
+41 ; possibly check legacy data: I $L($T(HXDATA^A7RDPAGU)...
+42 ;
+43 IF ACCESS
DO PRF(DFN,.CHKS)
+44 SET ERR(0)=""
+45 ;S HMP=$$ENCODE^HMPJSON("CHKS","ERR")
+46 DO ENCODE^HMPJSON("CHKS","HMPZ","ERR")
+47 QUIT
+48 ;
PRF(DFN,CHKS) ; get Patient Record Flags
+1 NEW HMPY,EDI,PRF,N,X
+2 if $$GETACT^DGPFAPI(DFN,"HMPY")'>0
QUIT
+3 SET EDI=0
FOR
SET EDI=$ORDER(HMPY(EDI))
if EDI<1
QUIT
KILL PRF
Begin DoDot:1
+4 SET CHKS("patientRecordFlags",EDI,"assignmentStatus")="Active"
+5 SET CHKS("patientRecordFlags",EDI,"assignTS")=$$JSONDT^HMPUTILS($PIECE($GET(HMPY(EDI,"ASSIGNDT")),U))
+6 SET CHKS("patientRecordFlags",EDI,"approved")=$PIECE($GET(HMPY(EDI,"APPRVBY")),U,2)
+7 SET CHKS("patientRecordFlags",EDI,"nextReviewDT")=$$JSONDT^HMPUTILS($PIECE($GET(HMPY(EDI,"REVIEWDT")),U))
+8 SET CHKS("patientRecordFlags",EDI,"name")=$PIECE($GET(HMPY(EDI,"FLAG")),U,2)
+9 SET CHKS("patientRecordFlags",EDI,"type")=$PIECE($GET(HMPY(EDI,"FLAGTYPE")),U,2)
+10 SET CHKS("patientRecordFlags",EDI,"category")=$PIECE($GET(HMPY(EDI,"CATEGORY")),U,2)
+11 SET CHKS("patientRecordFlags",EDI,"ownerSite")=$PIECE($GET(HMPY(EDI,"OWNER")),U,2)
+12 SET CHKS("patientRecordFlags",EDI,"originatingSite")=$PIECE($GET(HMPY(EDI,"ORIGSITE")),U,2)
+13 SET N=1
SET X=$GET(HMPY(EDI,"NARR",1,0))
+14 FOR
SET N=$ORDER(HMPY(EDI,"NARR",N))
if N<1
QUIT
SET X=X_$CHAR(13)_$CHAR(10)_$GET(HMPY(EDI,"NARR",N,0))
+15 SET CHKS("patientRecordFlags",EDI,"text")=X
End DoDot:1
+16 QUIT
+17 ;
LOG(HMPZ,DFN) ; Make entry in security log for sensitive patient access
+1 NEW ERR,RESULTS,HMPY,X
+2 ;IA #3027
DO NOTICE^DGSEC4(.HMPY,DFN)
+3 SET X=$SELECT(HMPY:"ok",1:"fail")
+4 SET RESULTS("result")=X
+5 ;S HMP=$$ENCODE^HMPJSON("RESULTS","ERR")
+6 DO ENCODE^HMPJSON("RESULTS","HMPZ","ERR")
+7 QUIT
+8 ;
ENROS(HMPZ,DFNARRAY) ;PROCESS PATIENTS FROM A ROSTER
+1 NEW DFN
SET DFN=0
+2 FOR
SET DFN=$ORDER(DFNARRAY(DFN))
if DFN'>0
QUIT
DO CHKS(.HMPZ,DFN)
+3 QUIT
+4 ;
