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

VPRHSX.m

Go to the documentation of this file. 
  1. VPRHSX ;SLC/MKB -- HS Mgt Options ;09/18/18 4:36pm
  1.  ;;1.0;VIRTUAL PATIENT RECORD;**8,15,25,27**;Sep 01, 2011;Build 10
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; External References          DBIA#
  1.  ; -------------------          -----
  1.  ; ^DPT                         10035
  1.  ; DIE                          10018
  1.  ; DIR                          10026
  1.  ; MPIF001                       2701
  1.  ; VADPT                         3744
  1.  ; XLFDT                        10103
  1.  ; XLFSTR                       10104
  1.  ; XUPROD                        4440
  1.  ;
  1. ON ; -- Turn monitoring on/off [VPR HS ENABLE]
  1.  N X0,DA,DR,DIE,X,Y
  1.  S X0=$G(^VPR(1,0)) I '$P(X0,U,2) D  Q  ;off -- turn on
  1.  . S DA=1,DR=".02",DIE="^VPR(" D ^DIE
  1.  . I $P($G(^VPR(1,0)),U,2) S $P(^VPR(1,0),U,4)=$$NOW^XLFDT
  1.  ; 
  1.  I $$PROD^XUPROD D  Q:'$$SURE
  1.  . W !,$C(7) ;On in production
  1.  . W !,"WARNING: Turning off data monitoring will cause the Regional Health Connect"
  1.  . W !,"         server to become out of synch with VistA!!",!
  1.  . W !,"    ***  Do NOT proceed unless directed to do so by Health Product Support"
  1.  . W !,"         or VPR development staff!",!
  1.  W ! S DA=1,DR=".02",DIE="^VPR(" D ^DIE
  1.  I '$P($G(^VPR(1,0)),U,2) S $P(^VPR(1,0),U,3,4)=$$NOW^XLFDT_U
  1.  Q
  1.  ;
  1. SURE() ; -- are you sure?
  1.  N X,Y,DIR,DUOUT,DTOUT
  1.  S DIR(0)="YA",DIR("B")="NO"
  1.  S DIR("A")="ARE YOU SURE? ",DIR("?")="Enter YES to continue with disabling data monitoring for HealthShare"
  1.  D ^DIR S:$D(DUOUT)!$D(DTOUT) Y="^"
  1.  Q Y
  1.  ;
  1.  ;
  1. PATS ; -- Inquire if patient is subscribed [VPR HS PATIENTS]
  1.  N PAT,DFN,SUB,ICN,X
  1. P1 W ! S PAT=$$PATIENT^VPRHST,ICN="" Q:PAT<1
  1.  S SUB=$$SUBS^VPRHS(+PAT),ICN=$$GETICN^MPIF001(+PAT)
  1.  W !!,$P(PAT,U,2)_" is "_$S('SUB:"NOT ",1:"")_"subscribed in HealthShare"
  1.  W !,"DFN: "_+PAT
  1.  W !,"ICN: "_$S(ICN>0:ICN,1:$P(ICN,U,2))
  1.  ; show other validity checks
  1.  S X=+$G(^DPT(+PAT,.35)) I X W !,">> Patient DIED on "_$$FMTE^XLFDT(X)
  1.  I $$TESTPAT^VADPT(+PAT),$$PROD^XUPROD W !,">> TEST PATIENT"
  1.  I $$MERGED^VPRHS(+PAT) D
  1.  . N X S X=$G(^DPT(+PAT,-9))
  1.  . W !,">> Patient is being MERGED"_$S(X:" into DFN "_X,1:"")
  1.  W ! G P1
  1.  Q
  1.  ;
  1.  ;
  1. GET ; -- Add patient/container/record to GET list [VPR HS PUSH]
  1.  G GET^VPRHSX1
  1.  Q
  1.  ;
  1. LAST ; -- Reset last seq# [VPR HS CLEAR LIST]
  1.  W !!,"OUT OF ORDER",$C(7) ;option removed
  1.  Q
  1.  ;
  1.  ;
  1. LOG ; -- Turn update logging on/off for debugging [VPR HS LOG]
  1.  N X0,ACT S X0=$G(^VPR(1,0))
  1.  I '$P(X0,U,2) W !,"NOTE: Data monitoring is not running!!"
  1.  ;
  1.  I '$P(X0,U,5) D  Q  ;off -- turn on logging?
  1.  . N X,Y,DIR
  1.  . W !!,"Upload list logging is currently OFF",!
  1.  . S DIR(0)="YA",DIR("B")="NO"
  1.  . S DIR("A")="Would you like to turn it ON? "
  1.  . S DIR("?",1)="Enter YES to begin saving a copy of the upload list nodes in ^XTMP;"
  1.  . S DIR("?")="logged data will be kept for three days."
  1.  . D ^DIR I Y>0 S $P(^VPR(1,0),U,5)=1
  1.  . D KILL
  1.  ;
  1.  ; on -- turn off logging?
  1.  W !!,"Upload list logging is currently ON",!
  1.  F  S ACT=$$ACTION Q:ACT="^"  D @ACT W !
  1.  Q
  1.  ;
  1. ACTION() ; -- select log action
  1.  N X,Y,Z,DIR,DUOUT,DTOUT
  1.  S DIR(0)="SA^V:VIEW;O:OFF;Q:QUIT;",DIR("A")="Select log action: "
  1.  S DIR("B")=$S($O(^XTMP("VPRHS-0"))?1"VPRHS-"1.N:"VIEW",1:"QUIT")
  1.  S DIR("?")="     Enter QUIT to exit this option."
  1.  S DIR("L",1)="     Enter VIEW to select a date to view data."
  1.  S DIR("L")="     Enter OFF to turn logging of the Upload List off."
  1.  D ^DIR S Z=$G(Y(0)) S:$D(DUOUT)!$D(DTOUT)!(Y="Q") Z="^"
  1.  Q Z
  1.  ;
  1. OFF ; -- turn off logging?
  1.  K DIR S DIR(0)="YA",DIR("B")="NO"
  1.  S DIR("A")="Would you like to turn logging OFF? "
  1.  S DIR("?")="Enter YES to stop saving a copy of the update list nodes in ^XTMP"
  1.  D ^DIR Q:Y'>0  S $P(^VPR(1,0),U,5)=0
  1.  D KILL
  1.  Q
  1.  ;
  1. KILL ; remove log too?
  1.  N I,X,Y,DIR
  1.  S I=$O(^XTMP("VPRHS-0")),X=+$O(^(I,0)) Q:X<1  ;no data
  1.  S DIR(0)="YA",DIR("B")="NO"
  1.  S DIR("A")="Would you like to remove existing logs? "
  1.  S DIR("?",1)="Enter YES to kill any existing logs in ^XTMP; NO will keep the logs"
  1.  S DIR("?")="available until "_$$FMTE^XLFDT(X,2)_"."
  1.  D ^DIR Q:Y<1
  1.  S I="VPRHS-0" F  S I=$O(^XTMP(I)) Q:I'?1"VPRHS-"5N  K ^XTMP(I)
  1.  Q
  1.  ;
  1. VIEW ; -- display ^XTMP log
  1.  N VPRH,PAT,SEQ,LCNT,DFN,STR,DONE
  1. V1 S VPRH=$$DATE Q:"^"[VPRH
  1.  S SEQ=$$NUM(VPRH) Q:"^"[SEQ
  1.  S PAT=$$PATIENT^VPRHST Q:$D(DUOUT)!$D(DTOUT)  S:+PAT<0 PAT=""
  1.  D HDR S LCNT=2 K DONE
  1.  F  S SEQ=$O(^XTMP("VPRHS-"_VPRH,SEQ)) Q:SEQ<1  D  I $G(DONE) W ! Q
  1.  . S DFN=+$O(^XTMP("VPRHS-"_VPRH,SEQ,0)),STR=$G(^(DFN))
  1.  . I PAT,DFN'=+PAT Q
  1.  . S LCNT=LCNT+1 I LCNT>(IOSL-2) D READ Q:$G(DONE)  D HDR S LCNT=3
  1.  . W !,SEQ,?10,DFN,?20,STR
  1.  I '$G(DONE) D READ W !
  1.  G V1
  1.  Q
  1.  ;
  1. HDR ; -- write captions
  1.  W !!,"SEQ",?10,"DFN",?20,$$HTE^XLFDT(VPRH) W:PAT " for ",$P(PAT,U,2)
  1.  W !,$$REPEAT^XLFSTR("-",79)
  1.  Q
  1.  ;
  1. DATE() ; -- select a date from ^XTMP("VPRHS",date)
  1.  N X1,X2,X,Y,DIR,DUOUT,DTOUT,Z
  1.  S X1=$O(^XTMP("VPRHS-0")),X1=+$P(X1,"-",2)
  1.  I 'X1 W !,"There are no log entries to display." Q "^"
  1.  S X2=$O(^XTMP("VPRHS-AAAAA"),-1),X2=+$P(X2,"-",2),DIR("A")="Select a date: "
  1.  S DIR(0)="DAO^"_$$HTFM^XLFDT(X1)_":"_$$HTFM^XLFDT(X2)_":EX"
  1.  S Z=$$HTE^XLFDT(X2),DIR("B")=Z ;latest date available
  1.  I X1=X2 S DIR("?")="Available date is "_Z
  1.  E  S DIR("?")="Available dates are "_$$HTE^XLFDT(X1)_" to "_Z
  1.  S DIR("?")=DIR("?")_", or enter ^ to exit"
  1.  D ^DIR S Z="" S:$D(DUOUT)!$D(DUOUT) Z="^"
  1.  I Y>0 S Z=$P($$FMTH^XLFDT(Y),",")
  1.  Q Z
  1.  ;
  1. NUM(DAY) ; -- select a starting seq#
  1.  N A,Z,X,Y
  1.  S A=+$O(^XTMP("VPRHS-"_DAY,0)),Z=+$O(^XTMP("VPRHS-"_DAY,"A"),-1)
  1. N1 W !,"Starting sequence#: FIRST// "
  1.  R X:DTIME I '$T!(X["^") Q "^"
  1.  I "FIRST"[$$UP^XLFSTR(X) Q 0
  1.  I +X=X,X'<A,X'>Z Q (X-1)
  1.  W !!,"Sequence numbers for this date are "_A_"-"_Z,!
  1.  G N1
  1.  Q
  1.  ;
  1. READ ; -- continue?
  1.  N X K DONE
  1.  W !!,"Press <return> to continue ..." R X:DTIME
  1.  S:X["^" DONE=1
  1.  Q