- DGRPAUD ;BP/MJB - REGISTRATION CATASTROPHIC EDITS ;Compiled May 21, 2008 14:52:59
- ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
- ;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
- DGRPAUD ;BP/MJB - REGISTRATION CATASTROPHIC EDITS ;Compiled May 21, 2008 14:52:59
- +1 ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
- +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