- 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 Feb 18, 2025@23:20:22 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 ;