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