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

AVAPCHK.m

Go to the documentation of this file. 
  1. AVAPCHK ;IHS/ORDC/LJF - CLEAN UP FILES 3,6,16&200 ; [ 10/03/95  7:57 AM ]
  1.  ;;93.2;VA SUPPORT FILES;;SEPT 18, 1995;Build 12
  1.  ;
  1.  ;This routine checks the status of your User, Person, Provider, and 
  1.  ;New Person files.  It attempts to correct links, if possible. Those
  1.  ;links this routine cannot fix are listed in the ^AVA global.
  1.  ;
  1.  ;To Area Offices: Please run this on each machine with these 4 files.
  1.  ;  1. Run ^XBCOUNT on files 3, 6, 16, and 200.
  1.  ;  2. Make sure the 3rd piece of the zero nodes of ^DIC(3
  1.  ;     and ^VA(200 are the same.  If not, set them to the larger
  1.  ;     number.
  1.  ;  3. Run EN^AVAPCHK. There is no user interface.  Then run
  1.  ;     RESULTS^AVAPCHK which displays to the screen the results.
  1.  ;  4. If it did not run clean, call me at (999) 999-9999.  I will
  1.  ;     need to hand fix those errors.
  1.  ;
  1.  ;To Developers: Use this routine to check the status of the 4 files
  1.  ;  before running your New Person conversions.  To do so, call 
  1.  ;  EN^AVAPCHK then check for the existence of ^AVA("OK"). Abort the
  1.  ;  conversion if it does not exist.
  1.  ;
  1.  Q  ;no direct entry to rtn
  1.  ;
  1. EN ;EP; called by A9AVA8
  1.  D DT^DICRW
  1.  K ^AVA(3),^AVA(16),^AVA("OK"),^AVA("NOT OK")
  1.  S X="AVAP7" X ^%ZOSF("TEST")
  1.  I '$T S ^AVA("NOT OK")="NEED AVA PATCH 7" Q
  1.  I $P($G(^DD(200,53.5,1,1,0)),U,2)'="AIHS" S ^AVA("NOT OK")="AVA PATCH 7 NOT INSTALLED" Q
  1.  D LOOP3,LOOP16,EXIT Q
  1.  ;
  1.  ;
  1. LOOP200 ; loop thru new person for missing zero nodes
  1.  S X=0 F  S X=$O(^VA(200,X)) Q:'X  I '$D(^VA(200,X,0)) W !,X
  1.  Q
  1.  ;
  1. LOOP3 ; loop thru user file
  1.  K AVA3,AVAPER
  1.  S AVA3=0
  1.  F  S AVA3=$O(^DIC(3,AVA3)) Q:AVA3'=+AVA3  D
  1.  . I '$D(^DIC(3,AVA3,0)) D ERR1
  1.  . I '$D(^VA(200,AVA3,0)) D ERR2
  1.  . S AVAPER=$P(^DIC(3,AVA3,0),U,16) I AVAPER="" D ERR3 Q:AVAPER=""
  1.  . I '$D(^DIC(16,AVAPER,0)) D ERR4
  1.  . I $G(^DIC(16,AVAPER,"A3"))="" D ERR5
  1.  . I $G(^DIC(16,AVAPER,"A3"))'=AVA3 D ERR6
  1.  Q
  1.  ;
  1.  ;
  1. LOOP16 ; loop thru person files
  1.  K AVA3,AVA16
  1.  S AVA16=0
  1.  F  S AVA16=$O(^DIC(16,AVA16)) Q:AVA16'=+AVA16  D
  1.  . I '$D(^DIC(16,AVA16,0)) D ERR7
  1.  . S AVA3=$G(^DIC(16,AVA16,"A3")) I AVA3="" D ERR8 Q:AVA3=""
  1.  . I '$D(^DIC(3,AVA3,0)) D ERR9 Q
  1.  . I $P(^DIC(3,AVA3,0),U,16)="" D ERR10
  1.  . I $P(^DIC(3,AVA3,0),U,16)'=AVA16 D ERR11
  1.  . ;
  1.  . I '$D(^DIC(6,AVA16,0)),$P($G(^DIC(6,AVA16,9999999)),U,9)]"" D ERR12
  1.  . I $P($G(^DIC(6,AVA16,0)),U,4)]"",$P($G(^VA(200,AVA3,"PS")),U,5)="" D ERR13
  1.  Q
  1.  ;
  1. EXIT ;
  1.  I '$D(^AVA(3)),'$D(^AVA(16)) S ^AVA("OK")=$H
  1.  K AVA3,AVAPER,AVA16,DIE,DA,DR,DIC Q
  1.  ;
  1.  ;
  1. ERR1 ;1=USER ENTRY MISSING 0 NODE
  1.  NEW X
  1.  I '$D(^VA(200,AVA3,0)) D SETERR(3,AVA3,"NO ZERO NODE FOR USER AND NO CORRESPONDING FILE 200 ENTRY") Q
  1.  I $D(^VA(200,AVA3,0)) D  Q
  1.  . S ^DIC(3,AVA3,0)=$P(^VA(200,AVA3,0),U,1,2)
  1.  . S $P(^DIC(3,AVA3,0),U,16)=$P(^VA(200,AVA3,0),U,16)
  1.  . S X=$P(^DIC(3,AVA3,0),U) I X]"" D
  1.  .. S ^DIC(3,"B",X,AVA3)=""
  1.  . S X=$P(^DIC(3,AVA3,0),U,2) I X]"" D
  1.  .. S ^DIC(3,"C",X,AVA3)=""
  1.  Q
  1.  ;
  1. ERR2 ;2=USER ENTRY NOT HAVE MATCHING VA(200 ENTRY
  1.  I $P(^DIC(3,AVA3,0),U)="" D ERR1 Q
  1.  S DIC="^VA(200,",DLAYGO=200,DINUM=AVA3,X=$P(^DIC(3,AVA3,0),U)
  1.  S DIC(0)="L",DIC("DR")=".02///"_$P(^DIC(3,AVA3,0),U,2)
  1.  K DD,DO D FILE^DICN
  1.  I '$D(^VA(200,AVA3,0)) D SETERR(3,AVA3,"NO COORESPONDING FILE 200 ENTRY FOR THIS USER")
  1.  Q
  1.  ;
  1. ERR3 ;3=USER ENTRY HAS NO 16TH PIECE
  1.  I $P($G(^VA(200,AVA3,0)),U,16)]"" D  Q
  1.  . S AVAPER=$P(^VA(200,AVA3,0),U,16)
  1.  . S $P(^DIC(3,AVA3,0),U,16)=AVAPER
  1.  ;D SETERR(3,AVA3,"NO USER OR FILE 200 LINK TO PERSON FILE")
  1.  Q
  1.  ;
  1. ERR4 ;4=USER ENTRY 16TH PIECE POINTS TO NON-EXISTING PERSON ENTRY
  1.  I $D(^DIC(16,+$P(^VA(200,AVA3,0),U,16),0)) D  Q
  1.  . S $P(^DIC(3,AVA3,0),U,16)=$P(^VA(200,AVA3,0),U,16)
  1.  ;
  1.  S $P(^DIC(3,AVA3,0),U,16)=""
  1.  S DIE=3,DA=AVA3,DR=".01///"_$P(^DIC(3,AVA3,0),U) D ^DIE
  1.  S DIE=200,DA=AVA3,DR="8980.16////"_$P(^DIC(3,AVA3,0),U,16) D ^DIE
  1.  I '$D(^DIC(16,$P(^DIC(3,AVA3,0),U,16),0)) D SETERR(3,AVA3,"NO PERSON MATCHED TO USER ENTRY")
  1.  Q
  1.  ;
  1. ERR5 ;5=USER ENTRY POINTS TO PERSON WITH NO A3 NODE
  1.  S ^DIC(16,AVAPER,"A3")=AVA3
  1.  Q
  1.  ;
  1. ERR6 ;6=USER ENTRY POINTS TO PERSON ENTRY WITH MISS-MATCHED A3 NODE
  1.  D SETERR(3,AVA3,"MISMATCHED 'A3' NODE & USER LINK; PERSON #"_AVAPER)
  1.  Q
  1.  ;
  1. ERR7 ;7=PERSON ENTRY HAS NO ZERO NODE
  1.  NEW X
  1.  S X=$G(^DIC(16,AVA16,"A3"))
  1.  I X]"",$P($G(^VA(200,X,0)),U)]"" D  Q
  1.  . S $P(^DIC(16,AVA16,0),U)=$P(^VA(200,X,0),U)
  1.  . S ^DIC(16,"B",$P(^VA(200,X,0),U),AVA16)=""
  1.  D SETERR(16,AVA16,"NO ZERO NODE FOR PERSON")
  1.  Q
  1.  ;
  1. ERR8 ;8=PERSON ENTRY HAS NULL A3 NODE
  1.  NEW X
  1.  S X=$P(^DIC(16,AVA16,0),U,9)
  1.  I X]"" S Y=$O(^VA(200,"SSN",X,0)) I Y]"" S (^DIC(16,AVA16,"A3"),AVA3)=Y
  1.  I $G(^DIC(16,AVA16,"A3"))="" D SETERR(16,AVA16,"NULL OR NON-EXISTING A3 NODE")
  1.  Q
  1.  ;
  1. ERR9 ;9=PERSON ENTRY A3 NODE POINTS TO NON-EXISITING USER ENTRY
  1.  I $D(^VA(200,AVA3,0)) D  Q
  1.  . D ERR1
  1.  . S $P(^DIC(3,AVA3,0),U,16)=AVA16,$P(^VA(200,AVA3,0),U,16)=AVA16
  1.  D SETERR(16,AVA16,"A3 POINTS TO NON-EXISTING USER ENTRY")
  1.  Q
  1.  ;
  1. ERR10 ;10=PERSON ENTRY A3 NODE POINTS TO USER ENTRY WITH NULL 16TH PIECE
  1.  I $P($G(^VA(200,AVA3,0)),U,16)'=AVA16 D SETERR(16,AVA16,"A3 POINTER NOT MATCHING FILE 200 OR 3") Q
  1.  S $P(^DIC(3,AVA3,0),U,16)=AVA16
  1.  S $P(^VA(200,AVA3,0),U,16)=AVA16
  1.  Q
  1.  ;
  1. ERR11 ;11=PERSON ENTRY A3 NODE POINTS TO USER ENTRY WITH MISMATCHED 16TH
  1.  NEW X
  1.  S X=$P(^DIC(3,AVA3,0),U,16)
  1.  I X,$G(^DIC(16,+X,"A3"))=AVA3 Q
  1.  D SETERR(16,AVA16,"A3 NODE POINTS TO MISMATCHED USER ENTRY")
  1.  Q
  1.  ;
  1. ERR12 ;12=PROVIDER ENTRY HAS NO ZERO NODE BUT HAS 99999999 NODE
  1.  K ^DIC(6,"GIHS",$P(^DIC(6,AVA16,9999999),U,9),AVA16)
  1.  K ^DIC(6,AVA16)
  1.  S AVA200=$P($G(^DIC(16,AVA16,"A3")),U) ;ifn in file 200
  1.  S AVACLS=$P($G(^VA(200,AVA200,"PS")),U,5) Q:AVACLS=""
  1.  ;
  1.  S DIE="^VA(200,",DA=AVA200,DR="53.5///@" D ^DIE
  1.  S DR="53.5////"_AVACLS D ^DIE
  1.  I '$D(^DIC(6,AVA16,0)) D SETERR(16,AVA16,"NO PROVIDER ZERO NODE")
  1.  Q
  1.  ;
  1. ERR13 ;13=IF PROVIDER HAS PROVIDER CLASS BUT FILE 200 DOESN'T: FIX IT
  1.  S DIE="^VA(200,",DA=AVA3,DR="53.5////"_$P(^DIC(6,AVA16,0),U,4) D ^DIE
  1.  I $P(^VA(200,AVA3,"PS"),U,5)="" D SETERR(16,AVA16,"NO CLASS IN FILE 200")
  1.  Q
  1.  ;
  1.  ;
  1. SETERR(FILE,IEN,MSG) ; -- SUBRTN to set entry into error file
  1.  I FILE=3 S ^AVA(3,IEN)=MSG Q
  1.  S ^AVA(16,IEN)=MSG Q
  1.  ;
  1. RESULTS ;EP; called to display results of run
  1.  D DT^DICRW,^XBCLS
  1.  W !!,"RESULTS OF AVA CHECK OF FILES 3, 6, 16, & 200",!
  1.  ;
  1.  I $D(^AVA("OK")) D  Q
  1.  . W !!,"ALL FILES OKAY!  READY FOR CONVERSION."
  1.  . S %H=^AVA("OK") D YX^%DTC W !,"Check completed at ",Y D READ
  1.  ;
  1.  I $D(^AVA("NOT OK")) D  Q
  1.  . W !!,"FILE CHECK NOT RUN!  ",^AVA("NOT OK") D READ
  1.  ;
  1.  F AVAF=3,16 D
  1.  . I $O(^AVA(AVAF,0)) W !!,"ERRORS FROM FILE ",AVAF
  1.  . S AVAX=0 F  S AVAX=$O(^AVA(AVAF,AVAX)) Q:'AVAX  D
  1.  .. W !,"Entry #",AVAX,?15,^AVA(AVAF,AVAX)
  1.  .. I $Y>20 D READ,^XBCLS
  1.  ;
  1.  K DIR,AVAF,AVAX Q
  1.  ;
  1. READ ;
  1.  K DIR S DIR(0)="E",DIR("A")="Press ENTER to continue" D ^DIR Q
  1.  ;
  1. ADD1(AVAX) ;EP; called to add new person & user entries for person entry
  1.  NEW AVA3,X
  1.  S AVA3=$P(^VA(200,0),U,3)+1
  1.  Q:$D(^VA(200,AVA3))  Q:$D(^DIC(3,AVA3))
  1.  S $P(^VA(200,0),U,3)=AVA3,$P(^DIC(3,0),U,3)=AVA3
  1.  ;
  1.  S ^VA(200,AVA3,0)=$P(^DIC(16,AVAX,0),U) ;name
  1.  S ^VA(200,"B",$P(^VA(200,AVA3,0),U),AVA3)="" ;name xref
  1.  S $P(^VA(200,AVA3,0),U,16)=AVAX ;person pointer
  1.  S X=$P(^DIC(16,AVAX,0),U,9) I X]"" D
  1.  . S $P(^VA(200,AVA3,1),U,9)=X
  1.  . S ^VA(200,"SSN",X,AVA3)=""
  1.  ;
  1.  S ^DIC(3,AVA3,0)=$P(^DIC(16,AVAX,0),U)
  1.  S ^DIC(3,"B",$P(^DIC(3,AVA3,0),U),AVA3)=""
  1.  S $P(^DIC(3,AVA3,0),U,16)=AVAX
  1.  ;
  1.  S ^DIC(16,AVAX,"A3")=AVA3
  1.  Q