DG505P ;BIR/PTD-PATCH DG*5.3*505 PRE/POST INSTALLATION ROUTINE ;4/7/03
;;5.3;Registration;**505**;Aug 13, 1993
;
;Reference to ^DD supported by IA #4078
;
PRE ;pre-install to check consistency checker data elements
I $$PATCH^XPDUTL("DG*5.3*505") Q ;patch previously installed - don't abort post init
N I
F I=64:1:66 I $D(^DGIN(38.6,I,0)) D H 2
. D BMES^XPDUTL(" ** Internal entry number "_I_" already exists in file 38.6 - contact NVS **")
. S XPDABORT=2
Q
;
POST ;Post-init entry point
D POST1,POST2
Q
;
POST1 ;Update identifier code for MULTIPLE BIRTH INDICATOR (#994) field in PATIENT (#2) file
D BMES^XPDUTL(" Updating the identifier code for the MULTIPLE BIRTH INDICATOR (#994) field.")
S ^DD(2,0,"ID",994)="I $$GET1^DIQ(2,Y_"","",994,""I"")=""Y"" D EN^DDIOL($$GET1^DIQ(2,Y_"","",994),"""",""?$X+2"")"
Q
;
POST2 ;post-init to add new inconsistent data elements
N I
F I=64:1:66 D
.N MSGROOT,FDAWP,FDAROOT,IENROOT,IEN,X
.D BMES^XPDUTL("Creating definition for INCONSISTENT DATA ELEMENT #"_I)
.S IEN="+1,"
.I I=64 D ;POB CITY/STATE MISSING
..S FDAROOT(38.6,IEN,.01)="POB CITY/STATE MISSING"
..S FDAROOT(38.6,IEN,2)="PLACE OF BIRTH CITY OR STATE IS MISSING"
..S FDAROOT(38.6,IEN,50)="FDAWP"
..S FDAWP(1,0)="Inconsistency results if the Patient's Place of Birth City or"
..S FDAWP(2,0)="State have not been entered."
.I I=65 D ;MOTHER'S MAIDEN NAME MISSING
..S FDAROOT(38.6,IEN,.01)="MOTHER'S MAIDEN NAME MISSING"
..S FDAROOT(38.6,IEN,2)="MOTHER'S MAIDEN NAME MISSING"
..S FDAROOT(38.6,IEN,50)="FDAWP"
..S FDAWP(1,0)="Inconsistency results if the Mother's Maiden Name is not entered."
.I I=66 D ;PSEUDO SSN IN USE
..S FDAROOT(38.6,IEN,.01)="PSEUDO SSN IN USE"
..S FDAROOT(38.6,IEN,2)="PSEUDO SSN IN USE"
..S FDAROOT(38.6,IEN,50)="FDAWP"
..S FDAWP(1,0)="Inconsistency results if a Pseudo SSN has been entered."
.S FDAROOT(38.6,IEN,3)="NO KEY REQUIRED"
.S FDAROOT(38.6,IEN,4)="NO"
.S FDAROOT(38.6,IEN,5)="CHECK"
.S IENROOT(1)=I
.D UPDATE^DIE("E","FDAROOT","IENROOT","MSGROOT")
.I $D(MSGROOT("DIERR")) D
..N ERR,LN,LN2
..S (ERR,LN2)=0
..F S ERR=+$O(MSGROOT("DIERR",ERR)) Q:'ERR D
...S LN=0
...F S LN=+$O(MSGROOT("DIERR",ERR,"TEXT",LN)) Q:'LN D
....S LN2=LN2+1
....S X(LN2)=MSGROOT("DIERR",ERR,"TEXT",LN)
..D BMES^XPDUTL(.X)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG505P 2345 printed Sep 23, 2025@20:11:19 Page 2
DG505P ;BIR/PTD-PATCH DG*5.3*505 PRE/POST INSTALLATION ROUTINE ;4/7/03
+1 ;;5.3;Registration;**505**;Aug 13, 1993
+2 ;
+3 ;Reference to ^DD supported by IA #4078
+4 ;
PRE ;pre-install to check consistency checker data elements
+1 ;patch previously installed - don't abort post init
IF $$PATCH^XPDUTL("DG*5.3*505")
QUIT
+2 NEW I
+3 FOR I=64:1:66
IF $DATA(^DGIN(38.6,I,0))
Begin DoDot:1
+4 DO BMES^XPDUTL(" ** Internal entry number "_I_" already exists in file 38.6 - contact NVS **")
+5 SET XPDABORT=2
End DoDot:1
HANG 2
+6 QUIT
+7 ;
POST ;Post-init entry point
+1 DO POST1
DO POST2
+2 QUIT
+3 ;
POST1 ;Update identifier code for MULTIPLE BIRTH INDICATOR (#994) field in PATIENT (#2) file
+1 DO BMES^XPDUTL(" Updating the identifier code for the MULTIPLE BIRTH INDICATOR (#994) field.")
+2 SET ^DD(2,0,"ID",994)="I $$GET1^DIQ(2,Y_"","",994,""I"")=""Y"" D EN^DDIOL($$GET1^DIQ(2,Y_"","",994),"""",""?$X+2"")"
+3 QUIT
+4 ;
POST2 ;post-init to add new inconsistent data elements
+1 NEW I
+2 FOR I=64:1:66
Begin DoDot:1
+3 NEW MSGROOT,FDAWP,FDAROOT,IENROOT,IEN,X
+4 DO BMES^XPDUTL("Creating definition for INCONSISTENT DATA ELEMENT #"_I)
+5 SET IEN="+1,"
+6 ;POB CITY/STATE MISSING
IF I=64
Begin DoDot:2
+7 SET FDAROOT(38.6,IEN,.01)="POB CITY/STATE MISSING"
+8 SET FDAROOT(38.6,IEN,2)="PLACE OF BIRTH CITY OR STATE IS MISSING"
+9 SET FDAROOT(38.6,IEN,50)="FDAWP"
+10 SET FDAWP(1,0)="Inconsistency results if the Patient's Place of Birth City or"
+11 SET FDAWP(2,0)="State have not been entered."
End DoDot:2
+12 ;MOTHER'S MAIDEN NAME MISSING
IF I=65
Begin DoDot:2
+13 SET FDAROOT(38.6,IEN,.01)="MOTHER'S MAIDEN NAME MISSING"
+14 SET FDAROOT(38.6,IEN,2)="MOTHER'S MAIDEN NAME MISSING"
+15 SET FDAROOT(38.6,IEN,50)="FDAWP"
+16 SET FDAWP(1,0)="Inconsistency results if the Mother's Maiden Name is not entered."
End DoDot:2
+17 ;PSEUDO SSN IN USE
IF I=66
Begin DoDot:2
+18 SET FDAROOT(38.6,IEN,.01)="PSEUDO SSN IN USE"
+19 SET FDAROOT(38.6,IEN,2)="PSEUDO SSN IN USE"
+20 SET FDAROOT(38.6,IEN,50)="FDAWP"
+21 SET FDAWP(1,0)="Inconsistency results if a Pseudo SSN has been entered."
End DoDot:2
+22 SET FDAROOT(38.6,IEN,3)="NO KEY REQUIRED"
+23 SET FDAROOT(38.6,IEN,4)="NO"
+24 SET FDAROOT(38.6,IEN,5)="CHECK"
+25 SET IENROOT(1)=I
+26 DO UPDATE^DIE("E","FDAROOT","IENROOT","MSGROOT")
+27 IF $DATA(MSGROOT("DIERR"))
Begin DoDot:2
+28 NEW ERR,LN,LN2
+29 SET (ERR,LN2)=0
+30 FOR
SET ERR=+$ORDER(MSGROOT("DIERR",ERR))
if 'ERR
QUIT
Begin DoDot:3
+31 SET LN=0
+32 FOR
SET LN=+$ORDER(MSGROOT("DIERR",ERR,"TEXT",LN))
if 'LN
QUIT
Begin DoDot:4
+33 SET LN2=LN2+1
+34 SET X(LN2)=MSGROOT("DIERR",ERR,"TEXT",LN)
End DoDot:4
End DoDot:3
+35 DO BMES^XPDUTL(.X)
End DoDot:2
End DoDot:1
+36 QUIT
