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

DG53177P.m

Go to the documentation of this file. 
  1. DG53177P ;ALB/SEK - VALIDATE ELIGIBILITY CODE FILES ROUTINE; 20 JULY 1998
  1.  ;;5.3;Registration;**177,1015**;Aug 13, 1993;Build 21
  1.  ;
  1.  ; This routine will validate entries in the MAS ELIGIBILITY CODE
  1.  ; file (#8.1) and the ELIGIBILITY CODE file (#8).
  1.  ;
  1.  ; The MAS ELIGIBILITY CODE file will be checked to see that there
  1.  ; are 21 entries with the correct internal entry number (IEN),
  1.  ; name, and inactive flag.
  1.  ; Discrepancies will be printed.
  1.  ;
  1.  ; If discrepancies are found in the MAS ELIGIBILITY CODE file, the
  1.  ; ELIGIBILITY CODE file is not checked and the user is asked to
  1.  ; correct the discrepancies and rerun this routine (D ^DG53177P).
  1.  ;
  1.  ; The following checks will be done on the ELIGIBILITY CODE file:
  1.  ; . Each entry (MAS ELIGIBILITY CODE field) points to an entry in
  1.  ;   the MAS ELIGIBILITY CODE file.  Discrepancies will be printed.
  1.  ; . Inactive entry points to an active entry in the MAS ELIGIBILITY.
  1.  ;   All occurrences will be printed with a message stating this may
  1.  ;   be correct, just listing for further review.
  1.  ; . Active entry points to an inactive entry in the MAS ELIGIBILITY.
  1.  ;   Occurrences will be printed.
  1.  ;
  1.  ;
  1.  ; Checking the MAS ELIGIBILITY CODE file (#8.1)
  1. EN ; 
  1.  D BMES^XPDUTL(">>> Checking the internal entry number(IEN), name, and activity")
  1.  D MES^XPDUTL("    of the 21 entries in the MAS ELIGIBILITY CODE file (#8.1).")
  1.  N DG1,DG2,DGACT,DGIEN,DGN,DGNAME,DGS,DGSACT,DGX,DGX1
  1.  K DGERR
  1.  S DGN=0
  1.  F DG1=1:1 S DGX=$P($T(DATA+DG1),";;",2) G:DGX="QUIT" PRINT D
  1.  .S DGIEN=$P(DGX,"^"),DGNAME=$P(DGX,"^",2),DGACT=$P(DGX,"^",3)
  1.  .S DGS=$G(^DIC(8.1,DGIEN,0)) I DGS']"" S DGN=DGN+1,DGERR(DGN)=DGX_";" Q
  1.  .I DGNAME'=$P(DGS,"^")!(DGACT'=$P(DGS,"^",7)) D  Q
  1.  ..S DGN=DGN+1,DGERR(DGN)=DGX_";A"
  1.  ..Q
  1.  .Q
  1.  ;
  1. PRINT ; Print MAS ELIGIBILITY CODE file discrepancies
  1.  G:'DGN NODEZ
  1.  D BMES^XPDUTL("   The following discrepancies were found:")
  1.  F DG2=1:1:DGN D
  1.  .S DGX=$P($G(DGERR(DG2)),";")
  1.  .S DGIEN=$P(DGX,"^"),DGNAME=$P(DGX,"^",2),DGACT=$P(DGX,"^",3)
  1.  .S DGX1=$P($G(DGERR(DG2)),";",2) I DGX1="" D  Q
  1.  ..D MES^XPDUTL("Missing IEN of "_DGIEN_" - "_DGNAME_" and "_$S(DGACT:"inactive",1:"active"))
  1.  ..Q
  1.  .D MES^XPDUTL("IEN of "_DGIEN_" should be "_DGNAME_" and "_$S(DGACT:"inactive",1:"active"))
  1.  .Q
  1.  ;
  1. NODEZ ; check ^DIC(8.1,0 for 21 entries
  1.  I $P($G(^DIC(8.1,0)),"^",4)>21 D  G CORR
  1.  .D BMES^XPDUTL("   The number of entries in the MAS ELIGIBILITY CODE file is greater than 21")
  1.  ;
  1.  I 'DGN D BMES^XPDUTL("   MAS ELIGIBILITY CODE file (#8.1) is correct.") G CHECK
  1.  ;
  1. CORR D BMES^XPDUTL(">>> Please correct the discrepancies in the MAS ELIGIBILITY CODE file")
  1.  D MES^XPDUTL("    and rerun DG53177P (D ^DG53177P)")
  1.  G QUIT
  1.  ;
  1. CHECK ; Checking the ELIGIBILITY CODE file (#8)
  1.  ;
  1.  D BMES^XPDUTL(">>> Checking the entries in the ELIGIBILITY CODE file (#8).")
  1.  N DG1,DG2,DGP,DGACT,DGN,DGSACT
  1.  ;
  1.  ; Each entry (MAS ELIGIBILITY CODE field) must point to an entry in
  1.  ; the MAS ELIGIBILITY CODE file.
  1.  ;
  1.  S DGN=0,DG1=0
  1.  F  S DG1=$O(^DIC(8,DG1)) G:'DG1 PRINT1 D
  1.  .S DG2=$G(^DIC(8,DG1,0)) Q:DG2=""
  1.  .S DGP=$P(DG2,"^",9)
  1.  .I DGP<1!(DGP>21) S DGN=DGN+1,DGERR(1,DGN)=DG1_"^"_$P(DG2,"^") Q
  1.  .S DGACT=$P($P($T(DATA+DGP),";;",2),"^",3)
  1.  .S DGSACT=$P(DG2,"^",7)
  1.  .I DGSACT=1&(DGACT'=1) S DGN=DGN+1,DGERR(2,DGN)=DG1_"^"_$P(DG2,"^") Q
  1.  .I DGSACT'=1&(DGACT=1) S DGN=DGN+1,DGERR(3,DGN)=DG1_"^"_$P(DG2,"^") Q
  1.  .Q
  1.  ;
  1. PRINT1 ; Print ELIGIBILITY CODE file discrepancies
  1.  I 'DGN D  G QUIT
  1.  . D BMES^XPDUTL("   ELIGIBILITY CODE file (#8) is correct.")
  1.  . D BMES^XPDUTL("   Validation has completed with no discrepancies found")
  1.  .Q
  1.  ;
  1.  N DG1,DG2
  1.  S DG1=0
  1.  F  S DG1=$O(DGERR(DG1)) Q:'DG1  D
  1.  .D @$S(DG1=1:"ERR1",DG1=2:"ERR2",1:"ERR3")
  1.  .S DG2=0
  1.  .F  S DG2=$O(DGERR(DG1,DG2)) Q:'DG2  D
  1.  ..D MES^XPDUTL("    IEN= "_$P(DGERR(DG1,DG2),"^")_"  NAME= "_$P(DGERR(DG1,DG2),"^",2))
  1.  ..Q
  1.  G QUIT1
  1.  ;
  1. ERR1 D BMES^XPDUTL("   The following entries do not point to an entry in the")
  1.  D MES^XPDUTL("      MAS ELIGIBILITY CODE file:")
  1.  Q
  1.  ;
  1. ERR2 D BMES^XPDUTL("   The following inactive entries point to an active")
  1.  D MES^XPDUTL("      entry in the MAS ELIGIBILITY CODE file:")
  1.  D MES^XPDUTL("   These may be correct, just listing for further review.")
  1.  Q
  1.  ;
  1. ERR3 D BMES^XPDUTL("   The following active entries point to an inactive")
  1.  D MES^XPDUTL("      entry in the MAS ELIGIBILITY CODE file:")
  1.  Q
  1.  ;
  1. QUIT1 D BMES^XPDUTL(">>> Please correct the discrepancies in the ELIGIBILITY CODE file")
  1.  D MES^XPDUTL("    and rerun DG53177P (D ^DG53177P)")
  1.  ;
  1. QUIT K DGERR
  1.  Q
  1.  ;
  1. DATA ; IEN^NAME^INACTIVE of MAS ELIGIBILIY CODE file (#8.1)
  1.  ;;1^SERVICE CONNECTED 50% to 100%
  1.  ;;2^AID & ATTENDANCE
  1.  ;;3^SC LESS THAN 50%
  1.  ;;4^NSC, VA PENSION
  1.  ;;5^NSC
  1.  ;;6^OTHER FEDERAL AGENCY
  1.  ;;7^ALLIED VETERAN
  1.  ;;8^HUMANITARIAN EMERGENCY
  1.  ;;9^SHARING AGREEMENT
  1.  ;;10^REIMBURSABLE INSURANCE
  1.  ;;11^DOM. PATIENT^1
  1.  ;;12^CHAMPVA
  1.  ;;13^COLLATERAL OF VET.
  1.  ;;14^EMPLOYEE
  1.  ;;15^HOUSEBOUND
  1.  ;;16^MEXICAN BORDER WAR
  1.  ;;17^WORLD WAR I
  1.  ;;18^PRISONER OF WAR
  1.  ;;19^TRICARE/CHAMPUS
  1.  ;;20^MEDICARE^1
  1.  ;;21^CATASTROPHICALLY DISABLED
  1.  ;;QUIT