DG53819C.m

DG53819C ;ALB/MJB - POST INSTALL ROUTINE ; 11/19/09

 ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20

 ;

 Q

EN ; START UPDATES

 D ADD

 D UPD

 Q

ADD ;Add suffixes to the Suffix file (#45.68)

 N DGI,DGERR,DGSUFF,DGIFN,DGQUES

 S DGIFN=0

 F DGI=1:1 S DGSUFF=$P($T(DGSUFF+DGI),";;",2) Q:DGSUFF="QUIT"  D

 .D SUFFIX

 Q

SUFFIX ; Add Suffix

 K DD,DO

 N DA,DIC,DIE,DLAYGO,DR,X,Y,DGDT

 S DLAYGO=45.68

 S DIC="^DIC(45.68,",DIC(0)="XLZ"

 S X=$P(DGSUFF,U,1)

 S DGDT=$P(DGSUFF,U,2)

 D ^DIC I Y<0 D BMES^XPDUTL(">> Error adding Suffix.  Call Customer Support.") Q

 D BMES^XPDUTL(" >> Suffix added to FACILITY SUFFIX file.")

 S (DIC,DIE)="^DIC(45.68,"_+Y_",""E"",",DA(1)=+Y,DIC("P")=$P(^DD(45.68,10,0),U,2),DIC(0)="XLZ",X=DGDT

 D ^DIC

 I Y<0 D BMES^XPDUTL(">> Error adding Suffix Effective Date.  Call Customer Support.") Q

 S DA=+Y

 S DR=".01////^S X=DGDT;.02////1"

 D ^DIE

 Q

 ;

DGSUFF ; SUFFIX

 ;;B1^3091214

 ;;B2^3091214

 ;;B3^3091214

 ;;B4^3091214

 ;;PB^2971001

 ;;PC^2971001

 ;;PD^2971001

 ;;PE^2971001

 ;;QUIT

 ;

UPD ;Update suffixes in the Suffix file (#45.68)

 N DGI,DGERR,DGSUFF,DGIFN,DGQUES

 S DGIFN=0

 F DGI=1:1 S DGSUFF=$P($T(DGSUFU+DGI),";;",2) Q:DGSUFF="QUIT"  D

 .D SUFFUP

 Q

SUFFUP ; Update Suffix

 K DD,DO

 N DA,DIC,DIE,DLAYGO,DR,X,Y,DGDT

 S DLAYGO=45.68

 S DIC="^DIC(45.68,",DIC(0)="XLZ"

 S X=$P(DGSUFF,U,1)

 S DGDT=$P(DGSUFF,U,2)

 D ^DIC I Y<0 D BMES^XPDUTL(">> Error updating Suffix.  Call Customer Support.") Q

 D BMES^XPDUTL(" >> Suffix updated in FACILITY SUFFIX file.")

 S (DIC,DIE)="^DIC(45.68,"_+Y_",""E"",",DA(1)=+Y,DIC("P")=$P(^DD(45.68,10,0),U,2),DIC(0)="XLZ",X=2931001

 D ^DIC

 I Y<0 D BMES^XPDUTL(">> Error updating Suffix Effective Date.  Call Customer Support.") Q

 S DA=+Y

 S DR=".02////1"

 D ^DIE

 Q

 ;

DGSUFU ; SUFFIX

 ;;BV^2931001

 ;;BW^2931001

 ;;BX^2931001

 ;;QUIT

 ;

DG53819C  ;ALB/MJB - POST INSTALL ROUTINE ; 11/19/09

 +1       ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20

 +2       ;

 +3        QUIT 

EN        ; START UPDATES

 +1        DO ADD

 +2        DO UPD

 +3        QUIT 

ADD       ;Add suffixes to the Suffix file (#45.68)

 +1        NEW DGI,DGERR,DGSUFF,DGIFN,DGQUES

 +2        SET DGIFN=0

 +3        FOR DGI=1:1

               SET DGSUFF=$PIECE($TEXT(DGSUFF+DGI),";;",2)

               IF DGSUFF="QUIT"

                   QUIT 

               Begin DoDot:1

 +4                DO SUFFIX

               End DoDot:1

 +5        QUIT 

SUFFIX    ; Add Suffix

 +1        KILL DD,DO

 +2        NEW DA,DIC,DIE,DLAYGO,DR,X,Y,DGDT

 +3        SET DLAYGO=45.68

 +4        SET DIC="^DIC(45.68,"

           SET DIC(0)="XLZ"

 +5        SET X=$PIECE(DGSUFF,U,1)

 +6        SET DGDT=$PIECE(DGSUFF,U,2)

 +7        DO ^DIC

           IF Y<0

               DO BMES^XPDUTL(">> Error adding Suffix.  Call Customer Support.")

               QUIT 

 +8        DO BMES^XPDUTL(" >> Suffix added to FACILITY SUFFIX file.")

 +9        SET (DIC,DIE)="^DIC(45.68,"_+Y_",""E"","

           SET DA(1)=+Y

           SET DIC("P")=$PIECE(^DD(45.68,10,0),U,2)

           SET DIC(0)="XLZ"

           SET X=DGDT

 +10       DO ^DIC

 +11       IF Y<0

               DO BMES^XPDUTL(">> Error adding Suffix Effective Date.  Call Customer Support.")

               QUIT 

 +12       SET DA=+Y

 +13       SET DR=".01////^S X=DGDT;.02////1"

 +14       DO ^DIE

 +15       QUIT 

 +16      ;

DGSUFF    ; SUFFIX

 +1       ;;B1^3091214

 +2       ;;B2^3091214

 +3       ;;B3^3091214

 +4       ;;B4^3091214

 +5       ;;PB^2971001

 +6       ;;PC^2971001

 +7       ;;PD^2971001

 +8       ;;PE^2971001

 +9       ;;QUIT

 +10      ;

UPD       ;Update suffixes in the Suffix file (#45.68)

 +1        NEW DGI,DGERR,DGSUFF,DGIFN,DGQUES

 +2        SET DGIFN=0

 +3        FOR DGI=1:1

               SET DGSUFF=$PIECE($TEXT(DGSUFU+DGI),";;",2)

               IF DGSUFF="QUIT"

                   QUIT 

               Begin DoDot:1

 +4                DO SUFFUP

               End DoDot:1

 +5        QUIT 

SUFFUP    ; Update Suffix

 +1        KILL DD,DO

 +2        NEW DA,DIC,DIE,DLAYGO,DR,X,Y,DGDT

 +3        SET DLAYGO=45.68

 +4        SET DIC="^DIC(45.68,"

           SET DIC(0)="XLZ"

 +5        SET X=$PIECE(DGSUFF,U,1)

 +6        SET DGDT=$PIECE(DGSUFF,U,2)

 +7        DO ^DIC

           IF Y<0

               DO BMES^XPDUTL(">> Error updating Suffix.  Call Customer Support.")

               QUIT 

 +8        DO BMES^XPDUTL(" >> Suffix updated in FACILITY SUFFIX file.")

 +9        SET (DIC,DIE)="^DIC(45.68,"_+Y_",""E"","

           SET DA(1)=+Y

           SET DIC("P")=$PIECE(^DD(45.68,10,0),U,2)

           SET DIC(0)="XLZ"

           SET X=2931001

 +10       DO ^DIC

 +11       IF Y<0

               DO BMES^XPDUTL(">> Error updating Suffix Effective Date.  Call Customer Support.")

               QUIT 

 +12       SET DA=+Y

 +13       SET DR=".02////1"

 +14       DO ^DIE

 +15       QUIT 

 +16      ;

DGSUFU    ; SUFFIX

 +1       ;;BV^2931001

 +2       ;;BW^2931001

 +3       ;;BX^2931001

 +4       ;;QUIT

 +5       ;