DVBA179P ;ALB/EF - Post init for DVBA*2.7*179 ; 1/15/2012
;;2.7;AMIE;**179**;Apr 10, 1995;Build 15
;
; The POST1 section of this routine adds menu items to two of the
; HRC menus distributed in DVBA*2.7*149.
; The PSO HRC PROFILE/REFILL menu item is included in patch PSO*7*382
; See ICR #4595
;
; The POST2 section of this routine collects the last 90 days of records
; in the 2507 REQUEST (#396.3) file and populates the new
; DATE STATUS LAST CHANGED (#7) field.
;
POST ;
;
D POST1 ;add HRC menu
D POST2 ;populate DATE STATUS LAST CHANGED (#7) field in 2507 REQUEST (#396.3) file.
Q
;
POST1 ;
;
;See ADDMNU for documentation on input parameters.
;Last parameter is the Display Order. Must be a number from 1 - 99.
;
;Pharmacy menu
;
D BMES^XPDUTL("-> Adding PSO HRC PROFILE/REFILL option to HRC Pharmacy Customer Care Menu <-")
D ADDMNU("DVBA HRC MENU PHARMACY CC","PSO HRC PROFILE/REFILL","PPR",30)
;
D BMES^XPDUTL("-> Adding PSO HRC PROFILE/REFILL option to HRC Pharmacy Menu <-")
D ADDMNU("DVBA HRC MENU PHARMACY","PSO HRC PROFILE/REFILL","PPR",30)
;
Q
ADDMNU(DVB1,DVB2,DVB3,DVB4) ;
;
;Adds Items to Menu (#19.01) subfile in Option (#19) file
;Input:
; DVB1 = Name of the menu(Required)
; DVB2 = Item (#.01)- Name of Option being added to the menu. (Required)
; DVB3 = Synonym (#2) field (optional)
; DVB4 = Display Order (#3) field (optional) (Number from 1 - 99)
;
;Output: 1 = Success - Option added to menu.
; 0 = Failure - Option not added to menu.
;
N DVOK
S DVOK=$$ADD^XPDMENU(DVB1,DVB2,DVB3,DVB4)
I 'DVOK D Q
.D MES^XPDUTL(" Could not add "_DVB2_" to "_DVB1)
D MES^XPDUTL(" "_DVB2_" added to "_DVB1)
Q
;
POST2 ;Set up TaskMan to populate new Date field in the background
N ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK
S ZTRTN="SETFLD7^DVBA179P"
S ZTDESC="Populate DATE STATUS LAST CHANGED for DVBA*2.7*179"
;Queue Task to start in 60 seconds
S ZTDTH=$$SCH^XLFDT("60S",$$NOW^XLFDT)
S ZTIO=""
D ^%ZTLOAD
D BMES^XPDUTL("*****")
D
. I $D(ZTSK)[0 D Q
. .D MES^XPDUTL("TaskMan run to populate new Date field for DVBA*2.7*179 was not started.")
. .D MES^XPDUTL("Re-run Post Install routine POST2^DVBA179P.")
. D MES^XPDUTL("Task "_ZTSK_" started to populate new Date field.")
. I $D(ZTSK("D")) D
. . D MES^XPDUTL("Task will start at "_$$HTE^XLFDT(ZTSK("D")))
D MES^XPDUTL("*****")
Q
;
SETFLD7 ;
; Retrieve 2507 REQUEST (#396.3) record date fields for the last 90 days,
; determine most recent activity date and populate the DATE STATUS LAST
; CHANGED (#7) field.
;
N DVBCNT ;updated record count
N DVBDAT ;2507 REQUEST DATE
N DVBIEN ;2507 REQUEST IEN
N DVBLST ;last activity date
N DVBMSG ;notification text
N DVBQUIT ;stop task
N DVBSTART ;start time
;
S DVBSTART=$$NOW^XLFDT()
S DVBCNT=0
S DVBQUIT=0
S DVBDAT=$$FMADD^XLFDT($$DT^XLFDT(),-91)
F S DVBDAT=$O(^DVB(396.3,"C",DVBDAT)) Q:'DVBDAT!(DVBQUIT) D
. S DVBIEN=0
. S DVBIEN=$O(^DVB(396.3,"C",DVBDAT,DVBIEN)) Q:'DVBIEN D
. . S DVBLST=$$GETLAST(DVBIEN)
. . I DVBLST,$$SETLAST(DVBIEN,DVBLST) S DVBCNT=DVBCNT+1
. . ;
. I $$S^%ZTLOAD D Q ;check for task stop request
. . S DVBMSG=2
. . S DVBMSG(1)="Patch DVBA*2.7*179 Field Population Task Stopped by User"
. . S DVBMSG(2)="Re-run Post Install routine POST2^DVBA179P."
. . S (ZTSTOP,DVBQUIT)=1
;
D NOTIFY(DVBSTART,DVBCNT,.DVBMSG)
Q
;
GETLAST(DVBIEN) ;get last activity date
; This function returns the most recent activity date on success.
;
; Fields Name
; 1 Request Date
; 4 Date Reported to MAS
; 6 Date Completed
; 13 Date Released
; 15 Date Printed by RO
; 19 Cancellation Date
;
; Input:
; DVBIEN - 2507 REQUEST file IEN
;
; Output:
; Funtion result - most recent activity date in FM format on success;
; otherwise, returns "0"
;
N DVBDATS ;FM DIQ results array
N DVBERR ;FM error msg
N DVBFLD ;request field#
N DVBIENS ;request record IENS
N DVBLST ;last activity date - function result
N DVBSRT ;activity dates sorted array
;
S DVBLST=0
S DVBIENS=DVBIEN_","
D GETS^DIQ(396.3,DVBIENS,"1;4;6;13;15;19","I","DVBDATS","DVBERR")
I '$D(DVBERR) D
. S DVBFLD=0
. F S DVBFLD=$O(DVBDATS(396.3,DVBIENS,DVBFLD)) Q:'DVBFLD D
. . S DVBSRT(+$G(DVBDATS(396.3,DVBIENS,DVBFLD,"I")))=""
. S DVBLST=$P(+$O(DVBSRT(""),-1),".",1)
Q DVBLST
;
SETLAST(DVBIEN,DVBLAST) ;file the date in the new field
; File the last activity date in the DATE STATUS LAST CHANGED (#7) field
;
; Input:
; DVBIEN - 2507 REQUEST IEN
; DVBLAST - last activity date in FM format
;
; Output:
; Function result - returns 1 on success; otherwise returns 0
;
N DVBERR ;FM error msg
N DVBFDA ;FDA array
S DVBFDA(396.3,DVBIEN_",",7)=DVBLAST
D FILE^DIE("","DVBFDA","DVBERR")
Q $S($D(DVBERR):0,1:1)
;
NOTIFY(DVBSTIME,DVBTOT,DVBMESS) ;send job msg
;
; Input
; DVBSTIME - job start date/time
; DVBTOT - count of records updated
; DVBMESS - free text message array for task stop or errors passed
; by reference
;
; Output
; none
;
N DIFROM,XMDUZ,XMSUB,XMTEXT,XMY,XMZ
N DVBSITE,DVBETIME,DVBTEXT,DVBI
S DVBSITE=$$SITE^VASITE
S DVBETIME=$$NOW^XLFDT
S XMDUZ="Populate DATE STATUS LAST CHANGED"
S XMSUB="Patch DVBA*2.7*179"
S XMTEXT="DVBTEXT("
S XMY(DUZ)=""
S DVBTEXT(1)=""
S DVBTEXT(2)=" Facility Name: "_$P(DVBSITE,U,2)
S DVBTEXT(3)=" Station Number: "_$P(DVBSITE,U,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)=""
I $G(DVBMESS) D
. F DVBI=1:1:DVBMESS D
. . S DVBTEXT(7+DVBI)="*** "_$E($G(DVBMESS(DVBI)),1,65)
I '$G(DVBMESS) D
. S DVBTEXT(8)="DATE STATUS LAST CHANGED (#7) Field Popluation Complete"
. S DVBTEXT(9)="Total 2507 REQUEST (#396.3) Records Updated: "_DVBTOT
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBA179P 6113 printed Dec 13, 2024@01:39:21 Page 2
DVBA179P ;ALB/EF - Post init for DVBA*2.7*179 ; 1/15/2012
+1 ;;2.7;AMIE;**179**;Apr 10, 1995;Build 15
+2 ;
+3 ; The POST1 section of this routine adds menu items to two of the
+4 ; HRC menus distributed in DVBA*2.7*149.
+5 ; The PSO HRC PROFILE/REFILL menu item is included in patch PSO*7*382
+6 ; See ICR #4595
+7 ;
+8 ; The POST2 section of this routine collects the last 90 days of records
+9 ; in the 2507 REQUEST (#396.3) file and populates the new
+10 ; DATE STATUS LAST CHANGED (#7) field.
+11 ;
POST ;
+1 ;
+2 ;add HRC menu
DO POST1
+3 ;populate DATE STATUS LAST CHANGED (#7) field in 2507 REQUEST (#396.3) file.
DO POST2
+4 QUIT
+5 ;
POST1 ;
+1 ;
+2 ;See ADDMNU for documentation on input parameters.
+3 ;Last parameter is the Display Order. Must be a number from 1 - 99.
+4 ;
+5 ;Pharmacy menu
+6 ;
+7 DO BMES^XPDUTL("-> Adding PSO HRC PROFILE/REFILL option to HRC Pharmacy Customer Care Menu <-")
+8 DO ADDMNU("DVBA HRC MENU PHARMACY CC","PSO HRC PROFILE/REFILL","PPR",30)
+9 ;
+10 DO BMES^XPDUTL("-> Adding PSO HRC PROFILE/REFILL option to HRC Pharmacy Menu <-")
+11 DO ADDMNU("DVBA HRC MENU PHARMACY","PSO HRC PROFILE/REFILL","PPR",30)
+12 ;
+13 QUIT
ADDMNU(DVB1,DVB2,DVB3,DVB4) ;
+1 ;
+2 ;Adds Items to Menu (#19.01) subfile in Option (#19) file
+3 ;Input:
+4 ; DVB1 = Name of the menu(Required)
+5 ; DVB2 = Item (#.01)- Name of Option being added to the menu. (Required)
+6 ; DVB3 = Synonym (#2) field (optional)
+7 ; DVB4 = Display Order (#3) field (optional) (Number from 1 - 99)
+8 ;
+9 ;Output: 1 = Success - Option added to menu.
+10 ; 0 = Failure - Option not added to menu.
+11 ;
+12 NEW DVOK
+13 SET DVOK=$$ADD^XPDMENU(DVB1,DVB2,DVB3,DVB4)
+14 IF 'DVOK
Begin DoDot:1
+15 DO MES^XPDUTL(" Could not add "_DVB2_" to "_DVB1)
End DoDot:1
QUIT
+16 DO MES^XPDUTL(" "_DVB2_" added to "_DVB1)
+17 QUIT
+18 ;
POST2 ;Set up TaskMan to populate new Date field in the background
+1 NEW ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK
+2 SET ZTRTN="SETFLD7^DVBA179P"
+3 SET ZTDESC="Populate DATE STATUS LAST CHANGED for DVBA*2.7*179"
+4 ;Queue Task to start in 60 seconds
+5 SET ZTDTH=$$SCH^XLFDT("60S",$$NOW^XLFDT)
+6 SET ZTIO=""
+7 DO ^%ZTLOAD
+8 DO BMES^XPDUTL("*****")
+9 Begin DoDot:1
+10 IF $DATA(ZTSK)[0
Begin DoDot:2
+11 DO MES^XPDUTL("TaskMan run to populate new Date field for DVBA*2.7*179 was not started.")
+12 DO MES^XPDUTL("Re-run Post Install routine POST2^DVBA179P.")
End DoDot:2
QUIT
+13 DO MES^XPDUTL("Task "_ZTSK_" started to populate new Date field.")
+14 IF $DATA(ZTSK("D"))
Begin DoDot:2
+15 DO MES^XPDUTL("Task will start at "_$$HTE^XLFDT(ZTSK("D")))
End DoDot:2
End DoDot:1
+16 DO MES^XPDUTL("*****")
+17 QUIT
+18 ;
SETFLD7 ;
+1 ; Retrieve 2507 REQUEST (#396.3) record date fields for the last 90 days,
+2 ; determine most recent activity date and populate the DATE STATUS LAST
+3 ; CHANGED (#7) field.
+4 ;
+5 ;updated record count
NEW DVBCNT
+6 ;2507 REQUEST DATE
NEW DVBDAT
+7 ;2507 REQUEST IEN
NEW DVBIEN
+8 ;last activity date
NEW DVBLST
+9 ;notification text
NEW DVBMSG
+10 ;stop task
NEW DVBQUIT
+11 ;start time
NEW DVBSTART
+12 ;
+13 SET DVBSTART=$$NOW^XLFDT()
+14 SET DVBCNT=0
+15 SET DVBQUIT=0
+16 SET DVBDAT=$$FMADD^XLFDT($$DT^XLFDT(),-91)
+17 FOR
SET DVBDAT=$ORDER(^DVB(396.3,"C",DVBDAT))
if 'DVBDAT!(DVBQUIT)
QUIT
Begin DoDot:1
+18 SET DVBIEN=0
+19 SET DVBIEN=$ORDER(^DVB(396.3,"C",DVBDAT,DVBIEN))
if 'DVBIEN
QUIT
Begin DoDot:2
+20 SET DVBLST=$$GETLAST(DVBIEN)
+21 IF DVBLST
IF $$SETLAST(DVBIEN,DVBLST)
SET DVBCNT=DVBCNT+1
+22 ;
End DoDot:2
+23 ;check for task stop request
IF $$S^%ZTLOAD
Begin DoDot:2
+24 SET DVBMSG=2
+25 SET DVBMSG(1)="Patch DVBA*2.7*179 Field Population Task Stopped by User"
+26 SET DVBMSG(2)="Re-run Post Install routine POST2^DVBA179P."
+27 SET (ZTSTOP,DVBQUIT)=1
End DoDot:2
QUIT
End DoDot:1
+28 ;
+29 DO NOTIFY(DVBSTART,DVBCNT,.DVBMSG)
+30 QUIT
+31 ;
GETLAST(DVBIEN) ;get last activity date
+1 ; This function returns the most recent activity date on success.
+2 ;
+3 ; Fields Name
+4 ; 1 Request Date
+5 ; 4 Date Reported to MAS
+6 ; 6 Date Completed
+7 ; 13 Date Released
+8 ; 15 Date Printed by RO
+9 ; 19 Cancellation Date
+10 ;
+11 ; Input:
+12 ; DVBIEN - 2507 REQUEST file IEN
+13 ;
+14 ; Output:
+15 ; Funtion result - most recent activity date in FM format on success;
+16 ; otherwise, returns "0"
+17 ;
+18 ;FM DIQ results array
NEW DVBDATS
+19 ;FM error msg
NEW DVBERR
+20 ;request field#
NEW DVBFLD
+21 ;request record IENS
NEW DVBIENS
+22 ;last activity date - function result
NEW DVBLST
+23 ;activity dates sorted array
NEW DVBSRT
+24 ;
+25 SET DVBLST=0
+26 SET DVBIENS=DVBIEN_","
+27 DO GETS^DIQ(396.3,DVBIENS,"1;4;6;13;15;19","I","DVBDATS","DVBERR")
+28 IF '$DATA(DVBERR)
Begin DoDot:1
+29 SET DVBFLD=0
+30 FOR
SET DVBFLD=$ORDER(DVBDATS(396.3,DVBIENS,DVBFLD))
if 'DVBFLD
QUIT
Begin DoDot:2
+31 SET DVBSRT(+$GET(DVBDATS(396.3,DVBIENS,DVBFLD,"I")))=""
End DoDot:2
+32 SET DVBLST=$PIECE(+$ORDER(DVBSRT(""),-1),".",1)
End DoDot:1
+33 QUIT DVBLST
+34 ;
SETLAST(DVBIEN,DVBLAST) ;file the date in the new field
+1 ; File the last activity date in the DATE STATUS LAST CHANGED (#7) field
+2 ;
+3 ; Input:
+4 ; DVBIEN - 2507 REQUEST IEN
+5 ; DVBLAST - last activity date in FM format
+6 ;
+7 ; Output:
+8 ; Function result - returns 1 on success; otherwise returns 0
+9 ;
+10 ;FM error msg
NEW DVBERR
+11 ;FDA array
NEW DVBFDA
+12 SET DVBFDA(396.3,DVBIEN_",",7)=DVBLAST
+13 DO FILE^DIE("","DVBFDA","DVBERR")
+14 QUIT $SELECT($DATA(DVBERR):0,1:1)
+15 ;
NOTIFY(DVBSTIME,DVBTOT,DVBMESS) ;send job msg
+1 ;
+2 ; Input
+3 ; DVBSTIME - job start date/time
+4 ; DVBTOT - count of records updated
+5 ; DVBMESS - free text message array for task stop or errors passed
+6 ; by reference
+7 ;
+8 ; Output
+9 ; none
+10 ;
+11 NEW DIFROM,XMDUZ,XMSUB,XMTEXT,XMY,XMZ
+12 NEW DVBSITE,DVBETIME,DVBTEXT,DVBI
+13 SET DVBSITE=$$SITE^VASITE
+14 SET DVBETIME=$$NOW^XLFDT
+15 SET XMDUZ="Populate DATE STATUS LAST CHANGED"
+16 SET XMSUB="Patch DVBA*2.7*179"
+17 SET XMTEXT="DVBTEXT("
+18 SET XMY(DUZ)=""
+19 SET DVBTEXT(1)=""
+20 SET DVBTEXT(2)=" Facility Name: "_$PIECE(DVBSITE,U,2)
+21 SET DVBTEXT(3)=" Station Number: "_$PIECE(DVBSITE,U,3)
+22 SET DVBTEXT(4)=""
+23 SET DVBTEXT(5)=" Date/Time job started: "_$$FMTE^XLFDT(DVBSTIME)
+24 SET DVBTEXT(6)=" Date/Time job stopped: "_$$FMTE^XLFDT(DVBETIME)
+25 SET DVBTEXT(7)=""
+26 IF $GET(DVBMESS)
Begin DoDot:1
+27 FOR DVBI=1:1:DVBMESS
Begin DoDot:2
+28 SET DVBTEXT(7+DVBI)="*** "_$EXTRACT($GET(DVBMESS(DVBI)),1,65)
End DoDot:2
End DoDot:1
+29 IF '$GET(DVBMESS)
Begin DoDot:1
+30 SET DVBTEXT(8)="DATE STATUS LAST CHANGED (#7) Field Popluation Complete"
+31 SET DVBTEXT(9)="Total 2507 REQUEST (#396.3) Records Updated: "_DVBTOT
End DoDot:1
+32 DO ^XMD
+33 QUIT
