DG53678P ;ALB/MRY - Pre/Post-Install ; 9/26/05 3:33pm
;;5.3;Registration;**678**;Aug 13, 1993
;
;
ENV ;Main entry point for Environment check point.
;
S XPDABORT=""
D PROGCHK(.XPDABORT) ;checks programmer variables
I XPDABORT="" K XPDABORT
Q
;
;
PRE ;Main entry point for Pre-init items.
;
Q
;
;
PROGCHK(XPDABORT) ;checks for necessary programmer variables
;
I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") DO
.D BMES^XPDUTL("*****")
.D MES^XPDUTL("Your programming variables are not set up properly.")
.D MES^XPDUTL("Installation aborted.")
.D MES^XPDUTL("*****")
.S XPDABORT=2
Q
;
POST ;
;Add new code into PTF AUSTIN ERROR CODES (#45.64) file
N LINE,X,DGCODE,DIC,DGDESC,DGPOS,Y,DGX,DGY,DGCNT
S DGCNT=0
D BMES^XPDUTL(">>> Adding new code 125 to file # 45.64")
F LINE=1:1 S X=$T(ADD+LINE) S DGCODE=$P(X,";;",2) Q:DGCODE="EXIT" D
.S DIC="^DGP(45.64,",DIC(0)=""
.S DGDESC=$P(DGCODE,U,2)
.S DGPOS=$P(DGCODE,U,3)
.I $L(DGDESC)>70 Q
.S DIC("DR")=".02///"_DGDESC_";.03///"_DGPOS
.S X=$P(DGCODE,U)
.I +$O(^DGP(45.64,"B",X,0)) S DGCNT=1 Q
.K DO D FILE^DICN
.I Y=-1 Q
.S DGX=$P(DGCODE,U),DGY=$P(DGCODE,U,2)
.D MES^XPDUTL(" CODE "_DGX_" "_DGY_" added.")
.S DGCNT=DGCNT+1
I DGCNT<1 D
.D MES^XPDUTL("Code(s) missing. Compare with patch description.")
;
D POST^DG53678A
Q
;
ADD ;new code - descriptions cannot exceed 70 char.
;;125^Invalid Emergency Response Indicator.^24
;;EXIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53678P 1484 printed Nov 22, 2024@17:48:19 Page 2
DG53678P ;ALB/MRY - Pre/Post-Install ; 9/26/05 3:33pm
+1 ;;5.3;Registration;**678**;Aug 13, 1993
+2 ;
+3 ;
ENV ;Main entry point for Environment check point.
+1 ;
+2 SET XPDABORT=""
+3 ;checks programmer variables
DO PROGCHK(.XPDABORT)
+4 IF XPDABORT=""
KILL XPDABORT
+5 QUIT
+6 ;
+7 ;
PRE ;Main entry point for Pre-init items.
+1 ;
+2 QUIT
+3 ;
+4 ;
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("*****")
+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 ;
POST ;
+1 ;Add new code into PTF AUSTIN ERROR CODES (#45.64) file
+2 NEW LINE,X,DGCODE,DIC,DGDESC,DGPOS,Y,DGX,DGY,DGCNT
+3 SET DGCNT=0
+4 DO BMES^XPDUTL(">>> Adding new code 125 to file # 45.64")
+5 FOR LINE=1:1
SET X=$TEXT(ADD+LINE)
SET DGCODE=$PIECE(X,";;",2)
if DGCODE="EXIT"
QUIT
Begin DoDot:1
+6 SET DIC="^DGP(45.64,"
SET DIC(0)=""
+7 SET DGDESC=$PIECE(DGCODE,U,2)
+8 SET DGPOS=$PIECE(DGCODE,U,3)
+9 IF $LENGTH(DGDESC)>70
QUIT
+10 SET DIC("DR")=".02///"_DGDESC_";.03///"_DGPOS
+11 SET X=$PIECE(DGCODE,U)
+12 IF +$ORDER(^DGP(45.64,"B",X,0))
SET DGCNT=1
QUIT
+13 KILL DO
DO FILE^DICN
+14 IF Y=-1
QUIT
+15 SET DGX=$PIECE(DGCODE,U)
SET DGY=$PIECE(DGCODE,U,2)
+16 DO MES^XPDUTL(" CODE "_DGX_" "_DGY_" added.")
+17 SET DGCNT=DGCNT+1
End DoDot:1
+18 IF DGCNT<1
Begin DoDot:1
+19 DO MES^XPDUTL("Code(s) missing. Compare with patch description.")
End DoDot:1
+20 ;
+21 DO POST^DG53678A
+22 QUIT
+23 ;
ADD ;new code - descriptions cannot exceed 70 char.
+1 ;;125^Invalid Emergency Response Indicator.^24
+2 ;;EXIT
