- 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 Apr 23, 2025@19:12:37 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
