source: FOIAVistA/tag/r/VDEF-VDEF/VDEFUTIL.m@ 1590

VDEFUTIL ;INTEGIC/AM & BPOIFO/JG - VDEF Utilities ; 21 Nov 2005  2:17 PM
 ;;1.0;VDEF;**3**;Dec 28, 2004
 ;Per VHA Directive 2004-038, 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@FORUM.VA.GOV")=""
 S XMY("GARDNER.JEFF@FORUM.VA.GOV")=""
 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)
 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."
 Q