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