DGRUGSEE ;ALB/GRR - BACKGROUND CHECKER FOR MASTER FILE CHANGES ;10/19/99 11:00
;;5.3;Registration;**190,381,427**;Aug 13, 1993
Q:'$D(^DGRU(46.11,"AC"))
I $D(^DGRU(46.11,"AC",2)) D ;Check for Patient SSN changes
.N DGFIEN S DGFIEN="" F S DGFIEN=$O(^DGRU(46.11,"AC",2,DGFIEN)) Q:DGFIEN'>0 D ;Loop through all SSN changes and call A08 builder
..N SSN S SSN=$$GET1^DIQ(46.11,DGFIEN,.01,"I")
..N DGOSSN S DGOSSN=$$GET1^DIQ(46.11,DGFIEN,.02,"I")
..N DGDA S (DGDA,DFN)=$$GET1^DIQ(46.11,DGFIEN,.04,"I")
..N DGRES S DGRES=$$BLDA08^DGRUGBJ(DFN,"","DGZZ","",DGOSSN)
..S DIK="^DGRU(46.11,",DA=DGFIEN D ^DIK K DIK
K ^TMP($J,"DGRUGMFU")
S DGSENM="DGRU-RAI-MFU-SERVER",DGRSIED=$O(^ORD(101,"B",DGSENM,0))
D INIT^HLFNC2(DGSENM,.HL)
S DGRUHLP("PRIORITY")="I"
I $O(HL(""))']"" D Q
.S HLERR(1)=HL
S DGFILE=0 F S DGFILE=$O(^DGRU(46.11,"AC",DGFILE)) Q:DGFILE="" S DGFIEN=0 F S DGFIEN=$O(^DGRU(46.11,"AC",DGFILE,DGFIEN)) Q:DGFIEN="" D
.I DGFILE=36 G DEL ;p-427
.I DGFILE=42 S DGFNAME="WARD",DGTYPE="LOCATION",DGSEG="LOC"
.I DGFILE=200 G DEL ;p-427
.I DGFILE=405.4 S DGFNAME="ROOM-BED",DGTYPE="LOCATION",DGSEG="LOC"
.I $G(DGSEG)="" G DEL
.S DGFOUND=0,DGRNEWN=$$GET1^DIQ(46.11,DGFIEN,.01)
.S DGROLDN=$$GET1^DIQ(46.11,DGFIEN,.02)
.S DGCIEN=$$GET1^DIQ(46.11,DGFIEN,.04) G:DGCIEN="" DEL
.I DGFILE=42 S DGWARD=DGCIEN I '$$CHKWARD^DGRUUTL(DGCIEN) G DEL ;p-381 changed
.I DGFILE=405.4 S DGWARD=0 F S DGWARD=$O(^DG(405.4,DGCIEN,"W",DGWARD)) Q:DGWARD'>0 I $$CHKWARD^DGRUUTL(DGWARD) S DGFOUND=1 Q
.I DGFILE=405.4,'DGFOUND G DEL
.D ENC^DGRUUTL(DGSEG,DGTYPE,DGFILE,DGFNAME,DGROLDN,DGRNEWN,DGRSIED,DGCIEN)
DEL .S DIK="^DGRU(46.11,",DA=DGFIEN D ^DIK K DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRUGSEE 1692 printed Nov 22, 2024@18:08:33 Page 2
DGRUGSEE ;ALB/GRR - BACKGROUND CHECKER FOR MASTER FILE CHANGES ;10/19/99 11:00
+1 ;;5.3;Registration;**190,381,427**;Aug 13, 1993
+2 if '$DATA(^DGRU(46.11,"AC"))
QUIT
+3 ;Check for Patient SSN changes
IF $DATA(^DGRU(46.11,"AC",2))
Begin DoDot:1
+4 ;Loop through all SSN changes and call A08 builder
NEW DGFIEN
SET DGFIEN=""
FOR
SET DGFIEN=$ORDER(^DGRU(46.11,"AC",2,DGFIEN))
if DGFIEN'>0
QUIT
Begin DoDot:2
+5 NEW SSN
SET SSN=$$GET1^DIQ(46.11,DGFIEN,.01,"I")
+6 NEW DGOSSN
SET DGOSSN=$$GET1^DIQ(46.11,DGFIEN,.02,"I")
+7 NEW DGDA
SET (DGDA,DFN)=$$GET1^DIQ(46.11,DGFIEN,.04,"I")
+8 NEW DGRES
SET DGRES=$$BLDA08^DGRUGBJ(DFN,"","DGZZ","",DGOSSN)
+9 SET DIK="^DGRU(46.11,"
SET DA=DGFIEN
DO ^DIK
KILL DIK
End DoDot:2
End DoDot:1
+10 KILL ^TMP($JOB,"DGRUGMFU")
+11 SET DGSENM="DGRU-RAI-MFU-SERVER"
SET DGRSIED=$ORDER(^ORD(101,"B",DGSENM,0))
+12 DO INIT^HLFNC2(DGSENM,.HL)
+13 SET DGRUHLP("PRIORITY")="I"
+14 IF $ORDER(HL(""))']""
Begin DoDot:1
+15 SET HLERR(1)=HL
End DoDot:1
QUIT
+16 SET DGFILE=0
FOR
SET DGFILE=$ORDER(^DGRU(46.11,"AC",DGFILE))
if DGFILE=""
QUIT
SET DGFIEN=0
FOR
SET DGFIEN=$ORDER(^DGRU(46.11,"AC",DGFILE,DGFIEN))
if DGFIEN=""
QUIT
Begin DoDot:1
+17 ;p-427
IF DGFILE=36
GOTO DEL
+18 IF DGFILE=42
SET DGFNAME="WARD"
SET DGTYPE="LOCATION"
SET DGSEG="LOC"
+19 ;p-427
IF DGFILE=200
GOTO DEL
+20 IF DGFILE=405.4
SET DGFNAME="ROOM-BED"
SET DGTYPE="LOCATION"
SET DGSEG="LOC"
+21 IF $GET(DGSEG)=""
GOTO DEL
+22 SET DGFOUND=0
SET DGRNEWN=$$GET1^DIQ(46.11,DGFIEN,.01)
+23 SET DGROLDN=$$GET1^DIQ(46.11,DGFIEN,.02)
+24 SET DGCIEN=$$GET1^DIQ(46.11,DGFIEN,.04)
if DGCIEN=""
GOTO DEL
+25 ;p-381 changed
IF DGFILE=42
SET DGWARD=DGCIEN
IF '$$CHKWARD^DGRUUTL(DGCIEN)
GOTO DEL
+26 IF DGFILE=405.4
SET DGWARD=0
FOR
SET DGWARD=$ORDER(^DG(405.4,DGCIEN,"W",DGWARD))
if DGWARD'>0
QUIT
IF $$CHKWARD^DGRUUTL(DGWARD)
SET DGFOUND=1
QUIT
+27 IF DGFILE=405.4
IF 'DGFOUND
GOTO DEL
+28 DO ENC^DGRUUTL(DGSEG,DGTYPE,DGFILE,DGFNAME,DGROLDN,DGRNEWN,DGRSIED,DGCIEN)
DEL SET DIK="^DGRU(46.11,"
SET DA=DGFIEN
DO ^DIK
KILL DIK
End DoDot:1
+1 QUIT
