Routine: MPIFP48

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")

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMPIFP48   948     printed  Dec 13, 2024@02:11:20                                                                                                                                                                                                      Page 2

MPIFP48   ;BIRM/CMC-POST INT FOR MPIF*1*48 ;MAY 24, 2007

 +1       ;;1.0; MASTER PATIENT INDEX VISTA ;**48**;30 Apr 99;Build 6

 +2       ;

POST      ;This post init will correct the values in fields

 +1       ;LAST NUMBER USED (#1) and NEXT NUMBER TO USE (#3) in the

 +2       ;MASTER PATIENT INDEX (LOCAL NUMBERS) FILE (#984.1)

 +3       ;

 +4        NEW NODE,F1,F3,IEN,ICN

 +5        SET IEN=$ORDER(^MPIF(984.1,0))

 +6        SET NODE=$GET(^MPIF(984.1,IEN,0))

 +7        SET F1=$PIECE(NODE,"^",2)

 +8        SET F3=$PIECE(NODE,"^",4)

 +9        IF $LENGTH(F1)=10&($LENGTH(F3)=10)

               DO BMES^XPDUTL("Local ICNs in file #984.1 were 10 digits already.")

               QUIT

 +10      ;

 +11       DO SETUP(IEN)

 +12       DO BMES^XPDUTL("Local ICNs in file #984.1 are now 10 digits")

 +13       QUIT

SETUP(IEN) ;

 +1        NEW CHK,NUM,NXTCHK,NXTNUM,SITE,DA,DIE,DR

 +2        SET SITE=$$SITE^VASITE

           SET SITE=$PIECE(SITE,"^",3)

           SET SITE=SITE\1

 +3        SET DIE="^MPIF(984.1,"

           SET DA=IEN

 +4        SET NUM=SITE_"0000000"

           SET CHK=$$CHECKDG^MPIFSPC(NUM)

           SET MPINUM=NUM_"V"_CHK

 +5        SET NXTNUM=NUM+1

           SET NXTCHK=$$CHECKDG^MPIFSPC(NXTNUM)

 +6        SET DR="1////"_NUM_";2////"_CHK_";3////"_NXTNUM_";5////"_NXTCHK

 +7        DO ^DIE

 +8        KILL X,Y

 +9        QUIT

MPIFP48.m