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

DG53P425.m

Go to the documentation of this file. 
  1. DG53P425 ;ALB/RPM - PATCH DG*5.3*425 INSTALL UTILITIES ; 8/21/03 4:52pm
  1.  ;;5.3;Registration;**425,1015**;Aug 13, 1993;Build 21
  1.  ;
  1. ENV ;Main entry point for Environment check point.
  1.  ;
  1.  S XPDABORT=""
  1.  D PROGCHK(.XPDABORT) ;checks programmer variables
  1.  I XPDABORT="" K XPDABORT
  1.  Q
  1.  ;
  1.  ;
  1. PRE ;Main entry point for Pre-init items.
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. POST ;Main entry point for Post-init items.
  1.  ;
  1.  N DGACTDT  ;software activation date
  1.  ;
  1.  S DGACTDT="Sep 25, 2003"  ;National PRF Software Activation date
  1.  ;
  1.  D POST1(DGACTDT)          ;create/update PRF PARAMETERS (#26.18) file
  1.  D POST2                   ;load BEHAVIORAL Category I PRF
  1.  Q
  1.  ;
  1.  ;
  1. PROGCHK(XPDABORT) ;checks for necessary programmer variables
  1.  ;
  1.  I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") DO
  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. POST1(DGACTDT) ;create PRF PARAMETERS (#26.18) file entry at IEN "1"
  1.  ;
  1.  ;  Input:
  1.  ;    DGACTDT - (optional) software activation date in external format
  1.  ;                         [default="May 01, 2003"  ;used at test sites]
  1.  ;
  1.  ;  Output:
  1.  ;    none
  1.  ;
  1.  N DGACT  ;type of file activity (add/update)
  1.  N DGFDA  ;FDA array
  1.  N DGFLD  ;field #
  1.  N DGERR  ;error array
  1.  N DGIEN  ;IEN array
  1.  N DGIENS
  1.  N DGPARM  ;parameter record
  1.  ;
  1.  I $G(DGACTDT)="" S DGACTDT="May 01, 2003"  ;date for test sites
  1.  ;
  1.  ;existing file entry
  1.  I $D(^DGPF(26.18,1,0))#2 D
  1.  . N DGERR
  1.  . S DGIENS="1,"
  1.  . S DGACT="update"
  1.  E  D
  1.  . S DGIENS="+1,"
  1.  . S DGACT="add"
  1.  ;
  1.  ;retrieve existing record
  1.  S DGPARM=$G(^DGPF(26.18,1,0))
  1.  ;
  1.  ;provide values for any missing parameters
  1.  I $P(DGPARM,U,1)="" S DGFDA(26.18,DGIENS,.01)=1
  1.  I $P(DGPARM,U,2)="" S DGFDA(26.18,DGIENS,1)=DGACTDT   ;activation date
  1.  I $P(DGPARM,U,3)="" S DGFDA(26.18,DGIENS,2)="ACTIVE"  ;ORU HL7 interface
  1.  I $P(DGPARM,U,4)="" S DGFDA(26.18,DGIENS,3)="DIRECT"  ;QRY HL7 interface
  1.  I $P(DGPARM,U,6)="" S DGFDA(26.18,DGIENS,5)=7  ;HL7 Auto Retrans Days
  1.  ;
  1.  ;short-circuit when there are no missing parameters
  1.  I '$D(DGFDA) D  Q
  1.  . D BMES^XPDUTL("*****")
  1.  . D MES^XPDUTL("  PRF PARAMETERS (#26.18) file values previously defined...no action taken.")
  1.  . D MES^XPDUTL("*****")
  1.  Q:'$D(DGFDA)
  1.  D UPDATE^DIE("ES","DGFDA","DGIEN","DGERR")
  1.  ;
  1.  ;check for errors and inform the installer of update status
  1.  I '$D(DGERR) D
  1.  . D BMES^XPDUTL("*****")
  1.  . D MES^XPDUTL("The '1' entry in the PRF PARAMETERS (#26.18) file was "_DGACT_$S(DGACT="add":"ed",1:"d")_" successfully.")
  1.  . ;
  1.  . ;display updated field list and values
  1.  . I DGACT="update" D
  1.  . . S DGFLD=0
  1.  . . F  S DGFLD=$O(DGFDA(26.18,DGIENS,DGFLD)) Q:'DGFLD  D
  1.  . . . D MES^XPDUTL("The "_$$GET1^DID(26.18,DGFLD,"","LABEL")_" (#"_DGFLD_") field was set to '"_DGFDA(26.18,DGIENS,DGFLD)_"'.")
  1.  . D MES^XPDUTL("*****")
  1.  E  D
  1.  . D BMES^XPDUTL("*****")
  1.  . D MES^XPDUTL("The attempt to "_DGACT_" the '1' entry in the PRF PARAMETERS (#26.18) file failed.")
  1.  . D MES^XPDUTL($G(DGERR("DIERR",1,"TEXT",1)))
  1.  . D MES^XPDUTL("*****")
  1.  ;
  1.  Q
  1.  ;
  1. POST2 ;create BEHAVIORAL Category I PRF
  1.  ;
  1.  ;short circuit if flag already exists
  1.  I $D(^DGPF(26.15,"B","BEHAVIORAL")) D  Q
  1.  . D BMES^XPDUTL("*****")
  1.  . D MES^XPDUTL("  'BEHAVIORAL' Category I flag previously defined...no action taken.")
  1.  . D MES^XPDUTL("*****")
  1.  ;
  1.  N DGDESC  ;description word-processing array
  1.  N DGFDA   ;FDA array
  1.  N DGIEN   ;IEN array
  1.  ;
  1.  ;flag description
  1.  S DGDESC(1,0)="The purpose of this National Patient Record Flag is to alert VHA medical"
  1.  S DGDESC(2,0)="staff and employees of patients whose behavior or characteristics may pose"
  1.  S DGDESC(3,0)="a threat either to their safety, the safety of other patients, or"
  1.  S DGDESC(4,0)="compromise the delivery of quality health care."
  1.  S DGDESC(5,0)="Application of National Patient Record Flags is coordinated through the"
  1.  S DGDESC(6,0)="Chief of Staff."
  1.  S DGDESC(7,0)="This is a nationally distributed flag."
  1.  ;
  1.  ;build FDA array
  1.  S DGFDA(26.15,"+1,",.01)="BEHAVIORAL"
  1.  S DGFDA(26.15,"+1,",.02)="ACTIVE"
  1.  S DGFDA(26.15,"+1,",.03)="BEHAVIORAL"
  1.  S DGFDA(26.15,"+1,",.04)=730
  1.  S DGFDA(26.15,"+1,",.05)=60
  1.  S DGFDA(26.15,"+1,",.06)="DGPF BEHAVIORAL FLAG REVIEW"
  1.  S DGFDA(26.15,"+1,",1)="DGDESC"
  1.  ;
  1.  ;ask for IEN = 1
  1.  S DGIEN(1)=1
  1.  ;
  1.  ;store record
  1.  D UPDATE^DIE("E","DGFDA","DGIEN","DGERR")
  1.  ;
  1.  ;check for errors and inform the installer of update status
  1.  D BMES^XPDUTL("*****")
  1.  I $D(^DGPF(26.15,"B","BEHAVIORAL")),'$D(DGERR) D
  1.  . D MES^XPDUTL("  'BEHAVIORAL' Category I Patient Record Flag created successfully.")
  1.  E  D
  1.  . D MES^XPDUTL("  'BEHAVIORAL' Category I Patient Record Flag creation failed!")
  1.  D MES^XPDUTL("*****")
  1.  Q