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

VDEFUTIL.m

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