- 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 Jan 18, 2025@02:42:56 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