ECX342P ;ALB/ESD - Patch ECX*3.0*40 Post-Install Utility Routine ; 01/24/02
;;3.0;DSS EXTRACTS;**42**;Dec 22, 1997
;
;
ENV ;- Main entry point for environment check
;
S XPDABORT=""
;
;- Checks programmer variables
D PROGCHK(.XPDABORT)
I XPDABORT="" K XPDABORT
Q
;
;
PRE ;- Main entry point for pre-init items
Q
;
;
POST ;- Main entry point for post-init items
;
;- Add new entries to DSS PRODUCTION UNIT (#729) file
D POST1
Q
;
;
PROGCHK(XPDABORT) ;Checks for necessary programmer variables
;
I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") D
.D BMES^XPDUTL("******** ERROR ********")
.D MES^XPDUTL("Your programming variables are not set up properly.")
.D MES^XPDUTL("Installation aborted.")
.D MES^XPDUTL("************************")
.S XPDABORT=2
Q
;
;
POST1 ;
;
;- This procedure will add new entries to the DSS PRODUCTION UNIT
; (#729) file.
;
N ECXFDA,ECXERR,ECXCODE,ECXREC,I
;
D BMES^XPDUTL(">>> Updating DSS PRODUCTION UNIT (#729) file...")
S $P(^DD(729,.01,0),U,5)=""
;
;- Get DSS Production Unit text
F I=1:1 S ECXREC=$P($T(PROUNIT+I),";;",2) Q:ECXREC="QUIT" D
.;
.;- Production Unit code
.S ECXCODE=$P(ECXREC,"^")
.;
.;- Quit w/error message if entry already exists in file #729
.I $$FIND1^DIC(729,"","X",ECXCODE) D Q
..D BMES^XPDUTL(">>>...."_ECXCODE_" "_$P(ECXREC,U,2)_" not added, entry already exists.")
..D MES^XPDUTL(">>> Delete entry and reinstall patch if this entry was not created by a")
..D MES^XPDUTL(">>> previous installation of this patch.")
.;
.;- Setup field values of new entry
.S ECXFDA(729,"+1,",.01)=ECXCODE
.S ECXFDA(729,"+1,",1)=$P(ECXREC,"^",2)
.S ECXFDA(729,"+1,",2)=$P(ECXREC,"^",3)
.;
.;- Add new entry to file #729
.D UPDATE^DIE("E","ECXFDA","","ECXERR")
.;
.I '$D(ECXERR) D BMES^XPDUTL(">>>...."_ECXCODE_" "_$P(ECXREC,U,2)_" added to file.")
.I $D(ECXERR) D BMES^XPDUTL(">>>....Unable to add "_ECXCODE_" "_$P(ECXREC,U,2)_" to file.")
;
D BMES^XPDUTL(">>> Update completed.")
S $P(^DD(729,.01,0),U,5)="K X"
;
Q
;
;
PROUNIT ;- Contains the DSS Production Units to be added
;;24^Geropsych Ward 2^GERPSYWRD2
;;25^Geropsych Ward 3^GERPSYWRD3
;;26^Geropsych Ward 4^GERPSYWRD4
;;27^Geropsych Ward 5^GERPSYWRD5
;;QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECX342P 2328 printed Apr 09, 2024@20:55:51 Page 2
ECX342P ;ALB/ESD - Patch ECX*3.0*40 Post-Install Utility Routine ; 01/24/02
+1 ;;3.0;DSS EXTRACTS;**42**;Dec 22, 1997
+2 ;
+3 ;
ENV ;- Main entry point for environment check
+1 ;
+2 SET XPDABORT=""
+3 ;
+4 ;- Checks programmer variables
+5 DO PROGCHK(.XPDABORT)
+6 IF XPDABORT=""
KILL XPDABORT
+7 QUIT
+8 ;
+9 ;
PRE ;- Main entry point for pre-init items
+1 QUIT
+2 ;
+3 ;
POST ;- Main entry point for post-init items
+1 ;
+2 ;- Add new entries to DSS PRODUCTION UNIT (#729) file
+3 DO POST1
+4 QUIT
+5 ;
+6 ;
PROGCHK(XPDABORT) ;Checks for necessary programmer variables
+1 ;
+2 IF '$GET(DUZ)!($GET(DUZ(0))'="@")!('$GET(DT))!($GET(U)'="^")
Begin DoDot:1
+3 DO BMES^XPDUTL("******** ERROR ********")
+4 DO MES^XPDUTL("Your programming variables are not set up properly.")
+5 DO MES^XPDUTL("Installation aborted.")
+6 DO MES^XPDUTL("************************")
+7 SET XPDABORT=2
End DoDot:1
+8 QUIT
+9 ;
+10 ;
POST1 ;
+1 ;
+2 ;- This procedure will add new entries to the DSS PRODUCTION UNIT
+3 ; (#729) file.
+4 ;
+5 NEW ECXFDA,ECXERR,ECXCODE,ECXREC,I
+6 ;
+7 DO BMES^XPDUTL(">>> Updating DSS PRODUCTION UNIT (#729) file...")
+8 SET $PIECE(^DD(729,.01,0),U,5)=""
+9 ;
+10 ;- Get DSS Production Unit text
+11 FOR I=1:1
SET ECXREC=$PIECE($TEXT(PROUNIT+I),";;",2)
if ECXREC="QUIT"
QUIT
Begin DoDot:1
+12 ;
+13 ;- Production Unit code
+14 SET ECXCODE=$PIECE(ECXREC,"^")
+15 ;
+16 ;- Quit w/error message if entry already exists in file #729
+17 IF $$FIND1^DIC(729,"","X",ECXCODE)
Begin DoDot:2
+18 DO BMES^XPDUTL(">>>...."_ECXCODE_" "_$PIECE(ECXREC,U,2)_" not added, entry already exists.")
+19 DO MES^XPDUTL(">>> Delete entry and reinstall patch if this entry was not created by a")
+20 DO MES^XPDUTL(">>> previous installation of this patch.")
End DoDot:2
QUIT
+21 ;
+22 ;- Setup field values of new entry
+23 SET ECXFDA(729,"+1,",.01)=ECXCODE
+24 SET ECXFDA(729,"+1,",1)=$PIECE(ECXREC,"^",2)
+25 SET ECXFDA(729,"+1,",2)=$PIECE(ECXREC,"^",3)
+26 ;
+27 ;- Add new entry to file #729
+28 DO UPDATE^DIE("E","ECXFDA","","ECXERR")
+29 ;
+30 IF '$DATA(ECXERR)
DO BMES^XPDUTL(">>>...."_ECXCODE_" "_$PIECE(ECXREC,U,2)_" added to file.")
+31 IF $DATA(ECXERR)
DO BMES^XPDUTL(">>>....Unable to add "_ECXCODE_" "_$PIECE(ECXREC,U,2)_" to file.")
End DoDot:1
+32 ;
+33 DO BMES^XPDUTL(">>> Update completed.")
+34 SET $PIECE(^DD(729,.01,0),U,5)="K X"
+35 ;
+36 QUIT
+37 ;
+38 ;
PROUNIT ;- Contains the DSS Production Units to be added
+1 ;;24^Geropsych Ward 2^GERPSYWRD2
+2 ;;25^Geropsych Ward 3^GERPSYWRD3
+3 ;;26^Geropsych Ward 4^GERPSYWRD4
+4 ;;27^Geropsych Ward 5^GERPSYWRD5
+5 ;;QUIT
