Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DG53657P

DG53657P.m

Go to the documentation of this file.
  1. DG53657P ;BAJ - Patch DG*5.3*657 Pre-Install Utility Routine ; 10/24/2006
  1. ;;5.3;Registration;**657**;AUG 13, 1993;Build 19
  1. Q
  1. ;
  1. ;
  1. EN N XPDABORT
  1. D LKUP(61,"MISSING PHONE NUMBER DATA","C")
  1. ;2 - consistency check not there, 3 - consistency check is wrong
  1. I ($G(XPDABORT)=2)!($G(XPDABORT)=3) Q ;Find file 38.6 entry
  1. D LKUP(87,"SC ELIG BUT NO RD CODES","A")
  1. Q:$G(XPDABORT)=3
  1. D POSTN ;Modify file 38.6 entry
  1. D CREATE ;add the 87 consistency check
  1. D COMPILE
  1. Q
  1. ;
  1. LKUP(RULE,FIELD01,MODE) ; Update entry in INCONSISTENT DATA ELEMENTS file (#38.6)
  1. ;MODE = 'C' change
  1. ;MODE = 'A' add
  1. N ERR,DA,DIE,DR,X
  1. K XPDABORT
  1. D BMES^XPDUTL("Checking entry #"_RULE_" in 38.6 file.")
  1. S DIE=38.6,DA=$$FIND1^DIC(DIE,"","X",RULE)
  1. I 'DA,MODE="C" D Q
  1. . S XPDABORT=2
  1. . D MES^XPDUTL(" *** Entry not found! ***")
  1. . D BMES^XPDUTL(" *** Please contact EVS for assistance ***")
  1. . D BMES^XPDUTL(" *** INSTALLATION ABORTED ***")
  1. . D BMES^XPDUTL("")
  1. . Q
  1. S X=""
  1. I $G(DA)'="" S X=$G(^DGIN(38.6,DA,0))
  1. I X'="",$P(X,"^",1)'=FIELD01 D Q
  1. . S XPDABORT=3
  1. . D MES^XPDUTL(" *** Field #.01 should be "_FIELD01_"! ***")
  1. . D BMES^XPDUTL(" *** Please contact EVS for assistance ***")
  1. . D BMES^XPDUTL(" *** INSTALLATION ABORTED ***")
  1. . D BMES^XPDUTL("")
  1. . Q
  1. Q
  1. POSTN ; Update entry in INCONSISTENT DATA ELEMENTS file (#38.6)
  1. N FILE,IENS,FIELD,DGWP,ERRORS,FDA
  1. D BMES^XPDUTL("Updating Consistency #61")
  1. ;FDA_ROOT(FILE#,"IENS",FIELD#)="VALUE"
  1. S FILE=38.6,IENS="61,",FIELD=50
  1. S DGWP(1,0)="Inconsistency results if the patient's Employment Status is EMPLOYED FULL"
  1. S DGWP(2,0)="TIME, EMPLOYED PART TIME, or SELF EMPLOYED and the PHONE NUMBER [WORK] has"
  1. S DGWP(3,0)="not been entered."
  1. S FDA(FILE,IENS,FIELD)="DGWP"
  1. D FILE^DIE("K","FDA","ERRORS(1)")
  1. I $D(ERRORS) D Q
  1. . D MES^XPDUTL(" *** Error filing Data Dictionary update! ***")
  1. . D BMES^XPDUTL(" *** Please contact EVS for assistance ***")
  1. . D BMES^XPDUTL(" *** INSTALLATION ABORTED ***")
  1. . D BMES^XPDUTL("")
  1. . Q
  1. D MES^XPDUTL(" *** Update Complete ***")
  1. D BMES^XPDUTL("")
  1. Q
  1. ;
  1. CREATE ;Post-Install
  1. N MSGROOT,FDAWP,FDAROOT,IENROOT,IEN,X,ERR,LN,LN2
  1. S X=$G(^DGIN(38.6,87,0))
  1. I $L(X),$P(X,"^",1)'="SC ELIG BUT NO RD CODES" D Q
  1. . D BMES^XPDUTL("An entry already exists in file 38.6 for consistency #87.")
  1. . D MES^XPDUTL("Cannot add SC ELIG BUT NO RD CODES.")
  1. . Q
  1. I $L(X),$P(X,"^",1)="SC ELIG BUT NO RD CODES" Q
  1. D BMES^XPDUTL("Adding Consistency #87")
  1. S IEN="+1,"
  1. S FDAROOT(38.6,IEN,.01)="SC ELIG BUT NO RD CODES"
  1. S FDAROOT(38.6,IEN,2)="SC ELIGIBILITY BUT NO RATED DISABILITY CODES"
  1. S FDAROOT(38.6,IEN,50)="FDAWP"
  1. S FDAWP(1,0)="Inconsistency results if the PRIMARY ELIGIBILITY CODE"
  1. S FDAWP(2,0)="is a 1 (SERVICE CONNECTED 50% TO 100%) or a 3 (SC LESS THAN 50%)"
  1. S FDAWP(3,0)="and no rated disabilities are present."
  1. S FDAROOT(38.6,IEN,3)="NO KEY REQUIRED"
  1. S FDAROOT(38.6,IEN,5)="CHECK"
  1. S IENROOT(1)=87
  1. D UPDATE^DIE("E","FDAROOT","IENROOT","MSGROOT")
  1. I $D(MSGROOT("DIERR")) D Q
  1. . S (ERR,LN2)=0
  1. . D ERR
  1. . D BMES^XPDUTL(.X)
  1. . Q
  1. D MES^XPDUTL(" *** CC #87 Added ***")
  1. D BMES^XPDUTL("")
  1. Q
  1. ERR F S ERR=+$O(MSGROOT("DIERR",ERR)) Q:'ERR D LN
  1. Q
  1. LN S LN=0
  1. F S LN=+$O(MSGROOT("DIERR",ERR,"TEXT",LN)) Q:'LN D
  1. . S LN2=LN2+1
  1. . S X(LN2)=MSGROOT("DIERR",ERR,"TEXT",LN)
  1. . Q
  1. Q
  1. COMPILE ;compile screen 7
  1. D BMES^XPDUTL("Re-compiling input template DG LOAD EDIT SCREEN 7 of PATIENT FILE(#2)")
  1. N X,Y,DMAX
  1. S Y=$O(^DIE("B","DG LOAD EDIT SCREEN 7",""))
  1. I Y'="" D
  1. . S X=$G(^DIE(Y,"ROU")) I $E(X)="^" S X=$E(X,2,99)
  1. . S DMAX=$$ROUSIZE^DILF
  1. . D EN^DIEZ
  1. . Q
  1. D BMES^XPDUTL("Re-compiling input template DVBHINQ UPDATE of PATIENT FILOE(#2)")
  1. S Y=$O(^DIE("B","DVBHINQ UPDATE",""))
  1. I Y'="" D
  1. . S X=$G(^DIE(Y,"ROU")) I $E(X)="^" S X=$E(X,2,99)
  1. . S DMAX=$$ROUSIZE^DILF
  1. . D EN^DIEZ
  1. . Q
  1. Q