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

IVM2A102.m

Go to the documentation of this file.
  1. IVM2A102 ;ALB/PJR - IVM*2.0*102 PRE-INSTALL ; 10/25/04 12:33pm
  1. ;;2.0;INCOME VERIFICATION MATCH;**102**; 21-OCT-94
  1. ;
  1. Q
  1. PRE ; pre-install entry point
  1. ; add 2 new entries to the 301.92 file
  1. N FDA,DATA,ERR,XME,FLDNUM
  1. S DATA=""
  1. S XME=" >> Adding entries to IVM DEMOGRAPHIC UPLOAD FIELDS (#301.92) file"
  1. D BMES^XPDUTL(XME)
  1. D SOURCE(.DATA),UPDATE(.DATA)
  1. D LAST(.DATA),UPDATE(.DATA)
  1. ;;
  1. D MES^XPDUTL("")
  1. Q
  1. ;
  1. SOURCE(DATA) ; setup fda array for Source of Notification for DOD
  1. S DATA(.01)="SOURCE OF NOTIFICATION"
  1. S DATA(.02)="ZPD31",DATA(.05)=.353,DATA(.04)=2
  1. S (DATA(.03),DATA(.06),DATA(.07))=1,DATA(.08)=0
  1. S (DATA(10),DATA(20))="S DR=.353 D LOOK^IVMPREC9"
  1. Q
  1. ;
  1. LAST(DATA) ; setup fda array for Last Updated Date for DOD
  1. S DATA(.01)="DATE OF DEATH LAST UPDATED"
  1. S DATA(.02)="ZPD32",DATA(.05)=.354,DATA(.04)=2
  1. S (DATA(.03),DATA(.06),DATA(.07))=1,DATA(.08)=0
  1. S (DATA(10),DATA(20))="S DR=.354 D LOOK^IVMPREC9"
  1. Q
  1. ;
  1. UPDATE(DATA) ;
  1. I $$FIND1^DIC(301.92,"","X",$G(DATA(.01))) D ALREADY Q
  1. S FLDNUM="" F S FLDNUM=$O(DATA(FLDNUM)) Q:'FLDNUM D ADD
  1. D UPDATE^DIE("","FDA","","ERR")
  1. I $D(ERR) D ERROR Q
  1. D SUCCESS
  1. K DATA
  1. Q
  1. ADD ;;
  1. S FDA(301.92,"+1,",FLDNUM)=$G(DATA(FLDNUM)) Q
  1. ;
  1. ALREADY ;;
  1. D BMES^XPDUTL(" *** "_$G(DATA(.01))_" entry already exists!") Q
  1. ERROR ;
  1. D BMES^XPDUTL(" >>> ERROR! "_$G(DATA(.01))_" not added to file #301.92!")
  1. I $D(ERR("DIERR",1))=11 D
  1. .D MES^XPDUTL(ERR("DIERR",1)_": "_ERR("DIERR",1,"TEXT",1))
  1. Q
  1. SUCCESS ;
  1. D BMES^XPDUTL(" "_$G(DATA(.01))_" successfully added.") Q