DG53819D.m

DG53819D ;ALB/MM - POST INSTALL FOR DG*5.3*819 ADDING SUFFIX TO VA DOMICILIARY IN STATION TYPE FILE (#45.81) ; 10/23/97

 ;;5.3;Registration;**819**;Aug 13, 1993;Build 16

 ;

EN ; START UPDATES

 D ADD

 Q

ADD ;Add suffixes to the STATION TYPE file (#45.81)

 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 STATION

 Q

STATION ;Find or add new suffix to VA Domicililary in Station Type file (#45.81)

 N DGDOM

 S DGDOM=$G(^DIC(45.81,30,0))

 I 'DGDOM D BMES^XPDUTL(">>Could not find VA DOMICILIARY in STATION TYPE file.") Q

 I $P(DGDOM,"^",2)'="VA DOMICILIARY" D BMES^XPDUTL(">>Entry #30 in STATION TYPE file is not VA DOMICILIARY.") Q

 N DA,DIC,X,Y

 S DA(1)=30

 S DIC="^DIC(45.81,"_DA(1)_",""S"","

 S DIC("P")=$P(^DD(45.81,50,0),"^",2)

 S DIC(0)="LMQ"

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

 D ^DIC

 I +Y=-1 D BMES^XPDUTL(">>Unable to add suffix to SUFFIX PTR multiple (#50) for VA DOMICILIARY station type.") Q

 I '$P(Y,"^",3) D BMES^XPDUTL(">>suffix found in SUFFIX PTR multiple (#50) for VA DOMICILIARY station type.  Nothing changed.") Q

 D BMES^XPDUTL(">>Suffix added to SUFFIX PTR multiple (#50) for VA DOMICILIARY station type.")

 Q

DGSUFF ; SUFFIX

 ;;B1^3091214

 ;;B2^3091214

 ;;B3^3091214

 ;;B4^3091214

 ;;PB^2971001

 ;;PC^2971001

 ;;PD^2971001

 ;;PE^2971001

 ;;QUIT

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DG53819D   1353     printed  Apr 09, 2024@21:58:21                                                                                                                                                                                                    Page 2

DG53819D  ;ALB/MM - POST INSTALL FOR DG*5.3*819 ADDING SUFFIX TO VA DOMICILIARY IN STATION TYPE FILE (#45.81) ; 10/23/97

 +1       ;;5.3;Registration;**819**;Aug 13, 1993;Build 16

 +2       ;

EN        ; START UPDATES

 +1        DO ADD

 +2        QUIT 

ADD       ;Add suffixes to the STATION TYPE file (#45.81)

 +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 STATION

               End DoDot:1

 +5        QUIT 

STATION   ;Find or add new suffix to VA Domicililary in Station Type file (#45.81)

 +1        NEW DGDOM

 +2        SET DGDOM=$GET(^DIC(45.81,30,0))

 +3        IF 'DGDOM

               DO BMES^XPDUTL(">>Could not find VA DOMICILIARY in STATION TYPE file.")

               QUIT 

 +4        IF $PIECE(DGDOM,"^",2)'="VA DOMICILIARY"

               DO BMES^XPDUTL(">>Entry #30 in STATION TYPE file is not VA DOMICILIARY.")

               QUIT 

 +5        NEW DA,DIC,X,Y

 +6        SET DA(1)=30

 +7        SET DIC="^DIC(45.81,"_DA(1)_",""S"","

 +8        SET DIC("P")=$PIECE(^DD(45.81,50,0),"^",2)

 +9        SET DIC(0)="LMQ"

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

 +11       DO ^DIC

 +12       IF +Y=-1

               DO BMES^XPDUTL(">>Unable to add suffix to SUFFIX PTR multiple (#50) for VA DOMICILIARY station type.")

               QUIT 

 +13       IF '$PIECE(Y,"^",3)

               DO BMES^XPDUTL(">>suffix found in SUFFIX PTR multiple (#50) for VA DOMICILIARY station type.  Nothing changed.")

               QUIT 

 +14       DO BMES^XPDUTL(">>Suffix added to SUFFIX PTR multiple (#50) for VA DOMICILIARY station type.")

 +15       QUIT 

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