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

RGEX03.m

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