Routine: DGP1104

DGP1104 ;ALB/CC - ADD COMPACT TO DG ADMISSIONS FILE ; Mar 22, 2023@14:22:39

 ;;5.3;Registration;**1104**;Aug 13, 1993;Build 59

POST ;

 D BMES^XPDUTL("Running post-install routine DGP1104")

 S DIC="^DIC(43.4,"

 S DIC(0)="L"

 S X="COMPACT ACT"

 D ^DIC

 W !,Y

 I Y=-1 D BMES^XPDUTL("COMPACT Act record was not added")

 I Y'=-1 D

 . D BMES^XPDUTL("COMPACT Act record was added")

 . N POSTSEQ

 . S POSTSEQ=$O(^DIC(43.4,"B","COMPACT ACT",""))

 . S $P(^DIC(43.4,POSTSEQ,0),"^",3)=17.1220

 . S $P(^DIC(43.4,POSTSEQ,0),"^",4)=0

 . S $P(^DIC(43.4,POSTSEQ,0),"^",6)=47

 K DIC,X,Y,DIE,DA,DR

 D BMES^XPDUTL("Post-install routine DGP1104 has completed")

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGP1104   669     printed  Mar 13, 2025@21:51:42                                                                                                                                                                                                      Page 2

DGP1104   ;ALB/CC - ADD COMPACT TO DG ADMISSIONS FILE ; Mar 22, 2023@14:22:39

 +1       ;;5.3;Registration;**1104**;Aug 13, 1993;Build 59

 +2        QUIT

POST      ;

 +1        DO BMES^XPDUTL("Running post-install routine DGP1104")

 +2        SET DIC="^DIC(43.4,"

 +3        SET DIC(0)="L"

 +4        SET X="COMPACT ACT"

 +5        DO ^DIC

 +6        WRITE !,Y

 +7        IF Y=-1

               DO BMES^XPDUTL("COMPACT Act record was not added")

 +8        IF Y'=-1

               Begin DoDot:1

 +9                DO BMES^XPDUTL("COMPACT Act record was added")

 +10               NEW POSTSEQ

 +11               SET POSTSEQ=$ORDER(^DIC(43.4,"B","COMPACT ACT",""))

 +12               SET $PIECE(^DIC(43.4,POSTSEQ,0),"^",3)=17.1220

 +13               SET $PIECE(^DIC(43.4,POSTSEQ,0),"^",4)=0

 +14               SET $PIECE(^DIC(43.4,POSTSEQ,0),"^",6)=47

               End DoDot:1

 +15       KILL DIC,X,Y,DIE,DA,DR

 +16       DO BMES^XPDUTL("Post-install routine DGP1104 has completed")

 +17       QUIT

DGP1104.m