RGEX03 ;BAY/ALS-LIST MANAGER FOR MPI/PD EXCEPTIONS ;10/13/99
;;1.0;CLINICAL INFO RESOURCE NETWORK;**3,12,19,23,27,30,38,39,43,44,48,54,57**;30 Apr 99;Build 2
;
;Reference to START^VAFCPDAT supported by IA #3299
;Reference to ^DIA(2 supported by IA #2097
;Reference to ^DPT( supported by IA #2969
;Reference to HINQ^DG10 supported by IA #2076
;Reference to CIRNEXC^MPIFQ0 supported by IA #2942
;Reference to VTQ^MPIFSAQ supported by IA #2941
;Reference to NOTICE^DGSEC4 and PTSEC^DGSEC4 supported by IA#3027
;Reference to POT^MPIFDUP supported by IA #4464;**57 MPIC_1893 call obsolete; removed PMR
;Reference to $$NCEDIT^DPTNAME supported by private IA #4116
;
EN(DATA) ; -- main entry point for RG EXCPT ACTION
D EN^VALM("RG EXCPT ACTION")
Q
HDR ; -- header code
S VALMHDR(1)="MPI/PD EXCEPTION HANDLING ACTIONS.",VALMHDR(2)=""
Q
INIT ; -- init variables and list array
K ^TMP("RGEXC2",$J)
K @VALMAR
I DATA="" Q
S STR="",LIN=1,STATUS="",NAME="",DOB="",SSN="",DFN="",CHKSM="" ;**44
S NAME=$P(DATA,"^",1),DOB=$P(DATA,"^",8),SSN=$P(DATA,"^",2)
S DFN=$P(DATA,"^",5),CHKSM=$P($G(^DPT(DFN,"MPI")),"^",2) ;**44
S STR=$$SETSTR^VALM1("Name:",STR,6,6),STR=$$SETSTR^VALM1(NAME,STR,14,30) D ADDTMP
S STR=$$SETSTR^VALM1(" SSN:",STR,6,6),STR=$$SETSTR^VALM1(SSN,STR,14,12) D ADDTMP
S STR=$$SETSTR^VALM1(" DOB:",STR,6,6),STR=$$SETSTR^VALM1(DOB,STR,14,20) D ADDTMP
S STR=$$SETSTR^VALM1(" DFN:",STR,6,6),STR=$$SETSTR^VALM1(DFN,STR,14,12) D ADDTMP ;**44
S STR=$$SETSTR^VALM1(" ICN:",STR,6,6),ICN="" S ICN=$P(DATA,"^",6) I ICN<0 S ICN=""
S STR=$$SETSTR^VALM1(ICN_($S(CHKSM="":"",1:"V"_CHKSM)),STR,14,20) D ADDTMP ;**44
S STR=$$SETSTR^VALM1("Date of Death:",STR,6,20),STR=$$SETSTR^VALM1($P(DATA,"^",13),STR,26,20) D ADDTMP
S STR=$$SETSTR^VALM1("Exception Type:",STR,6,20),STR=$$SETSTR^VALM1($P(DATA,"^",4),STR,26,50) D ADDTMP
S STR=$$SETSTR^VALM1("Exception Date:",STR,6,20),STR=$$SETSTR^VALM1($P(DATA,"^",3),STR,26,30) D ADDTMP
S STATUS=$P(DATA,"^",9)
I STATUS<1 S STATUS="NOT PROCESSED"
E S STATUS="PROCESSED"
S STR=$$SETSTR^VALM1("Exception Status:",STR,6,20),STR=$$SETSTR^VALM1(STATUS,STR,26,15) D ADDTMP
;Added Exception Text to Exception Handler, patch 39
N IEN,IEN2,X K ^UTILITY($J,"W") S IEN=$P(DATA,"^",10),IEN2=$P(DATA,"^",11)
I IEN'=""!(IEN2'="") D
.S EXCTEXT=$P($G(^RGHL7(991.1,IEN,1,IEN2,10)),"^",1) Q:EXCTEXT=""
.S STR=$$SETSTR^VALM1("Exception Text:",STR,6,20)
.S X=EXCTEXT,DIWL=1,DIWR=50,DIWF="|" D ^DIWP
.F N=1:1:$P($G(^UTILITY($J,"W",1)),1) D Q:'N
..S STR=$$SETSTR^VALM1(^UTILITY($J,"W",1,(N),0),STR,26,76)
..D ADDTMP
ADDNOTE ;Display Exception Notes, Word Processing field
S STR=$$SETSTR^VALM1("Exception Notes:",STR,6,20) D ADDTMP
N IEN,IEN2,IENS,N,NOTE
S IEN=$P(DATA,"^",10),IEN2=$P(DATA,"^",11),IENS=IEN2_","_IEN_",",N=$$GET1^DIQ(991.12,IENS,11,"","NT")
S L=0 F S L=$O(NT(L)) Q:'L S NOTE=NT(L),STR=$$SETSTR^VALM1(NOTE,STR,6,74) D ADDTMP
S VALMCNT=LIN-1,DFN=$P(DATA,"^",5),VAFCDFN=DFN
K L,NT
Q
ADDTMP ;
S ^TMP("RGEXC2",$J,LIN,0)=STR,^TMP("RGEXC2",$J,"IDX",LIN,LIN)="",LIN=LIN+1,STR=""
Q
UPD ;
N PROCDT,%,X,%I,%H
W !,"This option updates the exception status to PROCESSED.",!,"After it is processed it will not be listed in the summary."
S DIR("A")="Are you sure you want to change the status? ",DIR(0)="YA",DIR("B")="YES"
D ^DIR Q:$D(DIRUT) I Y>0 D
.;**48 populating the date/time marked as processed and who marked it as processed
.D NOW^%DTC S PROCDT=%
.S IEN="",IEN2="",IEN=$P(DATA,"^",10),IEN2=$P(DATA,"^",11) L +^RGHL7(991.1,IEN):10
.S DA(1)=IEN,DA=IEN2,DR="6///"_1_";7///"_PROCDT_";8////"_$G(DUZ),DIE="^RGHL7(991.1,"_DA(1)_",1," D ^DIE K DIE,DA,DR ;**57,MPIC_2024
.L -^RGHL7(991.1,IEN) S $P(DATA,"^",9)=1
.D INIT
K DIR,DIRUT S VALMBCK="R"
Q
PA ;Patient Audit
S PDFN=DFN
I '$O(^DIA(2,"B",VAFCDFN,0)) S VALMSG="This patient has no audit data available.",VALMBCK="" G PAQ
N IEN S DFN=VAFCDFN,QFLG=1 D FULL^VALM1 D:$T(ASK2^RGMTAUD)]"" ASK2^RGMTAUD S VALMBCK="R"
S DFN=PDFN K QFLG,PDFN
PAQ Q
HI ;Hinq Inquiry
S VALMBCK="" D HINQ^DG10 D PAUSE^VALM1 S VALMBCK="R"
Q
DISP ; Display Only Query
S VALMBCK="" D FULL^VALM1
S MPIVAR("DFN")=DFN,MPIVAR("SSN")=SSN,MPIVAR("NM")=NAME,MPIVAR("DOB")=$P($P(DATA,"^",7),".",1)
D VTQ^MPIFSAQ(.MPIVAR) D PAUSE^VALM1
S VALMBCK="R" K MPIVAR
Q
;
POT ;Potential Match on MPI, Query MPI, resolve duplicate if needed. **43;**57 MPIC_1893 OBSOLETE; remove PMR
;D POT^MPIFDUP
;D INIT S VALMBCK="R" K PROCESS
Q
;
REJ ;Primary View Reject. **44 Added entry point
D REJ^RGPVREJ
D INIT S VALMBCK="R"
Q
;
MPIPV ;MPI Primary View PDAT. **48 Added entry point
S SAPV=0 ;from EH, not stand alone option
D SEND^RGPVMPI
D INIT S VALMBCK="R"
Q
;
LOAD ; Edit Patient Data, if patient's eligibility is verified - check for DG ELIGIBILITY key for user
S VALMBCK="",DATAOLD=""
D FULL^VALM1 D ELIG^VADPT
I $P(VAEL(8),"^",1)="V" D
.I '$D(^XUSEC("DG ELIGIBILITY",DUZ)) D
..W !!,"Eligibility has been verified for this patient.",!!,"You do not have access to edit the Name, Date of ",!,"Birth or Social Security Number for this patient."
..D PAUSE^VALM1 S VALMBCK="R"
.E D SENS
E D SENS
Q
SENS ; check for patient sensitivity and user security
N RESULT,RGSEN
D PTSEC^DGSEC4(.RESULT,DFN,0,"RG EXCEPTION HANDLING^MPI/PD Exception Handling")
I RESULT(1)=-1 W !!,"Access denied: Required parameters not defined" D PAUSE^VALM1 S VALMBCK="R" Q
I RESULT(1)>0 W !!?15,"***PATIENT MARKED SENSITIVE***"
I RESULT(1)=3 W !!?15,"Access not allowed on your own PATIENT (#2) file entry" D PAUSE^VALM1 S VALMBCK="R" Q
I RESULT(1)=4 W !!?15,"Access denied: Your SSN is not defined" D PAUSE^VALM1 S VALMBCK="R" Q
I RESULT(1)<3 D
.I RESULT(1)=1 D NOTICE^DGSEC4(.RGSEN,DFN,"RG EXCEPTION HANDLING^MPI/PD Exception Handling",2)
.I RESULT(1)=2 D NOTICE^DGSEC4(.RGSEN,DFN,"RG EXCEPTION HANDLING^MPI/PD Exception Handling",3)
D EDIT
Q
EDIT ; edit patient data
S ACCESS=0
D REC
Q:ACCESS=0
S DIE="^DPT(",DA=DFN,DR=".01///^S X=$$NCEDIT^DPTNAME(DA);.03//^S X=DOB;.09//^S X=SSN"
L +^DPT(DFN):10 D ^DIE K DIE,DA,DR L -^DPT(DFN)
S DATAOLD=DATA
D DEATH
D DEM^VADPT
S DATA=VADM(1)_"^"_$P($G(VADM(2)),"^",1)_"^"_$P(DATAOLD,"^",3)_"^"_$P(DATAOLD,"^",4)_"^"_DFN_"^"_$P(DATAOLD,"^",6)_"^"
S DATA=DATA_$G(VADM(3))_"^"_$P(DATAOLD,"^",9)_"^"_$P(DATAOLD,"^",10)_"^"_$P(DATAOLD,"^",11)_"^"_$P(DATAOLD,"^",12)_"^"_$P($G(VADM(6)),"^",2)
D INIT
S VALMBCK="R"
K DGNEW,DATAOLD,VAEL,ACCESS,DGNPSSN
QUIT Q
REC ; Check if user is attempting to access own record
; check for security key
I $D(^XUSEC("DG RECORD ACCESS",+DUZ)) S ACCESS=1 Q
S DGNPSSN=$$GET1^DIQ(200,+DUZ_",",9,"I","","DGNPERR")
I 'DGNPSSN D Q
.W !!,"Your SSN is missing from the NEW PERSON file.",!,"Contact your ADP Coordinator."
.D PAUSE^VALM1 S VALMBCK="R"
I DGNPSSN=SSN D Q
.W !!,"Security regulations prohibit computer access to your",!,"own medical record."
.D PAUSE^VALM1 S VALMBCK="R"
E S ACCESS=1
Q
DEATH ; Check for access to edit date of death
I $D(^XUSEC("DG DETAIL",+DUZ)) D
.K VADM,DIE,DA,DR
.S (DOD1,DOD2,SRS)=""
.D DEM^VADPT
.S DOD1=$P($G(VADM(6)),"^",2) ;DOD original value
.S DIC="2",DA=DFN,DR=".353",DIQ(0)="E" D EN^DIQ1 ;**54
.S SRS=$G(^UTILITY("DIQ1",$J,2,DA,.353,"E")) ;source of notification original value
.S DIE="^DPT(",DA=DFN,DR=".351//^S X=DOD1" D DIEC ;ask DOD, prompt with original value
.;was a change made to DOD?
.D DEM^VADPT
.S DOD2=$P($G(VADM(6)),"^",2) D ;DOD value after DIE call
..I DOD1="",DOD2="" Q ;original and added DOD both null; don't prompt for .353
..I DOD1'="",DOD2="" S DIE="^DPT(",DA=DFN,DR=".353////@" D DIEC Q ;DOD now null - deleted; remove source field
..;Else DOD added or changed; so prompt for source
..I (DOD1=""&DOD2'="")!(DOD1'=DOD2) D
...S DIE="^DPT(",DA=DFN,DR=".353//^S X=SRS" D DIEC Q
E W !!,"You do not have the proper security to edit date of death." D PAUSE^VALM1 D INIT S VALMBCK="R"
K VADM,DIE,DA,DR,DOD1,DOD2,SRS,X,Y
Q
;
DIEC ;Do the ^DIE call from the DEATH module
L +^DPT(DFN):10
D ^DIE
L -^DPT(DFN)
Q
;
INQ ; Patient Inquiry
S VALMBCK=""
D FULL^VALM1 D EN^DGRPD D PAUSE^VALM1 D CLEAN^VALM10 D INIT
S VALMBCK="R"
Q
EDTNOT ; Edit Exception Notes
S IEN=$P(DATA,"^",10),IEN2=$P(DATA,"^",11)
L +^RGHL7(991.1,IEN):10 S DIE="^RGHL7(991.1,"_IEN_",1,",DA(1)=IEN,DA=IEN2,DR="11" D ^DIE L -^RGHL7(991.1,IEN)
K DIE,DA,DR,IEN,IEN2
D INIT
S VALMBCK="R"
Q
PDAT S VALMBCK="",PICN="",PSSN=""
I $D(SSN) S PSSN=SSN
S ARRAY="^TMP(""RGXHFS"","_$J_")",TYPE="I",REP=1,RGXDIR=$$GET^XPAR("SYS","RGX HFS SCRATCH"),RGXFILE="RGX"_DUZ_".DAT"
S IOM=132,IOSL=99999,IOST="P-DUMMY",IOF=""""""
D OPEN^%ZISH("RGX",RGXDIR,RGXFILE,"W") Q:POP
U IO
I ICN'="" S PICN=ICN D START^VAFCPDAT
N RGXDEL
D CLOSE^%ZISH("RGX")
K ^TMP("RGPDAT",$J)
S RGXDEL(RGXFILE)="",X=$$FTG^%ZISH(RGXDIR,RGXFILE,$NAME(^TMP("RGPDAT",$J,1)),3),X=$$DEL^%ZISH(RGXDIR,$NA(RGXDEL))
I $D(^TMP("RGPDAT",$J)) D EN^RGEX04
S ICN=PICN,SSN=PSSN
D INIT
S VALMBCK="R" K PICN,PSSN,ARRAY,REP,RGXDIR,RGXFILE,TYPE
Q
GETEX(RETURN,DFN) ; Get array of pending exceptions for a patient
K RETURN
S CNT=0,RETURN(0)="0^No Pending Exceptions",TYP=""
I 'DFN S RETURN(0)="-1^DFN not passed" G QGET
F S TYP=$O(^RGHL7(991.1,"ADFN",TYP)) Q:'TYP D
.I $D(^RGHL7(991.1,"ADFN",TYP,DFN)) D
..S IEN="" F S IEN=$O(^RGHL7(991.1,"ADFN",TYP,DFN,IEN)) Q:'IEN D
...S IEN2="",ETYP="" F S IEN2=$O(^RGHL7(991.1,"ADFN",TYP,DFN,IEN,IEN2)) Q:'IEN2 D
....I $P(^RGHL7(991.1,IEN,1,IEN2,0),"^",5)<1 D
.....S CNT=CNT+1,ETYP=$P(^RGHL7(991.11,TYP,10),"^",1)
.....S RETURN(CNT)=ETYP_"^"_IEN_"^"_IEN2
I CNT>0 S RETURN(0)=CNT_"^Pending Exception(s)"
QGET ;
K TYP,ETYP,IEN,IEN2,CNT
Q
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
EXIT ; -- exit code
S VALMBCK="" K ^TMP("RGEXC2",$J),CHKSM,DFN,DIR,EXCTEXT,IEN,IEN2,NAME,DOB,SSN,LIN,STATUS,STR,VAFCDFN,X,Y
S VALMBCK="R",RGBG=1
Q
EXPND ; -- expand code
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGEX03 10025 printed Sep 23, 2025@19:17:41 Page 2
RGEX03 ;BAY/ALS-LIST MANAGER FOR MPI/PD EXCEPTIONS ;10/13/99
+1 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**3,12,19,23,27,30,38,39,43,44,48,54,57**;30 Apr 99;Build 2
+2 ;
+3 ;Reference to START^VAFCPDAT supported by IA #3299
+4 ;Reference to ^DIA(2 supported by IA #2097
+5 ;Reference to ^DPT( supported by IA #2969
+6 ;Reference to HINQ^DG10 supported by IA #2076
+7 ;Reference to CIRNEXC^MPIFQ0 supported by IA #2942
+8 ;Reference to VTQ^MPIFSAQ supported by IA #2941
+9 ;Reference to NOTICE^DGSEC4 and PTSEC^DGSEC4 supported by IA#3027
+10 ;Reference to POT^MPIFDUP supported by IA #4464;**57 MPIC_1893 call obsolete; removed PMR
+11 ;Reference to $$NCEDIT^DPTNAME supported by private IA #4116
+12 ;
EN(DATA) ; -- main entry point for RG EXCPT ACTION
+1 DO EN^VALM("RG EXCPT ACTION")
+2 QUIT
HDR ; -- header code
+1 SET VALMHDR(1)="MPI/PD EXCEPTION HANDLING ACTIONS."
SET VALMHDR(2)=""
+2 QUIT
INIT ; -- init variables and list array
+1 KILL ^TMP("RGEXC2",$JOB)
+2 KILL @VALMAR
+3 IF DATA=""
QUIT
+4 ;**44
SET STR=""
SET LIN=1
SET STATUS=""
SET NAME=""
SET DOB=""
SET SSN=""
SET DFN=""
SET CHKSM=""
+5 SET NAME=$PIECE(DATA,"^",1)
SET DOB=$PIECE(DATA,"^",8)
SET SSN=$PIECE(DATA,"^",2)
+6 ;**44
SET DFN=$PIECE(DATA,"^",5)
SET CHKSM=$PIECE($GET(^DPT(DFN,"MPI")),"^",2)
+7 SET STR=$$SETSTR^VALM1("Name:",STR,6,6)
SET STR=$$SETSTR^VALM1(NAME,STR,14,30)
DO ADDTMP
+8 SET STR=$$SETSTR^VALM1(" SSN:",STR,6,6)
SET STR=$$SETSTR^VALM1(SSN,STR,14,12)
DO ADDTMP
+9 SET STR=$$SETSTR^VALM1(" DOB:",STR,6,6)
SET STR=$$SETSTR^VALM1(DOB,STR,14,20)
DO ADDTMP
+10 ;**44
SET STR=$$SETSTR^VALM1(" DFN:",STR,6,6)
SET STR=$$SETSTR^VALM1(DFN,STR,14,12)
DO ADDTMP
+11 SET STR=$$SETSTR^VALM1(" ICN:",STR,6,6)
SET ICN=""
SET ICN=$PIECE(DATA,"^",6)
IF ICN<0
SET ICN=""
+12 ;**44
SET STR=$$SETSTR^VALM1(ICN_($SELECT(CHKSM="":"",1:"V"_CHKSM)),STR,14,20)
DO ADDTMP
+13 SET STR=$$SETSTR^VALM1("Date of Death:",STR,6,20)
SET STR=$$SETSTR^VALM1($PIECE(DATA,"^",13),STR,26,20)
DO ADDTMP
+14 SET STR=$$SETSTR^VALM1("Exception Type:",STR,6,20)
SET STR=$$SETSTR^VALM1($PIECE(DATA,"^",4),STR,26,50)
DO ADDTMP
+15 SET STR=$$SETSTR^VALM1("Exception Date:",STR,6,20)
SET STR=$$SETSTR^VALM1($PIECE(DATA,"^",3),STR,26,30)
DO ADDTMP
+16 SET STATUS=$PIECE(DATA,"^",9)
+17 IF STATUS<1
SET STATUS="NOT PROCESSED"
+18 IF '$TEST
SET STATUS="PROCESSED"
+19 SET STR=$$SETSTR^VALM1("Exception Status:",STR,6,20)
SET STR=$$SETSTR^VALM1(STATUS,STR,26,15)
DO ADDTMP
+20 ;Added Exception Text to Exception Handler, patch 39
+21 NEW IEN,IEN2,X
KILL ^UTILITY($JOB,"W")
SET IEN=$PIECE(DATA,"^",10)
SET IEN2=$PIECE(DATA,"^",11)
+22 IF IEN'=""!(IEN2'="")
Begin DoDot:1
+23 SET EXCTEXT=$PIECE($GET(^RGHL7(991.1,IEN,1,IEN2,10)),"^",1)
if EXCTEXT=""
QUIT
+24 SET STR=$$SETSTR^VALM1("Exception Text:",STR,6,20)
+25 SET X=EXCTEXT
SET DIWL=1
SET DIWR=50
SET DIWF="|"
DO ^DIWP
+26 FOR N=1:1:$PIECE($GET(^UTILITY($JOB,"W",1)),1)
Begin DoDot:2
+27 SET STR=$$SETSTR^VALM1(^UTILITY($JOB,"W",1,(N),0),STR,26,76)
+28 DO ADDTMP
End DoDot:2
if 'N
QUIT
End DoDot:1
ADDNOTE ;Display Exception Notes, Word Processing field
+1 SET STR=$$SETSTR^VALM1("Exception Notes:",STR,6,20)
DO ADDTMP
+2 NEW IEN,IEN2,IENS,N,NOTE
+3 SET IEN=$PIECE(DATA,"^",10)
SET IEN2=$PIECE(DATA,"^",11)
SET IENS=IEN2_","_IEN_","
SET N=$$GET1^DIQ(991.12,IENS,11,"","NT")
+4 SET L=0
FOR
SET L=$ORDER(NT(L))
if 'L
QUIT
SET NOTE=NT(L)
SET STR=$$SETSTR^VALM1(NOTE,STR,6,74)
DO ADDTMP
+5 SET VALMCNT=LIN-1
SET DFN=$PIECE(DATA,"^",5)
SET VAFCDFN=DFN
+6 KILL L,NT
+7 QUIT
ADDTMP ;
+1 SET ^TMP("RGEXC2",$JOB,LIN,0)=STR
SET ^TMP("RGEXC2",$JOB,"IDX",LIN,LIN)=""
SET LIN=LIN+1
SET STR=""
+2 QUIT
UPD ;
+1 NEW PROCDT,%,X,%I,%H
+2 WRITE !,"This option updates the exception status to PROCESSED.",!,"After it is processed it will not be listed in the summary."
+3 SET DIR("A")="Are you sure you want to change the status? "
SET DIR(0)="YA"
SET DIR("B")="YES"
+4 DO ^DIR
if $DATA(DIRUT)
QUIT
IF Y>0
Begin DoDot:1
+5 ;**48 populating the date/time marked as processed and who marked it as processed
+6 DO NOW^%DTC
SET PROCDT=%
+7 SET IEN=""
SET IEN2=""
SET IEN=$PIECE(DATA,"^",10)
SET IEN2=$PIECE(DATA,"^",11)
LOCK +^RGHL7(991.1,IEN):10
+8 ;**57,MPIC_2024
SET DA(1)=IEN
SET DA=IEN2
SET DR="6///"_1_";7///"_PROCDT_";8////"_$GET(DUZ)
SET DIE="^RGHL7(991.1,"_DA(1)_",1,"
DO ^DIE
KILL DIE,DA,DR
+9 LOCK -^RGHL7(991.1,IEN)
SET $PIECE(DATA,"^",9)=1
+10 DO INIT
End DoDot:1
+11 KILL DIR,DIRUT
SET VALMBCK="R"
+12 QUIT
PA ;Patient Audit
+1 SET PDFN=DFN
+2 IF '$ORDER(^DIA(2,"B",VAFCDFN,0))
SET VALMSG="This patient has no audit data available."
SET VALMBCK=""
GOTO PAQ
+3 NEW IEN
SET DFN=VAFCDFN
SET QFLG=1
DO FULL^VALM1
if $TEXT(ASK2^RGMTAUD)]""
DO ASK2^RGMTAUD
SET VALMBCK="R"
+4 SET DFN=PDFN
KILL QFLG,PDFN
PAQ QUIT
HI ;Hinq Inquiry
+1 SET VALMBCK=""
DO HINQ^DG10
DO PAUSE^VALM1
SET VALMBCK="R"
+2 QUIT
DISP ; Display Only Query
+1 SET VALMBCK=""
DO FULL^VALM1
+2 SET MPIVAR("DFN")=DFN
SET MPIVAR("SSN")=SSN
SET MPIVAR("NM")=NAME
SET MPIVAR("DOB")=$PIECE($PIECE(DATA,"^",7),".",1)
+3 DO VTQ^MPIFSAQ(.MPIVAR)
DO PAUSE^VALM1
+4 SET VALMBCK="R"
KILL MPIVAR
+5 QUIT
+6 ;
POT ;Potential Match on MPI, Query MPI, resolve duplicate if needed. **43;**57 MPIC_1893 OBSOLETE; remove PMR
+1 ;D POT^MPIFDUP
+2 ;D INIT S VALMBCK="R" K PROCESS
+3 QUIT
+4 ;
REJ ;Primary View Reject. **44 Added entry point
+1 DO REJ^RGPVREJ
+2 DO INIT
SET VALMBCK="R"
+3 QUIT
+4 ;
MPIPV ;MPI Primary View PDAT. **48 Added entry point
+1 ;from EH, not stand alone option
SET SAPV=0
+2 DO SEND^RGPVMPI
+3 DO INIT
SET VALMBCK="R"
+4 QUIT
+5 ;
LOAD ; Edit Patient Data, if patient's eligibility is verified - check for DG ELIGIBILITY key for user
+1 SET VALMBCK=""
SET DATAOLD=""
+2 DO FULL^VALM1
DO ELIG^VADPT
+3 IF $PIECE(VAEL(8),"^",1)="V"
Begin DoDot:1
+4 IF '$DATA(^XUSEC("DG ELIGIBILITY",DUZ))
Begin DoDot:2
+5 WRITE !!,"Eligibility has been verified for this patient.",!!,"You do not have access to edit the Name, Date of ",!,"Birth or Social Security Number for this patient."
+6 DO PAUSE^VALM1
SET VALMBCK="R"
End DoDot:2
+7 IF '$TEST
DO SENS
End DoDot:1
+8 IF '$TEST
DO SENS
+9 QUIT
SENS ; check for patient sensitivity and user security
+1 NEW RESULT,RGSEN
+2 DO PTSEC^DGSEC4(.RESULT,DFN,0,"RG EXCEPTION HANDLING^MPI/PD Exception Handling")
+3 IF RESULT(1)=-1
WRITE !!,"Access denied: Required parameters not defined"
DO PAUSE^VALM1
SET VALMBCK="R"
QUIT
+4 IF RESULT(1)>0
WRITE !!?15,"***PATIENT MARKED SENSITIVE***"
+5 IF RESULT(1)=3
WRITE !!?15,"Access not allowed on your own PATIENT (#2) file entry"
DO PAUSE^VALM1
SET VALMBCK="R"
QUIT
+6 IF RESULT(1)=4
WRITE !!?15,"Access denied: Your SSN is not defined"
DO PAUSE^VALM1
SET VALMBCK="R"
QUIT
+7 IF RESULT(1)<3
Begin DoDot:1
+8 IF RESULT(1)=1
DO NOTICE^DGSEC4(.RGSEN,DFN,"RG EXCEPTION HANDLING^MPI/PD Exception Handling",2)
+9 IF RESULT(1)=2
DO NOTICE^DGSEC4(.RGSEN,DFN,"RG EXCEPTION HANDLING^MPI/PD Exception Handling",3)
End DoDot:1
+10 DO EDIT
+11 QUIT
EDIT ; edit patient data
+1 SET ACCESS=0
+2 DO REC
+3 if ACCESS=0
QUIT
+4 SET DIE="^DPT("
SET DA=DFN
SET DR=".01///^S X=$$NCEDIT^DPTNAME(DA);.03//^S X=DOB;.09//^S X=SSN"
+5 LOCK +^DPT(DFN):10
DO ^DIE
KILL DIE,DA,DR
LOCK -^DPT(DFN)
+6 SET DATAOLD=DATA
+7 DO DEATH
+8 DO DEM^VADPT
+9 SET DATA=VADM(1)_"^"_$PIECE($GET(VADM(2)),"^",1)_"^"_$PIECE(DATAOLD,"^",3)_"^"_$PIECE(DATAOLD,"^",4)_"^"_DFN_"^"_$PIECE(DATAOLD,"^",6)_"^"
+10 SET DATA=DATA_$GET(VADM(3))_"^"_$PIECE(DATAOLD,"^",9)_"^"_$PIECE(DATAOLD,"^",10)_"^"_$PIECE(DATAOLD,"^",11)_"^"_$PIECE(DATAOLD,"^",12)_"^"_$PIECE($GET(VADM(6)),"^",2)
+11 DO INIT
+12 SET VALMBCK="R"
+13 KILL DGNEW,DATAOLD,VAEL,ACCESS,DGNPSSN
QUIT QUIT
REC ; Check if user is attempting to access own record
+1 ; check for security key
+2 IF $DATA(^XUSEC("DG RECORD ACCESS",+DUZ))
SET ACCESS=1
QUIT
+3 SET DGNPSSN=$$GET1^DIQ(200,+DUZ_",",9,"I","","DGNPERR")
+4 IF 'DGNPSSN
Begin DoDot:1
+5 WRITE !!,"Your SSN is missing from the NEW PERSON file.",!,"Contact your ADP Coordinator."
+6 DO PAUSE^VALM1
SET VALMBCK="R"
End DoDot:1
QUIT
+7 IF DGNPSSN=SSN
Begin DoDot:1
+8 WRITE !!,"Security regulations prohibit computer access to your",!,"own medical record."
+9 DO PAUSE^VALM1
SET VALMBCK="R"
End DoDot:1
QUIT
+10 IF '$TEST
SET ACCESS=1
+11 QUIT
DEATH ; Check for access to edit date of death
+1 IF $DATA(^XUSEC("DG DETAIL",+DUZ))
Begin DoDot:1
+2 KILL VADM,DIE,DA,DR
+3 SET (DOD1,DOD2,SRS)=""
+4 DO DEM^VADPT
+5 ;DOD original value
SET DOD1=$PIECE($GET(VADM(6)),"^",2)
+6 ;**54
SET DIC="2"
SET DA=DFN
SET DR=".353"
SET DIQ(0)="E"
DO EN^DIQ1
+7 ;source of notification original value
SET SRS=$GET(^UTILITY("DIQ1",$JOB,2,DA,.353,"E"))
+8 ;ask DOD, prompt with original value
SET DIE="^DPT("
SET DA=DFN
SET DR=".351//^S X=DOD1"
DO DIEC
+9 ;was a change made to DOD?
+10 DO DEM^VADPT
+11 ;DOD value after DIE call
SET DOD2=$PIECE($GET(VADM(6)),"^",2)
Begin DoDot:2
+12 ;original and added DOD both null; don't prompt for .353
IF DOD1=""
IF DOD2=""
QUIT
+13 ;DOD now null - deleted; remove source field
IF DOD1'=""
IF DOD2=""
SET DIE="^DPT("
SET DA=DFN
SET DR=".353////@"
DO DIEC
QUIT
+14 ;Else DOD added or changed; so prompt for source
+15 IF (DOD1=""&DOD2'="")!(DOD1'=DOD2)
Begin DoDot:3
+16 SET DIE="^DPT("
SET DA=DFN
SET DR=".353//^S X=SRS"
DO DIEC
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+17 IF '$TEST
WRITE !!,"You do not have the proper security to edit date of death."
DO PAUSE^VALM1
DO INIT
SET VALMBCK="R"
+18 KILL VADM,DIE,DA,DR,DOD1,DOD2,SRS,X,Y
+19 QUIT
+20 ;
DIEC ;Do the ^DIE call from the DEATH module
+1 LOCK +^DPT(DFN):10
+2 DO ^DIE
+3 LOCK -^DPT(DFN)
+4 QUIT
+5 ;
INQ ; Patient Inquiry
+1 SET VALMBCK=""
+2 DO FULL^VALM1
DO EN^DGRPD
DO PAUSE^VALM1
DO CLEAN^VALM10
DO INIT
+3 SET VALMBCK="R"
+4 QUIT
EDTNOT ; Edit Exception Notes
+1 SET IEN=$PIECE(DATA,"^",10)
SET IEN2=$PIECE(DATA,"^",11)
+2 LOCK +^RGHL7(991.1,IEN):10
SET DIE="^RGHL7(991.1,"_IEN_",1,"
SET DA(1)=IEN
SET DA=IEN2
SET DR="11"
DO ^DIE
LOCK -^RGHL7(991.1,IEN)
+3 KILL DIE,DA,DR,IEN,IEN2
+4 DO INIT
+5 SET VALMBCK="R"
+6 QUIT
PDAT SET VALMBCK=""
SET PICN=""
SET PSSN=""
+1 IF $DATA(SSN)
SET PSSN=SSN
+2 SET ARRAY="^TMP(""RGXHFS"","_$JOB_")"
SET TYPE="I"
SET REP=1
SET RGXDIR=$$GET^XPAR("SYS","RGX HFS SCRATCH")
SET RGXFILE="RGX"_DUZ_".DAT"
+3 SET IOM=132
SET IOSL=99999
SET IOST="P-DUMMY"
SET IOF=""""""
+4 DO OPEN^%ZISH("RGX",RGXDIR,RGXFILE,"W")
if POP
QUIT
+5 USE IO
+6 IF ICN'=""
SET PICN=ICN
DO START^VAFCPDAT
+7 NEW RGXDEL
+8 DO CLOSE^%ZISH("RGX")
+9 KILL ^TMP("RGPDAT",$JOB)
+10 SET RGXDEL(RGXFILE)=""
SET X=$$FTG^%ZISH(RGXDIR,RGXFILE,$NAME(^TMP("RGPDAT",$JOB,1)),3)
SET X=$$DEL^%ZISH(RGXDIR,$NAME(RGXDEL))
+11 IF $DATA(^TMP("RGPDAT",$JOB))
DO EN^RGEX04
+12 SET ICN=PICN
SET SSN=PSSN
+13 DO INIT
+14 SET VALMBCK="R"
KILL PICN,PSSN,ARRAY,REP,RGXDIR,RGXFILE,TYPE
+15 QUIT
GETEX(RETURN,DFN) ; Get array of pending exceptions for a patient
+1 KILL RETURN
+2 SET CNT=0
SET RETURN(0)="0^No Pending Exceptions"
SET TYP=""
+3 IF 'DFN
SET RETURN(0)="-1^DFN not passed"
GOTO QGET
+4 FOR
SET TYP=$ORDER(^RGHL7(991.1,"ADFN",TYP))
if 'TYP
QUIT
Begin DoDot:1
+5 IF $DATA(^RGHL7(991.1,"ADFN",TYP,DFN))
Begin DoDot:2
+6 SET IEN=""
FOR
SET IEN=$ORDER(^RGHL7(991.1,"ADFN",TYP,DFN,IEN))
if 'IEN
QUIT
Begin DoDot:3
+7 SET IEN2=""
SET ETYP=""
FOR
SET IEN2=$ORDER(^RGHL7(991.1,"ADFN",TYP,DFN,IEN,IEN2))
if 'IEN2
QUIT
Begin DoDot:4
+8 IF $PIECE(^RGHL7(991.1,IEN,1,IEN2,0),"^",5)<1
Begin DoDot:5
+9 SET CNT=CNT+1
SET ETYP=$PIECE(^RGHL7(991.11,TYP,10),"^",1)
+10 SET RETURN(CNT)=ETYP_"^"_IEN_"^"_IEN2
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+11 IF CNT>0
SET RETURN(0)=CNT_"^Pending Exception(s)"
QGET ;
+1 KILL TYP,ETYP,IEN,IEN2,CNT
+2 QUIT
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
EXIT ; -- exit code
+1 SET VALMBCK=""
KILL ^TMP("RGEXC2",$JOB),CHKSM,DFN,DIR,EXCTEXT,IEN,IEN2,NAME,DOB,SSN,LIN,STATUS,STR,VAFCDFN,X,Y
+2 SET VALMBCK="R"
SET RGBG=1
+3 QUIT
EXPND ; -- expand code
+1 QUIT
