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

MPIFP48.m

Go to the documentation of this file.
MPIFP48 ;BIRM/CMC-POST INT FOR MPIF*1*48 ;MAY 24, 2007
 ;;1.0; MASTER PATIENT INDEX VISTA ;**48**;30 Apr 99;Build 6
 ;
POST ;This post init will correct the values in fields
 ;LAST NUMBER USED (#1) and NEXT NUMBER TO USE (#3) in the 
 ;MASTER PATIENT INDEX (LOCAL NUMBERS) FILE (#984.1)
 ;
 N NODE,F1,F3,IEN,ICN
 S IEN=$O(^MPIF(984.1,0))
 S NODE=$G(^MPIF(984.1,IEN,0))
 S F1=$P(NODE,"^",2)
 S F3=$P(NODE,"^",4)
 I $L(F1)=10&($L(F3)=10) D BMES^XPDUTL("Local ICNs in file #984.1 were 10 digits already.") Q
 ;
 D SETUP(IEN)
 D BMES^XPDUTL("Local ICNs in file #984.1 are now 10 digits")
 Q
SETUP(IEN) ;
 N CHK,NUM,NXTCHK,NXTNUM,SITE,DA,DIE,DR
 S SITE=$$SITE^VASITE,SITE=$P(SITE,"^",3),SITE=SITE\1
 S DIE="^MPIF(984.1,",DA=IEN
 S NUM=SITE_"0000000",CHK=$$CHECKDG^MPIFSPC(NUM),MPINUM=NUM_"V"_CHK
 S NXTNUM=NUM+1,NXTCHK=$$CHECKDG^MPIFSPC(NXTNUM)
 S DR="1////"_NUM_";2////"_CHK_";3////"_NXTNUM_";5////"_NXTCHK
 D ^DIE
 K X,Y
 Q