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 ---[H[J[2J[HDG53819D 1353 printed Dec 13, 2024@02:38:54 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
