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

VDEFMNU.m

Go to the documentation of this file. 
  1. VDEFMNU ;INTEGIC/YG & BPOIFO/JG - Edit VDEF parameters & status ; 20 Dec 2005  12:57 PM
  1.  ;;1.0;VDEF;**3**;Dec 28, 2004;
  1.  ;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  ; IA's: #4322 - ^HLCS(870,<link>,0)
  1.  ;       #1373 - Lookup to file #101
  1.  ;       #10063 - $$JOB^%ZTLOAD
  1.  ;
  1.  Q  ; No bozos
  1.  ;
  1. SITE ; Edit Site-Wide Parameters
  1.  N DA,DIC,DIE,DR S DIE=579.5,DA=1,DR=".01;.02;" D ^DIE
  1.  Q
  1.  ;
  1. REQUEST ; Edit Request Queue Parameters
  1.  N DIC,DLAYGO,X,Y,DIE,DA,DR
  1. REQUEST1 K DIC S DIC=579.3,DIC(0)="AQE",DIC("A")="Select Request Queue: "  W ! D ^DIC Q:Y=-1
  1.  K DIC S DIE=579.3,DA=$P(Y,U),DR=".04;.05;.02" D ^DIE
  1.  G REQUEST1
  1.  ;
  1. REQOFF ; Toggle Requestor On/Off
  1.  N DIC,DLAYGO,X,Y,DIE,DA,DR
  1. REQOFF1 K DIC S DIC=579.1,DIC(0)="AQE",DIC("A")="Select Requestor: " W ! D ^DIC Q:Y=-1
  1.  I $$GET1^DIQ(579.1,$P(Y,U)_",",.05,"I")="A" D
  1.  . W !,!,"Inactivating a requestor has a significant effect on the synchronization"
  1.  . W !,"of VistA and remote system(s).  All VDEF requests made while the requestor"
  1.  . W !,"is inactive will be PERMANENTLY lost.  Make sure you really want to"
  1.  . W !,"turn it off.",!
  1.  K DIC S DIE=579.1,DA=$P(Y,U),DR=".05" D ^DIE
  1.  G REQOFF1
  1.  ;
  1. QUEOFF ; Toggle Request Processor Queue on/off
  1.  N DIC,DLAYGO,X,Y,DIE,DA,DR,QUEUE,STAT,TMTASK
  1. QUEOFF1 K DIC S DIC=579.3,DIC(0)="AQE",DIC("A")="Select Request Queue: " W ! D ^DIC Q:Y=-1
  1.  K DIC S QUEUE=$P(Y,U) S DIE=579.3,DA=QUEUE,DR=".09" D ^DIE
  1.  ;
  1.  ; Get the new status of the Request Processor
  1.  S STAT=$$GET1^DIQ(579.3,QUEUE_",",.09,"I")
  1.  ;
  1.  ; Start the Request Processor
  1.  I STAT="R" D REQ^VDEFCONT(QUEUE)
  1.  ;
  1.  ; Stop the Request Processor
  1.  I STAT="S" D
  1.  . S TMTASK=$$GET1^DIQ(579.3,QUEUE_",",.08,"I") S:TMTASK'="" X=$$ASKSTOP^%ZTLOAD(TMTASK)
  1.  . S TMTASK=$$GET1^DIQ(579.3,QUEUE_",",.11,"I") S:TMTASK'="" X=$$ASKSTOP^%ZTLOAD(TMTASK)
  1.  G QUEOFF1
  1.  ;
  1. SCHED ; Schedule processor
  1.  N DIC,DLAYGO,X,Y,SIEN,DIE,DA,DR,QUEUE,STAT,TMTASK,ENTRY
  1. SCHED1 K DIC S DIC=579.3,DIC(0)="AQE",DIC("A")="Select Request Queue: " W ! D ^DIC Q:Y=-1
  1.  K DIC S QUEUE=$P(Y,U) D DISP S DA(1)=QUEUE,DIC="^VDEFHL7(579.3,"_QUEUE_",2,"
  1.  S DIC(0)="AQEL",DIC("A")="Select Entry: " D ^DIC G SCHED1:Y=-1
  1.  S ENTRY=$P(Y,U),DIE=DIC,DA=ENTRY
  1.  S DR=".01;.02;.03;D SCHFORM^VDEFMNU;.04;D SCHFORM^VDEFMNU;.05" D ^DIE
  1.  W ! D DISP
  1.  ;
  1.  ; Now reschedule the processor task back
  1.  S ZTSK=$P(^VDEFHL7(579.3,QUEUE,0),U,8) D ISQED^%ZTLOAD
  1.  ;
  1.  ; If old task not found or not running, start it.
  1.  I $G(ZTSK("E"))'="" D REQ^VDEFCONT(QUEUE) G SCHED1
  1.  I ZTSK(0)=0 D REQ^VDEFCONT(QUEUE) G SCHED1
  1.  ;
  1.  ; Task is scheduled, so reschedule it.
  1.  K ZTDESC,ZTIO,ZTRTN,ZTSAVE S ZTDTH=$H D REQ^%ZTLOAD
  1.  G SCHED1
  1.  ;
  1. SCHFORM W !,"Enter time in military form as HH:MM"
  1.  Q
  1.  ;
  1. DISP ; Display scheduling rules.
  1.  I '$O(^VDEFHL7(579.3,QUEUE,2,0)) W !,"No Scheduling Rules currently defined for this queue"
  1.  E  S SIEN=0 D
  1.  . W !,"Currently defined Scheduling Rules are :"
  1.  . F  S SIEN=$O(^VDEFHL7(579.3,QUEUE,2,SIEN)) Q:'SIEN  D
  1.  .. W !,$$GET1^DIQ(579.32,SIEN_","_QUEUE_",",.01,"E")
  1.  .. W ") On ",$$GET1^DIQ(579.32,SIEN_","_QUEUE_",",.02,"E")
  1.  .. W " the request processor is "
  1.  .. S STAT=$$GET1^DIQ(579.32,SIEN_","_QUEUE_",",.03,"E")
  1.  .. W STAT," from ",$$GET1^DIQ(579.32,SIEN_","_QUEUE_",",.04,"I")
  1.  .. W " to ",$$GET1^DIQ(579.32,SIEN_","_QUEUE_",",.05,"I")
  1.  Q
  1.  ;
  1. CUSTOD ; Edit Custodial Package Status
  1.  N DIC,DLAYGO,X,Y,DIE,DA,DR,PACK
  1. CUSTOD1 K DIC S DIC=579.6,DIC(0)="AQE",DIC("A")="Select Custodial Package: "
  1.  W ! D ^DIC Q:Y=-1  S PACK=$P(Y,U)
  1.  I $P(Y,U,2)="REGISTRATION" D  G CUSTOD1
  1.  . W !,"Registration custodial package can't be edited"
  1.  I $$GET1^DIQ(579.6,PACK_",",.02,"I")="A" D
  1.  . W !!,"Inactivating a custodial package has a significant effect on the"
  1.  . W !,"synchronization of VistA and remote system(s).  All VDEF requests for HL7"
  1.  . W !,"messages associated with this custodial package made while the package is"
  1.  . W !,"inactivated will be PERMANENTLY lost.  Make sure you really want to turn"
  1.  . W !,"this custodial package off.",!
  1.  K DIC S DIE=579.6,DA=PACK,DR=".02" D ^DIE
  1.  G CUSTOD1
  1.  ;
  1. EVENT ; Edit VDEF API Event Status
  1.  N DIC,DLAYGO,X,Y,DIE,DA,DR,EVENT
  1. EVENT1 K DIC S DIC("W")="N Z,DESC S Z=^(0),DESC=$G(^(1)) W:$P(Z,U,9)'="""" DESC_""   ""_""Status: ""_$S($P(Z,U,11)=""A"":""ACTIVE"",1:""INACTIVE""),!,?8,""Pkg: ""_$P($G(^DIC(9.4,$P($G(^VDEFHL7(579.6,$P(Z,U,9),0),-1),U),0)),U)"
  1.  S DIC=577,DIC(0)="AQES",DIC("A")="Select VDEF API Event: "
  1.  W ! D ^DIC Q:Y=-1  S EVENT=$P(Y,U)
  1.  I $$GET1^DIQ(577,EVENT_",",.2,"I")="A" D
  1.  . W !!,"Inactivating a VDEF API event will cause all requests for that"
  1.  . W !,"API to be PERMANENTLY lost.  Make sure you really want to turn"
  1.  . W !,"this API event off.",!
  1.  K DIC S DIE=577,DA=EVENT,DR=".2" D ^DIE
  1.  G EVENT1
  1.  ;
  1. REPORT ; Display VDEF status/parameters
  1.  N LL,LLN,SUBS,LINX,TNN,TNF,IEN,NZ,VDI,VDJ,VDK,VDA,PROT,STATS,%H,Y
  1. REPORT1 W @IOF,?22,"VDEF Status - " S %H=$H D YX^%DTC W Y
  1.  W !,"Logical Link Status" K LINX
  1.  S VDI=0 F  S VDI=$O(^VDEFHL7(577,VDI)) Q:VDI=""  D
  1.  . K RES S PROT=$P($G(^VDEFHL7(577,VDI,0)),U,7) Q:PROT=""
  1.  . D GETS^DIQ(101,PROT_",","775*","I","RES")
  1.  . S VDJ=0 F  S VDJ=$O(RES(101.0775,VDJ)) Q:VDJ=""  D
  1.  .. S SUBS=RES(101.0775,VDJ,.01,"I")
  1.  .. I SUBS S LLN=$$GET1^DIQ(101,SUBS_",",770.7,"E") I LLN'="" S LINX(LLN)=1
  1.  S LLN=0 F  S LLN=$O(LINX(LLN)) Q:LLN=""  D
  1.  . W !?2,LLN,": " S LL=$O(^HLCS(870,"B",LLN,"")) Q:LL=""
  1.  . N ZTSK S ZTSK=$P($G(^HLCS(870,LL,0)),U,12)
  1.  . I ZTSK'="" D STAT^%ZTLOAD W:$G(ZTSK(1))=2 "running task #",ZTSK K ZTSK
  1.  . E  W "stopped or caught up"
  1.  W !!,"Requestor Status"
  1.  S IEN=0 F  S IEN=$O(^VDEFHL7(579.1,IEN)) Q:'IEN  D
  1.  . S NZ=^VDEFHL7(579.1,IEN,0) W !?2,$P(NZ,U),": "
  1.  . W $S($P(NZ,U,5)="A":"Activated",1:"Inactivated")
  1.  . W ?32,"Dest.: ",$P(^VDEFHL7(579.2,$P(NZ,U,3),0),U)
  1.  . W ?52,"Req. Queue: ",$P(^VDEFHL7(579.3,$P(NZ,U,4),0),U,1)
  1.  W !!,"Request Processor Status"
  1.  S IEN=0 F  S IEN=$O(^VDEFHL7(579.3,IEN)) Q:'IEN  D
  1.  . S NZ=^VDEFHL7(579.3,IEN,0) W !?2,$P(NZ,U),": "
  1.  . W $S($P(NZ,U,9)="R":"Running",1:"Suspended")
  1.  . N ZTSK S TNN=$P(NZ,U,11),ZTSK=TNN D STAT^%ZTLOAD
  1.  . W !?2,"Current Task # [Proc]: ",TNN
  1.  . W " ["_$$CNV^XLFUTL($$JOB^%ZTLOAD(TNN),16)_"]"
  1.  . W "  Task status: "
  1.  . I 'ZTSK(0) W "Undefined"
  1.  . E  W $S(ZTSK(1)=0:"Undefined",ZTSK(1)=1:"Active-Pending",ZTSK(1)=2:"Active-Running",ZTSK(1)=3:"Finished",ZTSK(1)=4:"Available",ZTSK(1)=5:"Interrupted",1:"Unknown")
  1.  . S NZ=$G(^VDEFHL7(579.3,IEN,1,0))
  1.  . I NZ="" W !?2,"No requests in the queue"
  1.  . E  W !?2,"Requests waiting for purge: ",$P(NZ,U,4),"      Last request#: ",$P(NZ,U,3)
  1.  . S STATS="" W !?2
  1.  . F STAT="C","Q","E" D
  1.  .. S (VDJ,VDK)=0 F VDJ=0:1:100+(STAT="Q"*900) S VDK=$O(^VDEFHL7(579.3,"C",STAT,IEN,VDK)) Q:VDK=""
  1.  .. W $S(STAT="C":"Checked Out",STAT="Q":"  Queued Up",STAT="E":"  Errored Out")
  1.  .. W $S(VDJ<(100+(STAT="Q"*900)):"("_VDJ_")",1:"(> "_(100+(STAT="Q"*900))_")")
  1.  ;
  1.  ; Loop added for dashboard monitoring
  1.  R !!,"Hit <return/enter> to continue or '^' to terminate: ",VDA:5
  1.  Q:VDA="^"  G REPORT1