Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DG53588P

DG53588P.m

Go to the documentation of this file.
  1. DG53588P ;BAY/JAT; Post-init; ; 4/9/04 11:12am
  1. ;;5.3;Registration;**588,1015**;Aug 13, 1993;Build 21
  1. ENV ;Environment check point
  1. S XPDABORT=""
  1. D PROGCHK(.XPDABORT)
  1. I XPDABORT="" K XPDABORT
  1. Q
  1. ;
  1. PROGCHK(XPDABORT) ;checks for necessary programmer variables
  1. I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") D
  1. . D BMES^XPDUTL("*****")
  1. . D MES^XPDUTL("Your programming variables are not set up properly.")
  1. . D MES^XPDUTL("Installation aborted.")
  1. . D MES^XPDUTL("*****")
  1. . S XPDABORT=2
  1. Q
  1. ;
  1. POST ;
  1. N DGIEN,DGSUB,DGNODE,DGPTR,DGDOMAIN,DIE,DA,DR,DGFOUND,DGNAME
  1. S (DGIEN,DGFOUND)=0
  1. F S DGIEN=$O(^VAT(407.7,DGIEN)) Q:'DGIEN D
  1. .S DGSUB=0
  1. .F S DGSUB=$O(^VAT(407.7,DGIEN,"R",DGSUB)) Q:'DGSUB D
  1. ..S DGNODE=$G(^VAT(407.7,DGIEN,"R",DGSUB,0))
  1. ..Q:DGNODE=""
  1. ..S DGPTR=$P(DGNODE,U,2)
  1. ..Q:'DGPTR
  1. ..S DGDOMAIN=$$GET1^DIQ(4.2,DGPTR_",",.01)
  1. ..Q:DGDOMAIN'="IPDB-CHICAGO.VA.GOV"
  1. ..S DGFOUND=1
  1. ..S DA(1)=DGIEN
  1. ..S DA=DGSUB
  1. ..S DR="2///0"
  1. ..S DIE="^VAT(407.7,"_DA(1)_",""R"","
  1. ..D ^DIE
  1. ..S DGNAME=$P($G(^VAT(407.7,DGIEN,0)),U)
  1. ..D MES^XPDUTL(DGNAME_" Record updated.")
  1. I 'DGFOUND D MES^XPDUTL("No record found. Contact Vista Support.")
  1. Q