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

HLOUSR7.m

Go to the documentation of this file.
  1. HLOUSR7 ;OIFO-ALB/CJM - Deleting HLO queues ;03/26/2012
  1. ;;1.6;HEALTH LEVEL SEVEN;**147,153,158**;Oct 13, 1995;Build 14
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ;
  1. SPURGE ; Entry point from ListManager for deleting sequential queues.
  1. N CONF,LINK,QUE,PORT,WHEN,COUNT,IEN
  1. S VALMBCK="R"
  1. D OWNSKEY^XUSRB(.CONF,"HLOMGR",DUZ)
  1. I CONF(0)'=1 D Q
  1. . W !,"**** You are not authorized to use this option ****" D PAUSE^VALM1 Q
  1. S QUE=$$GETQ^HLOUSR4()
  1. Q:QUE=""
  1. I '$D(^HLB("QUEUE","SEQUENCE",QUE)) W !,"There are no messages on that queue!" D PAUSE^VALM1 Q
  1. W !!,"Deleting a queue in error will result in lost messages!"
  1. Q:'$$ASKYESNO^HLOUSR2("Are you SURE you want to delete that queue","NO")
  1. W !!,"After removing the messages from the sequence queue they will deleted"
  1. W !,"When do you want to schedule the messages to be purged?"
  1. S WHEN=$$ASKWHEN($$FMADD^XLFDT($$NOW^XLFDT,7),"Date/Time to schedule purge:")
  1. Q:'WHEN
  1. S (IEN,COUNT)=0
  1. F S IEN=$O(^HLB("QUEUE","SEQUENCE",QUE,IEN)) Q:'IEN S COUNT=COUNT+1 Q:COUNT>100
  1. I COUNT>100,$$ASKTASK() D
  1. .S ZTRTN="SEQPURGE^HLOUSR7"
  1. .S ZTDESC="HLO QUEUE PURGE"
  1. .S ZTDTH=$H
  1. .S ZTIO=""
  1. .S ZTSAVE("QUE")=QUE,ZTSAVE("WHEN")=""
  1. .D ^%ZTLOAD
  1. .I '$G(ZTSK) W !!,?5,"UNABLE TO SCHEDULE PURGE JOB",!
  1. .I $G(ZTSK) W !!,?5,"Purge job is scheduled, task #"_ZTSK
  1. .D PAUSE^VALM1
  1. E D
  1. .D SEQPURGE
  1. .I $L(HLRFRSH) D @HLRFRSH
  1. Q
  1. ;
  1. OPURGE ; Entry point from ListManager for deleting outgoing queues.
  1. N CONF,LINK,QUE,PORT,WHEN,COUNT,IEN
  1. S VALMBCK="R"
  1. D OWNSKEY^XUSRB(.CONF,"HLOMGR",DUZ)
  1. I CONF(0)'=1 D Q
  1. . W !,"**** You are not authorized to use this option ****" D PAUSE^VALM1 Q
  1. S LINK=$$ASKLINK^HLOUSR
  1. Q:LINK=""
  1. W !
  1. S PORT=$$ASKPORT^HLOTRACE(LINK)
  1. I 'PORT W !,"There are no outgoing messages for that destination!" Q
  1. S LINK=LINK_":"_PORT
  1. W !
  1. S QUE=$$ASKQUE^HLOTRACE(LINK)
  1. I QUE="" W !,"There are no outgoing messages for that destination!" Q
  1. W !!,"Deleting a queue in error will result in lost messages!"
  1. Q:'$$ASKYESNO^HLOUSR2("Are you SURE you want to delete that queue","NO")
  1. W !!,"After removing the messages from the outgoing queue they will deleted"
  1. W !,"When do you want to schedule the messages to be purged?"
  1. S WHEN=$$ASKWHEN($$FMADD^XLFDT($$NOW^XLFDT,7),"Date/Time to schedule purge:")
  1. Q:'WHEN
  1. S (IEN,COUNT)=0
  1. F S IEN=$O(^HLB("QUEUE","OUT",LINK,QUE,IEN)) Q:'IEN S COUNT=COUNT+1 Q:COUNT>100
  1. I COUNT>100,$$ASKTASK() D
  1. .S ZTRTN="OUTPURGE^HLOUSR7"
  1. .S ZTDESC="HLO QUEUE PURGE"
  1. .S ZTDTH=$H
  1. .S ZTIO=""
  1. .S ZTSAVE("LINK")="",ZTSAVE("QUE")=QUE,ZTSAVE("WHEN")=""
  1. .D ^%ZTLOAD
  1. .I '$G(ZTSK) W !!,?5,"UNABLE TO SCHEDULE PURGE JOB",!
  1. .I $G(ZTSK) W !!,?5,"Purge job is scheduled, task #"_ZTSK
  1. .D PAUSE^VALM1
  1. E D
  1. .D OUTPURGE
  1. .D OUTQUE^HLOUSR6
  1. Q
  1. ;
  1. ASKTASK() ;
  1. W !!,"There are a lot of messages pending on that queue!"
  1. Q $$ASKYESNO^HLOUSR2("Would you like to delete the queue in the background via a separate task","YES")
  1. ;
  1. ;
  1. ASKWHEN(DEFAULT,PROMPT) ;
  1. ;Description: Asks the user to enter a dt/tm.
  1. ;Input: DEFAULT - the suggested default dt/time (optional, defaults to NOW)
  1. ;PROMPT - optional prompt
  1. ;Output: Returns the date as the function value, or 0 if the user does not select a date
  1. ;
  1. ;
  1. N %DT
  1. S %DT="AEST"
  1. S:$L($G(PROMPT)) %DT("A")=PROMPT
  1. S %DT("B")=$$FMTE^XLFDT($S($L($G(DEFAULT)):DEFAULT,1:"NOW"))
  1. S %DT(0)="NOW"
  1. Q:$D(DTOUT) 0
  1. D ^%DT
  1. I Y=-1 Q 0
  1. Q Y
  1. OUTPURGE ;Purge outgoing queue
  1. N MSG,CNT
  1. N MSG
  1. S (CNT,MSG)=0
  1. I '$D(ZTQUEUED) W !,"Removing messages....",!
  1. F S MSG=$O(^HLB("QUEUE","OUT",LINK,QUE,MSG)) Q:'MSG D
  1. .S CNT=CNT+1
  1. .I '(CNT#100),'$D(ZTQUEUED) W "."
  1. .I '(CNT#70000),'$D(ZTQUEUED) W "!"
  1. .D DEQUE^HLOQUE(LINK,QUE,"OUT",MSG)
  1. .I $$SETPURGE(MSG,WHEN) S $P(^HLB(MSG,0),"^",21)="MESSAGE GENERATED IN ERROR AND NOT TRANSMITTED"
  1. Q
  1. ;
  1. SEQPURGE ;Purge sequence queue
  1. N MSG,CNT
  1. S (CNT,MSG)=0
  1. I '$D(ZTQUEUED) W !,"Removing messages....",!
  1. F S MSG=$O(^HLB("QUEUE","SEQUENCE",QUE,MSG)) Q:'MSG D
  1. .S CNT=CNT+1
  1. .I '(CNT#100),'$D(ZTQUEUED) W "."
  1. .I '(CNT#70000),'$D(ZTQUEUED) W "!"
  1. .K ^HLB("QUEUE","SEQUENCE",QUE,MSG)
  1. .I $$SETPURGE(MSG,WHEN) S $P(^HLB(MSG,0),"^",21)="MESSAGE GENERATED IN ERROR AND NOT TRANSMITTED"
  1. I $$INC^HLOSITE($NA(^HLC("QUEUECOUNT","SEQUENCE")),-$G(^HLC("QUEUECOUNT","SEQUENCE",QUE)))
  1. S ^HLC("QUEUECOUNT","SEQUENCE",QUE)=0
  1. S ^HLB("QUEUE","SEQUENCE",QUE)=""
  1. Q
  1. ;
  1. SETPURGE(MSGIEN,TIME) ; Set message up for purging.
  1. ;Resets the purge date/time.
  1. ;Input:
  1. ; MSGIEN (required) ien of the message, file #778
  1. ; TIME (optional) dt/time to set the purge time to, defaults to NOW
  1. ;Output:
  1. ; Function returns 1 on success, 0 on failure
  1. ;
  1. N NODE,OLDTIME,HLDIR
  1. Q:'$G(MSGIEN) 0
  1. S NODE=$G(^HLB(MSGIEN,0))
  1. Q:NODE="" 0
  1. S OLDTIME=$P(NODE,"^",9)
  1. S:'$G(TIME) TIME=$$NOW^XLFDT
  1. S HLDIR=$S($E($P(NODE,"^",4))="I":"IN",1:"OUT")
  1. K:OLDTIME ^HLB("AD",HLDIR,OLDTIME,MSGIEN)
  1. S $P(^HLB(MSGIEN,0),"^",9)=TIME
  1. S ^HLB("AD",HLDIR,TIME,MSGIEN)=""
  1. Q 1