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

DVBA35P.m

Go to the documentation of this file. 
  1. DVBA35P ;ALB/PRH CAPRI CLEANUP POST-INS DVBA*2.7*35 ;03/02/01
  1.  ;;2.7;AMIE;**35**;Apr 10, 1995
  1.  ;
  1.  ; This routine contains pre & post subroutines for patch DVBA*2.7*35
  1.  ;
  1.  ; The post installation routine contains a cleanup routine
  1.  ; which will correct errors in the FORM 7131 file (#396).
  1.  ; These occurred initially when both the Division and Date were
  1.  ; stored in incorrect formats.
  1.  ; Division was stored as a name and should be converted to division
  1.  ; pointer number.
  1.  ; Date was stored as a text date and should be converted to
  1.  ; FileMan format.
  1.  ;
  1.  ; The fields in question (Both piece positions correspond) are;
  1.  ; Division - Node 6 - i.e. ^DVB(396,DA,6)
  1.  ; Date - Node 7 - i.e. ^DVB(396,DA,7)
  1.  ;
  1.  ; Div Field #  Date Field #    Position
  1.  ;    4.6           4.7             9
  1.  ;    5.6           5.7            11
  1.  ;    6.6           6.7            13
  1.  ;    7.6           7.7            15
  1.  ;    9.6           9.7            17
  1.  ;   11.6          11.7            19
  1.  ;   13.6          13.7            21
  1.  ;   15.6          15.7            23
  1.  ;   17.6          17.7             7
  1.  ;   18.6          18.7            26
  1.  ;   20.6          20.7            28
  1.  ;
  1.  ; In addition the post-install will also update the AMIE site
  1.  ; parameter (#396.1) file, field #.11 to extend the number
  1.  ; of days to keep the 2507 REQUEST file (#396.3) to 365 days
  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.  ;
  1.  Q
  1.  ;
  1. POST ;Main entry point for Post-init items
  1.  ;
  1.  D INIT
  1.  D POST1 ;Correct (#396) file entries
  1.  D POST2 ;Update (#396.1) file, field (#.11)
  1.  D POST3 ;Email totals
  1.  ;
  1.  Q
  1.  ;
  1. INIT ;Post-install Initialization
  1.  ;
  1.  ;The XTMP global will hold four variables
  1.  ;     Piece 1 = Date/Time run stared (FileMan format)
  1.  ;     Piece 2 = Number of Division entries modified - DVBCTR1
  1.  ;     Piece 3 = Number of date entries modified - DVBCTR2
  1.  ;     Piece 4 = History file updated? (0=No 1=Yes)
  1.  ;
  1.  K ^XTMP("DVBA35P")
  1.  S ^XTMP("DVBA35P",0)=$$NOW^XLFDT()_U_0_U_0_U_0
  1.  ;
  1.  Q
  1.  ;
  1. POST1 ;Correct (#396) file entries
  1.  ;
  1.  N DVBCTR1,DVBCTR2
  1.  ;
  1.  D BMES^XPDUTL("  >> starting Post-installation for DVBA*2.7*35")
  1.  ;
  1.  D LOOP
  1.  ;
  1.  I (DVBCTR1+DVBCTR2) D
  1.  . D BMES^XPDUTL("    "_DVBCTR1_" Division entries corrected in FORM 7131 file")
  1.  . D MES^XPDUTL("    "_DVBCTR2_" Date entries corrected in FORM 7131 file")
  1.  ;
  1.  S $P(^XTMP("DVBA35P",0),U,2,3)=DVBCTR1_U_DVBCTR2
  1.  ;
  1.  Q
  1.  ;
  1. POST2 ;Update (#396.1) file, field (#.11)
  1.  ;
  1.  ;Retain 2507 REQUEST (#396.3) file for 365 days
  1.  ;
  1.  N DA,DIE,DR,DVBARR,DVBERR
  1.  ;
  1.  ;First check how many days they retain at the moment
  1.  K DVBARR,DVBERR
  1.  D GETS^DIQ(396.1,1,.11,"I","DVBARR","DVBERR")
  1.  Q:$D(DVBERR)
  1.  I $G(DVBARR(396.1,"1,",.11,"I"))>364 D  Q  ;Already exceeds 364 days
  1.  . S $P(^XTMP("DVBA35P",0),U,4)=0 ;No change
  1.  ;
  1.  S DA=1,DIE="^DVB(396.1,",DR=".11///365"
  1.  D ^DIE
  1.  S $P(^XTMP("DVBA35P",0),U,4)=1 ;Updated
  1.  ;
  1.  D BMES^XPDUTL("  2507 REQUEST FILE (#396.3) History retention updated to 365 days")
  1.  D BMES^XPDUTL("  >> Post-installation completed")
  1.  ;
  1.  Q
  1.  ;
  1. POST3 ; send e-mail to user's
  1.  ;
  1.  ; if not in production account, do not send notification message (exit)
  1.  X ^%ZOSF("UCI") I Y'=^%ZOSF("PROD") Q
  1.  ;
  1.  N DIFROM,DVBCTR1,DVBCTR2,DVBSITE,DVBSTIME,DVBETIME,DVBSTR,DVBTEXT,DVBUPD,XMY,XMDUN,XMDUZ,XMSUB,XMTEXT,XMZ
  1.  S DVBSITE=$$SITE^VASITE
  1.  S DVBSTR=^XTMP("DVBA35P",0)
  1.  S DVBSTIME=$P(DVBSTR,U,1),DVBCTR1=$P(DVBSTR,U,2),DVBCTR2=$P(DVBSTR,U,3)
  1.  S DVBUPD=$P(DVBSTR,U,4)
  1.  S DVBETIME=$$NOW^XLFDT()      ;end date/time
  1.  S XMDUZ=.5,XMY(XMDUZ)="",XMY(DUZ)="",XMTEXT="DVBTEXT("
  1.  S XMY("G.PCMM TESTING@DOMAIN.EXT")=""  ;e-mail all sites totals to
  1.  S XMSUB="Patch DVBA*2.7*35 Post Install Routine ("_$P(DVBSITE,U,3)_")"
  1.  ;
  1.  S DVBTEXT(1)=""
  1.  S DVBTEXT(2)="          Facility Name:  "_$P(DVBSITE,"^",2)
  1.  S DVBTEXT(3)="         Station Number:  "_$P(DVBSITE,"^",3)
  1.  S DVBTEXT(4)=""
  1.  S DVBTEXT(5)="  Date/Time job started:  "_$$FMTE^XLFDT(DVBSTIME)
  1.  S DVBTEXT(6)="  Date/Time job stopped:  "_$$FMTE^XLFDT(DVBETIME)
  1.  S DVBTEXT(7)=""
  1.  S DVBTEXT(8)=$J(DVBCTR1,5)_" Division entries corrected in FORM 7131 file"
  1.  S DVBTEXT(9)=$J(DVBCTR2,5)_" Date entries corrected in FORM 7131 file"
  1.  S DVBTEXT(10)=""
  1.  I DVBUPD S DVBTEXT(11)="  2507 REQUEST FILE (#396.3) History retention updated to 365 days"
  1.  S DVBTEXT(12)=""
  1.  S DVBTEXT(13)="  >> Post-installation completed"
  1.  S DVBTEXT(14)=""
  1.  ;
  1.  D ^XMD
  1.  ;
  1.  K ^XTMP("DVBA35P")
  1.  ;
  1.  Q
  1.  ;
  1. LOOP ;Loop ^DVB(396 file to find incorrect entries and correct them
  1.  ;
  1.  N CNTR,DA,DAX,DIE,DR,DVB6F,DVB7F,DVBARR,DVBERR,DVBDIV,DVBDIVN,DVBDAT,FLD,X,Y
  1.  ;
  1.  S (DA,DVBCTR1,DVBCTR2)=0,DIE="^DVB(396,"
  1.  ;
  1.  ;DVB6F = Relevant Division Fields
  1.  S DVB6F="4.6;5.6;6.6;7.6;9.6;11.6;13.6;15.6;17.6;18.6;20.6"
  1.  ;
  1.  ;DVB7F = Relevant Date Fields
  1.  S DVB7F="4.7;5.7;6.7;7.7;9.7;11.7;13.7;15.7;17.7;18.7;20.7"
  1.  ;
  1.  F  S DA=$O(^DVB(396,DA)) Q:'DA!(DA'?1.N)  D
  1.  . S DAX=DA_","
  1.  . I $D(^DVB(396,DA,6)) D                   ;Division string exists
  1.  . . K DVBARR,DVBERR
  1.  . . D GETS^DIQ(396,DAX,DVB6F,"I","DVBARR","DVBERR")
  1.  . . Q:$D(DVBERR)                           ;Error found
  1.  . . F CNTR=1:1:$L(DVB6F,";") S FLD=$P(DVB6F,";",CNTR) D
  1.  . . . S DVBDIV=$G(DVBARR(396,DAX,FLD,"I"))
  1.  . . . Q:DVBDIV=""                          ;No entry made
  1.  . . . Q:$E(DVBDIV,1)?1N                    ;Division correct format
  1.  . . . S DVBDIVN=$O(^DG(40.8,"B",DVBDIV,""))
  1.  . . . S DR=FLD_"///"_DVBDIVN
  1.  . . . D ^DIE
  1.  . . . S DVBCTR1=DVBCTR1+1
  1.  . ;Now check the Date
  1.  . I $D(^DVB(396,DA,7)) D  ;Date string exists
  1.  . . K DVBARR,DVBERR
  1.  . . D GETS^DIQ(396,DAX,DVB7F,"I","DVBARR","DVBERR")
  1.  . . Q:$D(DVBERR)                           ;Error found
  1.  . . F CNTR=1:1:$L(DVB7F,";") S FLD=$P(DVB7F,";",CNTR) D
  1.  . . . S DVBDAT=$G(DVBARR(396,DAX,FLD,"I"))
  1.  . . . Q:DVBDAT=""                          ;No entry made
  1.  . . . Q:$E(DVBDAT,1)?1N                    ;Date correct format
  1.  . . . S X=DVBDAT D ^%DT
  1.  . . . Q:Y=-1
  1.  . . . S DR=FLD_"///"_Y
  1.  . . . D ^DIE
  1.  . . . S DVBCTR2=DVBCTR2+1
  1.  ;
  1.  Q
  1.  ;
  1. PROGCHK(XPDABORT) ;checks for necessary programmer variables
  1.  ;
  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.  ;
  1.  Q
  1.  ;
  1. PARMCHK(XPDABORT) ;checks for proper param file ien
  1.  ;
  1.  I '$D(^DVB(396.1,1)) D
  1.  . D BMES^XPDUTL("*****")
  1.  . D MES^XPDUTL("Parameter file (#396.1) does not have proper IEN (1).")
  1.  . D MES^XPDUTL("Installation aborted.")
  1.  . D MES^XPDUTL("*****")
  1.  . S XPDABORT=2
  1.  ;
  1.  Q