DG53588P ;BAY/JAT; Post-init; ; 4/9/04 11:12am
;;5.3;Registration;**588**;Aug 13, 1993
ENV ;Environment check point
S XPDABORT=""
D PROGCHK(.XPDABORT)
I XPDABORT="" K XPDABORT
Q
;
PROGCHK(XPDABORT) ;checks for necessary programmer variables
I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") D
. 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 ;
N DGIEN,DGSUB,DGNODE,DGPTR,DGDOMAIN,DIE,DA,DR,DGFOUND,DGNAME
S (DGIEN,DGFOUND)=0
F S DGIEN=$O(^VAT(407.7,DGIEN)) Q:'DGIEN D
.S DGSUB=0
.F S DGSUB=$O(^VAT(407.7,DGIEN,"R",DGSUB)) Q:'DGSUB D
..S DGNODE=$G(^VAT(407.7,DGIEN,"R",DGSUB,0))
..Q:DGNODE=""
..S DGPTR=$P(DGNODE,U,2)
..Q:'DGPTR
..S DGDOMAIN=$$GET1^DIQ(4.2,DGPTR_",",.01)
..Q:DGDOMAIN'="IPDB-CHICAGO.DOMAIN.EXT"
..S DGFOUND=1
..S DA(1)=DGIEN
..S DA=DGSUB
..S DR="2///0"
..S DIE="^VAT(407.7,"_DA(1)_",""R"","
..D ^DIE
..S DGNAME=$P($G(^VAT(407.7,DGIEN,0)),U)
..D MES^XPDUTL(DGNAME_" Record updated.")
I 'DGFOUND D MES^XPDUTL("No record found. Contact Vista Support.")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53588P 1183 printed Nov 22, 2024@17:47:52 Page 2
DG53588P ;BAY/JAT; Post-init; ; 4/9/04 11:12am
+1 ;;5.3;Registration;**588**;Aug 13, 1993
ENV ;Environment check point
+1 SET XPDABORT=""
+2 DO PROGCHK(.XPDABORT)
+3 IF XPDABORT=""
KILL XPDABORT
+4 QUIT
+5 ;
PROGCHK(XPDABORT) ;checks for necessary programmer variables
+1 IF '$GET(DUZ)!($GET(DUZ(0))'="@")!('$GET(DT))!($GET(U)'="^")
Begin DoDot:1
+2 DO BMES^XPDUTL("*****")
+3 DO MES^XPDUTL("Your programming variables are not set up properly.")
+4 DO MES^XPDUTL("Installation aborted.")
+5 DO MES^XPDUTL("*****")
+6 SET XPDABORT=2
End DoDot:1
+7 QUIT
+8 ;
POST ;
+1 NEW DGIEN,DGSUB,DGNODE,DGPTR,DGDOMAIN,DIE,DA,DR,DGFOUND,DGNAME
+2 SET (DGIEN,DGFOUND)=0
+3 FOR
SET DGIEN=$ORDER(^VAT(407.7,DGIEN))
if 'DGIEN
QUIT
Begin DoDot:1
+4 SET DGSUB=0
+5 FOR
SET DGSUB=$ORDER(^VAT(407.7,DGIEN,"R",DGSUB))
if 'DGSUB
QUIT
Begin DoDot:2
+6 SET DGNODE=$GET(^VAT(407.7,DGIEN,"R",DGSUB,0))
+7 if DGNODE=""
QUIT
+8 SET DGPTR=$PIECE(DGNODE,U,2)
+9 if 'DGPTR
QUIT
+10 SET DGDOMAIN=$$GET1^DIQ(4.2,DGPTR_",",.01)
+11 if DGDOMAIN'="IPDB-CHICAGO.DOMAIN.EXT"
QUIT
+12 SET DGFOUND=1
+13 SET DA(1)=DGIEN
+14 SET DA=DGSUB
+15 SET DR="2///0"
+16 SET DIE="^VAT(407.7,"_DA(1)_",""R"","
+17 DO ^DIE
+18 SET DGNAME=$PIECE($GET(^VAT(407.7,DGIEN,0)),U)
+19 DO MES^XPDUTL(DGNAME_" Record updated.")
End DoDot:2
End DoDot:1
+20 IF 'DGFOUND
DO MES^XPDUTL("No record found. Contact Vista Support.")
+21 QUIT
