DGRPAUD ;BP/MJB - REGISTRATION CATASTROPHIC EDITS ;Compiled May 21, 2008 14:52:59
;;5.3;Registration;**750**;Aug 13, 1993;Build 6
;This routine will be called by DGRPECE if a change is made to patient name, ssn, dob, and sex.
;It will will get patient information from the audit file for comparisons.
;DGIEN-Audit file IEN(S) for patient
;DGAUDZRO-zero node of the audit file
;DGDT-date in audit file
;DGFLDNMR=field number of change
;DGOPTION-option used to make the update
;DGCHG=check to verify if a change was made
;
DGAUD(DFN,DGCNT) ;SET AUDITS FOR PATIENT
N DGI,DGIEN,DGAUDIEN,DGAUDZRO,DGFLDNBR,DGOPTION,DGPTIEN,DGDT,DGCHG,DGTM,DGTODAY
K ^TMP("DGRPAUD")
S DGI=0,DGAUDZRO=0,U="^"
S DGTODAY=$P($$NOW^XLFDT(),".")
F S DGI=$O(^DIA(2,"B",DFN,DGI)) Q:'DGI D ;Get all audit IENS for patient.
.S DGIEN(DGI)=DGI
.S DGAUDZRO=$G(^DIA(2,DGIEN(DGI),0)) ;get zero node for all audits
.I 'DGAUDZRO Q
.S DGDT=$P(DGAUDZRO,"^",2),DGTM=$P(DGDT,".",1)
.I DGTODAY'=DGTM Q ;only get todays audits
.S DGFLDNBR=$P(DGAUDZRO,"^",3)
.;get only NAME(.01),SEX(.02),DOB(.03),SSN(.09) for catastrophic edit checks
.I DGFLDNBR'=".01"&(DGFLDNBR'=".02")&(DGFLDNBR'=".03")&(DGFLDNBR'=".09") Q
.S DGOPTION=$P($G(^DIA(2,DGIEN(DGI),4.1)),U)
.I 'DGOPTION Q
.S DGCHG=$G(^DIA(2,DGIEN(DGI),2)) ;Check to see if change was made
.I '$D(DGCHG)!(DGCHG="") Q
.S DGPTIEN=$P(DGAUDZRO,U)
.;set data into a temp global to be used by DGRPECE for changes
.;this temp global will show changes that are currently in the audit file for this patient
.;piece 1 - date and time of change
.;piece 2 - changed field
.;piece 3 - option used to change
.;piece 4 - previous field value
.;piece 5 - new field value
.S ^TMP("DGRPAUD",$J,DFN,DGIEN(DGI))=$P(DGAUDZRO,U,2)_"^"_DGFLDNBR_"^"_DGOPTION_"^"_$G(^DIA(2,DGIEN(DGI),2))_"^"_$G(^DIA(2,DGIEN(DGI),3))_"^"_$P(DGAUDZRO,U,5)
;
N DGAUDIEN
S DGAUDIEN=0
F S DGAUDIEN=$O(^TMP("DGRPAUD",$J,DFN,DGAUDIEN)) Q:'DGAUDIEN D
.S DGCNT=DGCNT+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRPAUD 2017 printed Sep 23, 2025@20:31:45 Page 2
DGRPAUD ;BP/MJB - REGISTRATION CATASTROPHIC EDITS ;Compiled May 21, 2008 14:52:59
+1 ;;5.3;Registration;**750**;Aug 13, 1993;Build 6
+2 ;This routine will be called by DGRPECE if a change is made to patient name, ssn, dob, and sex.
+3 ;It will will get patient information from the audit file for comparisons.
+4 ;DGIEN-Audit file IEN(S) for patient
+5 ;DGAUDZRO-zero node of the audit file
+6 ;DGDT-date in audit file
+7 ;DGFLDNMR=field number of change
+8 ;DGOPTION-option used to make the update
+9 ;DGCHG=check to verify if a change was made
+10 ;
DGAUD(DFN,DGCNT) ;SET AUDITS FOR PATIENT
+1 NEW DGI,DGIEN,DGAUDIEN,DGAUDZRO,DGFLDNBR,DGOPTION,DGPTIEN,DGDT,DGCHG,DGTM,DGTODAY
+2 KILL ^TMP("DGRPAUD")
+3 SET DGI=0
SET DGAUDZRO=0
SET U="^"
+4 SET DGTODAY=$PIECE($$NOW^XLFDT(),".")
+5 ;Get all audit IENS for patient.
FOR
SET DGI=$ORDER(^DIA(2,"B",DFN,DGI))
if 'DGI
QUIT
Begin DoDot:1
+6 SET DGIEN(DGI)=DGI
+7 ;get zero node for all audits
SET DGAUDZRO=$GET(^DIA(2,DGIEN(DGI),0))
+8 IF 'DGAUDZRO
QUIT
+9 SET DGDT=$PIECE(DGAUDZRO,"^",2)
SET DGTM=$PIECE(DGDT,".",1)
+10 ;only get todays audits
IF DGTODAY'=DGTM
QUIT
+11 SET DGFLDNBR=$PIECE(DGAUDZRO,"^",3)
+12 ;get only NAME(.01),SEX(.02),DOB(.03),SSN(.09) for catastrophic edit checks
+13 IF DGFLDNBR'=".01"&(DGFLDNBR'=".02")&(DGFLDNBR'=".03")&(DGFLDNBR'=".09")
QUIT
+14 SET DGOPTION=$PIECE($GET(^DIA(2,DGIEN(DGI),4.1)),U)
+15 IF 'DGOPTION
QUIT
+16 ;Check to see if change was made
SET DGCHG=$GET(^DIA(2,DGIEN(DGI),2))
+17 IF '$DATA(DGCHG)!(DGCHG="")
QUIT
+18 SET DGPTIEN=$PIECE(DGAUDZRO,U)
+19 ;set data into a temp global to be used by DGRPECE for changes
+20 ;this temp global will show changes that are currently in the audit file for this patient
+21 ;piece 1 - date and time of change
+22 ;piece 2 - changed field
+23 ;piece 3 - option used to change
+24 ;piece 4 - previous field value
+25 ;piece 5 - new field value
+26 SET ^TMP("DGRPAUD",$JOB,DFN,DGIEN(DGI))=$PIECE(DGAUDZRO,U,2)_"^"_DGFLDNBR_"^"_DGOPTION_"^"_$GET(^DIA(2,DGIEN(DGI),2))_"^"_$GET(^DIA(2,DGIEN(DGI),3))_"^"_$PIECE(DGAUDZRO,U,5)
End DoDot:1
+27 ;
+28 NEW DGAUDIEN
+29 SET DGAUDIEN=0
+30 FOR
SET DGAUDIEN=$ORDER(^TMP("DGRPAUD",$JOB,DFN,DGAUDIEN))
if 'DGAUDIEN
QUIT
Begin DoDot:1
+31 SET DGCNT=DGCNT+1
End DoDot:1
+32 QUIT
