VDEFUTIL ;INTEGIC/AM & BPOIFO/JG - VDEF Utilities ;05/11/2012
;;1.0;VDEF;**3,10,11,12**;Dec 28, 2004;Build 2
;;Per VA Directive 6402, this routine should not be modified.
;
; IA: #10103 - $$HTE^XLFDT
;
Q ; No bozos
;
FUTURE(WAKEUP) ;
; Function that calculates $H date/time a WAKEUP number of
; seconds in the future
; Calculate the time WAKEUP number of seconds in the future as
; expressed in the number of seconds since 1840
N X S X=$H,X=$P(X,",",1)*86400+$P(X,",",2)+WAKEUP
; Convert the time from the number of seconds since 1840 to $H format
Q X\86400_","_(X#86400)
;
; Function to calculate the number of seconds between two dates
DIFF(FIRST,SECOND) ;
N X
; Convert the dates from Fileman to $H format if necessary
I FIRST?.E1".".E S X=FIRST D H^%DTC S FIRST=%H_","_%T
I SECOND?.E1".".E S X=SECOND D H^%DTC S SECOND=%H_","_%T
;
; Convert $H date/time values to the number of seconds since 1840
S FIRST=$P(FIRST,",",1)*86400+$P(FIRST,",",2)
S SECOND=$P(SECOND,",",1)*86400+$P(SECOND,",",2)
; Return the number of seconds between the two dates
Q SECOND-FIRST
;
ALERT(XQAMSG) ;
; Subroutine to send an Alert message to the VISTA HL7 IRM
; Input Parameters:
; XQAMSG - Text of the message to send to the Vista HL7 IRM
N ALERTS,XQA,X,Y,VDEFMSGX
S Y=$$HTE^XLFDT($H,2) S XQAMSG=Y_" "_XQAMSG,VDEFMSGX=XQAMSG
; Retrieve the Mailman Group to send VDEF alerts to.
; If site has no VDEF ALERTS Mail Group,
; send it to HL7 Mail Group.
S X=$P($$GETAPP^HLCS2("VDEF ALERTS"),U)
I X="" S X=$$GET1^DIQ(869.3,"1,",".05")
S XQA("G."_X)="",X=$$SETUP1^XQALERT
;
; Send a mail message to VDEF ALERT group on FORUM
N XMDUZ,XMY,XMSUB,XMTEXT,SITEPARM,VDEFMSG
S SITEPARM=$$PARAM^HLCS2,SITEPARM=$P(SITEPARM,U,5)_" ("_$P(SITEPARM,U,6)_")"
S XMY("G.VDEF NATIONAL ALERTS@DOMAIN.EXT")=""
;**VDEF P10 START CJM
;S XMY("GARDNER.JEFF@DOMAIN.EXT")=""
;**VDEF P10 END CJM
S XMDUZ="VDEF ALERT - "_SITEPARM,XMSUB="VDEF ALERT - "_SITEPARM,XMTEXT="VDEFMSG("
S VDEFMSG(1)="THIS IS AN ALERT GENERATED BY VDEF AT "_SITEPARM
S VDEFMSG(2)=" ",VDEFMSG(3)="ALERT TEXT:",VDEFMSG(4)=VDEFMSGX
D ^XMD
Q
;
TIMEI(T) ;
N TIME,CH,F,I,D,H,M,S,NUM,DONE
S TIME="",NUM="",DONE=0,F="DHMS",T=T_" "
F I=1:1:$L(T) S CH=$E(T,I) D Q:DONE
. I CH?1.N S NUM=NUM*10+$E(T,I) Q
. I CH=" ",NUM="" Q
. I CH=" " S CH=$E(F)
. I NUM="" S DONE=1 Q
. I CH="D" S D=NUM,NUM="",F=$P(F,CH,2) Q
. I CH="H" S H=NUM,NUM="",F=$P(F,CH,2) S:H>24 DONE=1 Q
. I CH="M" S M=NUM,NUM="",F=$P(F,CH,2) S:M>60 DONE=1 Q
. I CH="S" S S=NUM,NUM="",F=$P(F,CH,2) S:S>60 DONE=1 Q
. S DONE=1 W "*",CH,"*"
I DONE Q ""
;W !,$G(D),"D ",$G(H),"H ",$G(M),"M ",$G(S),"S",!
S TIME=TIME+($G(D)*86400)+($G(H)*3600)+($G(M)*60)+$G(S)
;VDEF*1*12 RRA ticket 1065808 restrict to 30 days directly in input transform
;minimum time is 30 days, mandated by customer
;I TIME<(30*24*60*60) Q ""
Q TIME
;
TIMEE(T) ;
N TIME S TIME=""
I T'<86400 S TIME=TIME_(T\86400)_"D ",T=T#86400
I T'<3600 S TIME=TIME_(T\3600)_"H ",T=T#3600
I T'<60 S TIME=TIME_(T\60)_"M ",T=T#60
I T>0 S TIME=TIME_T_"S "
S TIME=$E(TIME,1,$L(TIME)-1)
Q TIME
;
; Delete all entries in a given Request Queue
CLEANREQ(Q) ;
; For development and testing only.
; DO NOT USE IN PRODUCTION SYSTEMS.
I $$PROD^XUPROD(1) W:'$D(ZTQUEUED) !,"Can't be used in a production environment!" Q
N QUE S QUE=$P($G(^VDEFHL7(579.3,Q,0)),U)
I QUE="" W !,"Invalid queue" Q
K DIR S DIR(0)="Y",DIR("A")="Are you sure you want to continue",DIR("B")="No"
W !,"This action will delete all entries from Request Queue '"_QUE_"'."
D ^DIR I Y=0 W !,"Entries not deleted." Q
W !,"Deleting records ..."
N IEN S IEN=0 F S IEN=$O(^VDEFHL7(579.3,Q,1,IEN)) Q:'IEN D
. K FDA,MSG S FDA(579.31,IEN_","_Q_",",.01)="@" D FILE^DIE(,"FDA","MSG")
W !,"Entries deleted from "_QUE_" queue."
Q
;
PURGEQ ; Purge all Request Queues of their entries
; For development and testing only.
; DO NOT USE IN PRODUCTION SYSTEMS.
I $$PROD^XUPROD(1) W:'$D(ZTQUEUED) !,"Can't be used in a production environment!" Q
N QIEN S QIEN=0 F S QIEN=$O(^VDEFHL7(579.3,QIEN)) Q:'QIEN D CLEANREQ(QIEN)
Q
;
CLEANUP ; Delete records from VDEF files before installing the VDEF KIDS package
; For development and testing only.
; DO NOT USE IN PRODUCTION SYSTEMS.
I $$PROD^XUPROD(1) W:'$D(ZTQUEUED) !,"Can't be used in a production environment!" Q
K DIR S DIR(0)="Y",DIR("A")="Do you want to continue",DIR("B")="No"
W !,"This action will DELETE all data from VDEF globals in preparation for a KIDS install."
D ^DIR K DIR I Y=0 W !,"VDEF Globals not deleted." Q
W !,"Deleting records from VDEF globals ..."
N SUB S SUB="" F S SUB=$O(^VDEFHL7(SUB)) Q:SUB="" D
. S X=^VDEFHL7(SUB,0) K ^VDEFHL7(SUB) S ^VDEFHL7(SUB,0)=X
S SUB="" F S SUB=$O(^VDEFOUT(SUB)) Q:SUB="" D
. S X=^VDEFOUT(SUB,0) K ^VDEFOUT(SUB) S ^VDEFOUT(SUB,0)=X
W !,"VDEF Globals deleted."
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVDEFUTIL 4965 printed Oct 16, 2024@18:44:34 Page 2
VDEFUTIL ;INTEGIC/AM & BPOIFO/JG - VDEF Utilities ;05/11/2012
+1 ;;1.0;VDEF;**3,10,11,12**;Dec 28, 2004;Build 2
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; IA: #10103 - $$HTE^XLFDT
+5 ;
+6 ; No bozos
QUIT
+7 ;
FUTURE(WAKEUP) ;
+1 ; Function that calculates $H date/time a WAKEUP number of
+2 ; seconds in the future
+3 ; Calculate the time WAKEUP number of seconds in the future as
+4 ; expressed in the number of seconds since 1840
+5 NEW X
SET X=$HOROLOG
SET X=$PIECE(X,",",1)*86400+$PIECE(X,",",2)+WAKEUP
+6 ; Convert the time from the number of seconds since 1840 to $H format
+7 QUIT X\86400_","_(X#86400)
+8 ;
+9 ; Function to calculate the number of seconds between two dates
DIFF(FIRST,SECOND) ;
+1 NEW X
+2 ; Convert the dates from Fileman to $H format if necessary
+3 IF FIRST?.E1".".E
SET X=FIRST
DO H^%DTC
SET FIRST=%H_","_%T
+4 IF SECOND?.E1".".E
SET X=SECOND
DO H^%DTC
SET SECOND=%H_","_%T
+5 ;
+6 ; Convert $H date/time values to the number of seconds since 1840
+7 SET FIRST=$PIECE(FIRST,",",1)*86400+$PIECE(FIRST,",",2)
+8 SET SECOND=$PIECE(SECOND,",",1)*86400+$PIECE(SECOND,",",2)
+9 ; Return the number of seconds between the two dates
+10 QUIT SECOND-FIRST
+11 ;
ALERT(XQAMSG) ;
+1 ; Subroutine to send an Alert message to the VISTA HL7 IRM
+2 ; Input Parameters:
+3 ; XQAMSG - Text of the message to send to the Vista HL7 IRM
+4 NEW ALERTS,XQA,X,Y,VDEFMSGX
+5 SET Y=$$HTE^XLFDT($HOROLOG,2)
SET XQAMSG=Y_" "_XQAMSG
SET VDEFMSGX=XQAMSG
+6 ; Retrieve the Mailman Group to send VDEF alerts to.
+7 ; If site has no VDEF ALERTS Mail Group,
+8 ; send it to HL7 Mail Group.
+9 SET X=$PIECE($$GETAPP^HLCS2("VDEF ALERTS"),U)
+10 IF X=""
SET X=$$GET1^DIQ(869.3,"1,",".05")
+11 SET XQA("G."_X)=""
SET X=$$SETUP1^XQALERT
+12 ;
+13 ; Send a mail message to VDEF ALERT group on FORUM
+14 NEW XMDUZ,XMY,XMSUB,XMTEXT,SITEPARM,VDEFMSG
+15 SET SITEPARM=$$PARAM^HLCS2
SET SITEPARM=$PIECE(SITEPARM,U,5)_" ("_$PIECE(SITEPARM,U,6)_")"
+16 SET XMY("G.VDEF NATIONAL ALERTS@DOMAIN.EXT")=""
+17 ;**VDEF P10 START CJM
+18 ;S XMY("GARDNER.JEFF@DOMAIN.EXT")=""
+19 ;**VDEF P10 END CJM
+20 SET XMDUZ="VDEF ALERT - "_SITEPARM
SET XMSUB="VDEF ALERT - "_SITEPARM
SET XMTEXT="VDEFMSG("
+21 SET VDEFMSG(1)="THIS IS AN ALERT GENERATED BY VDEF AT "_SITEPARM
+22 SET VDEFMSG(2)=" "
SET VDEFMSG(3)="ALERT TEXT:"
SET VDEFMSG(4)=VDEFMSGX
+23 DO ^XMD
+24 QUIT
+25 ;
TIMEI(T) ;
+1 NEW TIME,CH,F,I,D,H,M,S,NUM,DONE
+2 SET TIME=""
SET NUM=""
SET DONE=0
SET F="DHMS"
SET T=T_" "
+3 FOR I=1:1:$LENGTH(T)
SET CH=$EXTRACT(T,I)
Begin DoDot:1
+4 IF CH?1.N
SET NUM=NUM*10+$EXTRACT(T,I)
QUIT
+5 IF CH=" "
IF NUM=""
QUIT
+6 IF CH=" "
SET CH=$EXTRACT(F)
+7 IF NUM=""
SET DONE=1
QUIT
+8 IF CH="D"
SET D=NUM
SET NUM=""
SET F=$PIECE(F,CH,2)
QUIT
+9 IF CH="H"
SET H=NUM
SET NUM=""
SET F=$PIECE(F,CH,2)
if H>24
SET DONE=1
QUIT
+10 IF CH="M"
SET M=NUM
SET NUM=""
SET F=$PIECE(F,CH,2)
if M>60
SET DONE=1
QUIT
+11 IF CH="S"
SET S=NUM
SET NUM=""
SET F=$PIECE(F,CH,2)
if S>60
SET DONE=1
QUIT
+12 SET DONE=1
WRITE "*",CH,"*"
End DoDot:1
if DONE
QUIT
+13 IF DONE
QUIT ""
+14 ;W !,$G(D),"D ",$G(H),"H ",$G(M),"M ",$G(S),"S",!
+15 SET TIME=TIME+($GET(D)*86400)+($GET(H)*3600)+($GET(M)*60)+$GET(S)
+16 ;VDEF*1*12 RRA ticket 1065808 restrict to 30 days directly in input transform
+17 ;minimum time is 30 days, mandated by customer
+18 ;I TIME<(30*24*60*60) Q ""
+19 QUIT TIME
+20 ;
TIMEE(T) ;
+1 NEW TIME
SET TIME=""
+2 IF T'<86400
SET TIME=TIME_(T\86400)_"D "
SET T=T#86400
+3 IF T'<3600
SET TIME=TIME_(T\3600)_"H "
SET T=T#3600
+4 IF T'<60
SET TIME=TIME_(T\60)_"M "
SET T=T#60
+5 IF T>0
SET TIME=TIME_T_"S "
+6 SET TIME=$EXTRACT(TIME,1,$LENGTH(TIME)-1)
+7 QUIT TIME
+8 ;
+9 ; Delete all entries in a given Request Queue
CLEANREQ(Q) ;
+1 ; For development and testing only.
+2 ; DO NOT USE IN PRODUCTION SYSTEMS.
+3 IF $$PROD^XUPROD(1)
if '$DATA(ZTQUEUED)
WRITE !,"Can't be used in a production environment!"
QUIT
+4 NEW QUE
SET QUE=$PIECE($GET(^VDEFHL7(579.3,Q,0)),U)
+5 IF QUE=""
WRITE !,"Invalid queue"
QUIT
+6 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Are you sure you want to continue"
SET DIR("B")="No"
+7 WRITE !,"This action will delete all entries from Request Queue '"_QUE_"'."
+8 DO ^DIR
IF Y=0
WRITE !,"Entries not deleted."
QUIT
+9 WRITE !,"Deleting records ..."
+10 NEW IEN
SET IEN=0
FOR
SET IEN=$ORDER(^VDEFHL7(579.3,Q,1,IEN))
if 'IEN
QUIT
Begin DoDot:1
+11 KILL FDA,MSG
SET FDA(579.31,IEN_","_Q_",",.01)="@"
DO FILE^DIE(,"FDA","MSG")
End DoDot:1
+12 WRITE !,"Entries deleted from "_QUE_" queue."
+13 QUIT
+14 ;
PURGEQ ; Purge all Request Queues of their entries
+1 ; For development and testing only.
+2 ; DO NOT USE IN PRODUCTION SYSTEMS.
+3 IF $$PROD^XUPROD(1)
if '$DATA(ZTQUEUED)
WRITE !,"Can't be used in a production environment!"
QUIT
+4 NEW QIEN
SET QIEN=0
FOR
SET QIEN=$ORDER(^VDEFHL7(579.3,QIEN))
if 'QIEN
QUIT
DO CLEANREQ(QIEN)
+5 QUIT
+6 ;
CLEANUP ; Delete records from VDEF files before installing the VDEF KIDS package
+1 ; For development and testing only.
+2 ; DO NOT USE IN PRODUCTION SYSTEMS.
+3 IF $$PROD^XUPROD(1)
if '$DATA(ZTQUEUED)
WRITE !,"Can't be used in a production environment!"
QUIT
+4 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Do you want to continue"
SET DIR("B")="No"
+5 WRITE !,"This action will DELETE all data from VDEF globals in preparation for a KIDS install."
+6 DO ^DIR
KILL DIR
IF Y=0
WRITE !,"VDEF Globals not deleted."
QUIT
+7 WRITE !,"Deleting records from VDEF globals ..."
+8 NEW SUB
SET SUB=""
FOR
SET SUB=$ORDER(^VDEFHL7(SUB))
if SUB=""
QUIT
Begin DoDot:1
+9 SET X=^VDEFHL7(SUB,0)
KILL ^VDEFHL7(SUB)
SET ^VDEFHL7(SUB,0)=X
End DoDot:1
+10 SET SUB=""
FOR
SET SUB=$ORDER(^VDEFOUT(SUB))
if SUB=""
QUIT
Begin DoDot:1
+11 SET X=^VDEFOUT(SUB,0)
KILL ^VDEFOUT(SUB)
SET ^VDEFOUT(SUB,0)=X
End DoDot:1
+12 WRITE !,"VDEF Globals deleted."
