DG53145P.m

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

 ;;5.3;Registration;**145**;Aug 13, 1993

 ;

EN ;Find or add PA 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="PA"

 D ^DIC

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

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

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

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DG53145P   980     printed  Dec 13, 2024@02:36:16                                                                                                                                                                                                     Page 2

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

 +1       ;;5.3;Registration;**145**;Aug 13, 1993

 +2       ;

EN        ;Find or add PA 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="PA"

 +11       DO ^DIC

 +12       IF +Y=-1

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

               QUIT 

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

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

               QUIT 

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

 +15       QUIT