DG505P.m

DG505P ;BIR/PTD-PATCH DG*5.3*505 PRE/POST INSTALLATION ROUTINE ;4/7/03

 ;;5.3;Registration;**505,1015**;Aug 13, 1993;Build 21

 ;

 ;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

DG505P    ;BIR/PTD-PATCH DG*5.3*505 PRE/POST INSTALLATION ROUTINE ;4/7/03

 +1       ;;5.3;Registration;**505,1015**;Aug 13, 1993;Build 21

 +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