DG53657P ;BAJ - Patch DG*5.3*657 Pre-Install Utility Routine ; 10/24/2006
;;5.3;Registration;**657**;AUG 13, 1993;Build 19
Q
;
;
EN N XPDABORT
D LKUP(61,"MISSING PHONE NUMBER DATA","C")
;2 - consistency check not there, 3 - consistency check is wrong
I ($G(XPDABORT)=2)!($G(XPDABORT)=3) Q ;Find file 38.6 entry
D LKUP(87,"SC ELIG BUT NO RD CODES","A")
Q:$G(XPDABORT)=3
D POSTN ;Modify file 38.6 entry
D CREATE ;add the 87 consistency check
D COMPILE
Q
;
LKUP(RULE,FIELD01,MODE) ; Update entry in INCONSISTENT DATA ELEMENTS file (#38.6)
;MODE = 'C' change
;MODE = 'A' add
N ERR,DA,DIE,DR,X
K XPDABORT
D BMES^XPDUTL("Checking entry #"_RULE_" in 38.6 file.")
S DIE=38.6,DA=$$FIND1^DIC(DIE,"","X",RULE)
I 'DA,MODE="C" D Q
. S XPDABORT=2
. D MES^XPDUTL(" *** Entry not found! ***")
. D BMES^XPDUTL(" *** Please contact EVS for assistance ***")
. D BMES^XPDUTL(" *** INSTALLATION ABORTED ***")
. D BMES^XPDUTL("")
. Q
S X=""
I $G(DA)'="" S X=$G(^DGIN(38.6,DA,0))
I X'="",$P(X,"^",1)'=FIELD01 D Q
. S XPDABORT=3
. D MES^XPDUTL(" *** Field #.01 should be "_FIELD01_"! ***")
. D BMES^XPDUTL(" *** Please contact EVS for assistance ***")
. D BMES^XPDUTL(" *** INSTALLATION ABORTED ***")
. D BMES^XPDUTL("")
. Q
Q
POSTN ; Update entry in INCONSISTENT DATA ELEMENTS file (#38.6)
N FILE,IENS,FIELD,DGWP,ERRORS,FDA
D BMES^XPDUTL("Updating Consistency #61")
;FDA_ROOT(FILE#,"IENS",FIELD#)="VALUE"
S FILE=38.6,IENS="61,",FIELD=50
S DGWP(1,0)="Inconsistency results if the patient's Employment Status is EMPLOYED FULL"
S DGWP(2,0)="TIME, EMPLOYED PART TIME, or SELF EMPLOYED and the PHONE NUMBER [WORK] has"
S DGWP(3,0)="not been entered."
S FDA(FILE,IENS,FIELD)="DGWP"
D FILE^DIE("K","FDA","ERRORS(1)")
I $D(ERRORS) D Q
. D MES^XPDUTL(" *** Error filing Data Dictionary update! ***")
. D BMES^XPDUTL(" *** Please contact EVS for assistance ***")
. D BMES^XPDUTL(" *** INSTALLATION ABORTED ***")
. D BMES^XPDUTL("")
. Q
D MES^XPDUTL(" *** Update Complete ***")
D BMES^XPDUTL("")
Q
;
CREATE ;Post-Install
N MSGROOT,FDAWP,FDAROOT,IENROOT,IEN,X,ERR,LN,LN2
S X=$G(^DGIN(38.6,87,0))
I $L(X),$P(X,"^",1)'="SC ELIG BUT NO RD CODES" D Q
. D BMES^XPDUTL("An entry already exists in file 38.6 for consistency #87.")
. D MES^XPDUTL("Cannot add SC ELIG BUT NO RD CODES.")
. Q
I $L(X),$P(X,"^",1)="SC ELIG BUT NO RD CODES" Q
D BMES^XPDUTL("Adding Consistency #87")
S IEN="+1,"
S FDAROOT(38.6,IEN,.01)="SC ELIG BUT NO RD CODES"
S FDAROOT(38.6,IEN,2)="SC ELIGIBILITY BUT NO RATED DISABILITY CODES"
S FDAROOT(38.6,IEN,50)="FDAWP"
S FDAWP(1,0)="Inconsistency results if the PRIMARY ELIGIBILITY CODE"
S FDAWP(2,0)="is a 1 (SERVICE CONNECTED 50% TO 100%) or a 3 (SC LESS THAN 50%)"
S FDAWP(3,0)="and no rated disabilities are present."
S FDAROOT(38.6,IEN,3)="NO KEY REQUIRED"
S FDAROOT(38.6,IEN,5)="CHECK"
S IENROOT(1)=87
D UPDATE^DIE("E","FDAROOT","IENROOT","MSGROOT")
I $D(MSGROOT("DIERR")) D Q
. S (ERR,LN2)=0
. D ERR
. D BMES^XPDUTL(.X)
. Q
D MES^XPDUTL(" *** CC #87 Added ***")
D BMES^XPDUTL("")
Q
ERR F S ERR=+$O(MSGROOT("DIERR",ERR)) Q:'ERR D LN
Q
LN 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)
. Q
Q
COMPILE ;compile screen 7
D BMES^XPDUTL("Re-compiling input template DG LOAD EDIT SCREEN 7 of PATIENT FILE(#2)")
N X,Y,DMAX
S Y=$O(^DIE("B","DG LOAD EDIT SCREEN 7",""))
I Y'="" D
. S X=$G(^DIE(Y,"ROU")) I $E(X)="^" S X=$E(X,2,99)
. S DMAX=$$ROUSIZE^DILF
. D EN^DIEZ
. Q
D BMES^XPDUTL("Re-compiling input template DVBHINQ UPDATE of PATIENT FILOE(#2)")
S Y=$O(^DIE("B","DVBHINQ UPDATE",""))
I Y'="" D
. S X=$G(^DIE(Y,"ROU")) I $E(X)="^" S X=$E(X,2,99)
. S DMAX=$$ROUSIZE^DILF
. D EN^DIEZ
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53657P 3895 printed Apr 09, 2024@22:02:56 Page 2
DG53657P ;BAJ - Patch DG*5.3*657 Pre-Install Utility Routine ; 10/24/2006
+1 ;;5.3;Registration;**657**;AUG 13, 1993;Build 19
+2 QUIT
+3 ;
+4 ;
EN NEW XPDABORT
+1 DO LKUP(61,"MISSING PHONE NUMBER DATA","C")
+2 ;2 - consistency check not there, 3 - consistency check is wrong
+3 ;Find file 38.6 entry
IF ($GET(XPDABORT)=2)!($GET(XPDABORT)=3)
QUIT
+4 DO LKUP(87,"SC ELIG BUT NO RD CODES","A")
+5 if $GET(XPDABORT)=3
QUIT
+6 ;Modify file 38.6 entry
DO POSTN
+7 ;add the 87 consistency check
DO CREATE
+8 DO COMPILE
+9 QUIT
+10 ;
LKUP(RULE,FIELD01,MODE) ; Update entry in INCONSISTENT DATA ELEMENTS file (#38.6)
+1 ;MODE = 'C' change
+2 ;MODE = 'A' add
+3 NEW ERR,DA,DIE,DR,X
+4 KILL XPDABORT
+5 DO BMES^XPDUTL("Checking entry #"_RULE_" in 38.6 file.")
+6 SET DIE=38.6
SET DA=$$FIND1^DIC(DIE,"","X",RULE)
+7 IF 'DA
IF MODE="C"
Begin DoDot:1
+8 SET XPDABORT=2
+9 DO MES^XPDUTL(" *** Entry not found! ***")
+10 DO BMES^XPDUTL(" *** Please contact EVS for assistance ***")
+11 DO BMES^XPDUTL(" *** INSTALLATION ABORTED ***")
+12 DO BMES^XPDUTL("")
+13 QUIT
End DoDot:1
QUIT
+14 SET X=""
+15 IF $GET(DA)'=""
SET X=$GET(^DGIN(38.6,DA,0))
+16 IF X'=""
IF $PIECE(X,"^",1)'=FIELD01
Begin DoDot:1
+17 SET XPDABORT=3
+18 DO MES^XPDUTL(" *** Field #.01 should be "_FIELD01_"! ***")
+19 DO BMES^XPDUTL(" *** Please contact EVS for assistance ***")
+20 DO BMES^XPDUTL(" *** INSTALLATION ABORTED ***")
+21 DO BMES^XPDUTL("")
+22 QUIT
End DoDot:1
QUIT
+23 QUIT
POSTN ; Update entry in INCONSISTENT DATA ELEMENTS file (#38.6)
+1 NEW FILE,IENS,FIELD,DGWP,ERRORS,FDA
+2 DO BMES^XPDUTL("Updating Consistency #61")
+3 ;FDA_ROOT(FILE#,"IENS",FIELD#)="VALUE"
+4 SET FILE=38.6
SET IENS="61,"
SET FIELD=50
+5 SET DGWP(1,0)="Inconsistency results if the patient's Employment Status is EMPLOYED FULL"
+6 SET DGWP(2,0)="TIME, EMPLOYED PART TIME, or SELF EMPLOYED and the PHONE NUMBER [WORK] has"
+7 SET DGWP(3,0)="not been entered."
+8 SET FDA(FILE,IENS,FIELD)="DGWP"
+9 DO FILE^DIE("K","FDA","ERRORS(1)")
+10 IF $DATA(ERRORS)
Begin DoDot:1
+11 DO MES^XPDUTL(" *** Error filing Data Dictionary update! ***")
+12 DO BMES^XPDUTL(" *** Please contact EVS for assistance ***")
+13 DO BMES^XPDUTL(" *** INSTALLATION ABORTED ***")
+14 DO BMES^XPDUTL("")
+15 QUIT
End DoDot:1
QUIT
+16 DO MES^XPDUTL(" *** Update Complete ***")
+17 DO BMES^XPDUTL("")
+18 QUIT
+19 ;
CREATE ;Post-Install
+1 NEW MSGROOT,FDAWP,FDAROOT,IENROOT,IEN,X,ERR,LN,LN2
+2 SET X=$GET(^DGIN(38.6,87,0))
+3 IF $LENGTH(X)
IF $PIECE(X,"^",1)'="SC ELIG BUT NO RD CODES"
Begin DoDot:1
+4 DO BMES^XPDUTL("An entry already exists in file 38.6 for consistency #87.")
+5 DO MES^XPDUTL("Cannot add SC ELIG BUT NO RD CODES.")
+6 QUIT
End DoDot:1
QUIT
+7 IF $LENGTH(X)
IF $PIECE(X,"^",1)="SC ELIG BUT NO RD CODES"
QUIT
+8 DO BMES^XPDUTL("Adding Consistency #87")
+9 SET IEN="+1,"
+10 SET FDAROOT(38.6,IEN,.01)="SC ELIG BUT NO RD CODES"
+11 SET FDAROOT(38.6,IEN,2)="SC ELIGIBILITY BUT NO RATED DISABILITY CODES"
+12 SET FDAROOT(38.6,IEN,50)="FDAWP"
+13 SET FDAWP(1,0)="Inconsistency results if the PRIMARY ELIGIBILITY CODE"
+14 SET FDAWP(2,0)="is a 1 (SERVICE CONNECTED 50% TO 100%) or a 3 (SC LESS THAN 50%)"
+15 SET FDAWP(3,0)="and no rated disabilities are present."
+16 SET FDAROOT(38.6,IEN,3)="NO KEY REQUIRED"
+17 SET FDAROOT(38.6,IEN,5)="CHECK"
+18 SET IENROOT(1)=87
+19 DO UPDATE^DIE("E","FDAROOT","IENROOT","MSGROOT")
+20 IF $DATA(MSGROOT("DIERR"))
Begin DoDot:1
+21 SET (ERR,LN2)=0
+22 DO ERR
+23 DO BMES^XPDUTL(.X)
+24 QUIT
End DoDot:1
QUIT
+25 DO MES^XPDUTL(" *** CC #87 Added ***")
+26 DO BMES^XPDUTL("")
+27 QUIT
ERR FOR
SET ERR=+$ORDER(MSGROOT("DIERR",ERR))
if 'ERR
QUIT
DO LN
+1 QUIT
LN SET LN=0
+1 FOR
SET LN=+$ORDER(MSGROOT("DIERR",ERR,"TEXT",LN))
if 'LN
QUIT
Begin DoDot:1
+2 SET LN2=LN2+1
+3 SET X(LN2)=MSGROOT("DIERR",ERR,"TEXT",LN)
+4 QUIT
End DoDot:1
+5 QUIT
COMPILE ;compile screen 7
+1 DO BMES^XPDUTL("Re-compiling input template DG LOAD EDIT SCREEN 7 of PATIENT FILE(#2)")
+2 NEW X,Y,DMAX
+3 SET Y=$ORDER(^DIE("B","DG LOAD EDIT SCREEN 7",""))
+4 IF Y'=""
Begin DoDot:1
+5 SET X=$GET(^DIE(Y,"ROU"))
IF $EXTRACT(X)="^"
SET X=$EXTRACT(X,2,99)
+6 SET DMAX=$$ROUSIZE^DILF
+7 DO EN^DIEZ
+8 QUIT
End DoDot:1
+9 DO BMES^XPDUTL("Re-compiling input template DVBHINQ UPDATE of PATIENT FILOE(#2)")
+10 SET Y=$ORDER(^DIE("B","DVBHINQ UPDATE",""))
+11 IF Y'=""
Begin DoDot:1
+12 SET X=$GET(^DIE(Y,"ROU"))
IF $EXTRACT(X)="^"
SET X=$EXTRACT(X,2,99)
+13 SET DMAX=$$ROUSIZE^DILF
+14 DO EN^DIEZ
+15 QUIT
End DoDot:1
+16 QUIT
