VPRHSX2 ;SLC/MKB -- Monitor Encounter Upload task ;09/18/18 4:36pm
;;1.0;VIRTUAL PATIENT RECORD;**25**;Sep 01, 2011;Build 12
;;Per VA Directive 6402, this routine should not be modified.
;
; External References DBIA#
; ------------------- -----
; ^AUPNVSIT 2028
; ^SC 10040
; %ZTLOAD 10063
; DIQ 2056
; DIR 10026
; XLFDT 10103
; XLFSTR 10104
; XUPROD 4440
; XUTMTP 3521
;
EN ; -- Monitor Encounter update task
N VPRPX,DONE,ACT,ZTSK,STS
S VPRPX=$NA(^XTMP("VPRPX")),DONE=0
F D Q:DONE
. D DISP S ACT=$$ACTION
. Q:"U"[ACT I ACT="^" S DONE=1 Q
. D @$S(ACT="T":"TSK",ACT="R":"QUE",ACT="E":"ENC",ACT="D":"DOC",1:"ERR")
Q
;
ERR Q
;
DISP ; -- show current status
K ZTSK S ZTSK=$G(@VPRPX@("ZTSK"))
W @IOF,!,"Current time: "_$$FMTE^XLFDT($$NOW^XLFDT)
W !!,"Data Monitoring System is "_$S($$ON^VPRHS:"",1:"NOT ")_"ON."
;
; Task status
W !!,"Checking TaskMan ..."
D:ZTSK ISQED^%ZTLOAD S STS=$G(ZTSK(0))
W !!,?5,"VPR Encounter task is "_$S('STS:"NOT ",1:"")_"SCHEDULED."
W:ZTSK="" !?5,"There is NO task defined." I ZTSK D
. W !?5,"Task #"_ZTSK_" is "_$S(STS:"SCHEDULED",STS="":"INVALID.",1:"")
. I STS S X=$G(ZTSK("D")) I X W " for "_$$HTE^XLFDT(X) Q
. I STS="" W !?5,$$TSKERR($G(ZTSK("E"))) Q
. D STAT^%ZTLOAD W $G(ZTSK(2)) ;ZTSK(0)=0: task stopped
;
; Data waiting
W !!,"Checking the Transmission List ...",!
W !?5,"There are "_$S($O(@VPRPX@(0)):"",1:"no ")_"encounters awaiting transmission."
W !?5,"There are "_$S($O(@VPRPX@("DOC",0)):"",1:"no ")_"documents awaiting transmission."
; Q:ZTSK&STS Q:'DATA&(ZTSK="") ;ok
I ZTSK,'STS W !!," *** VPR ENCOUNTER TASK MUST BE RESTARTED ***"
W !
Q
TSKERR(X) ; -- return description for error code X
N Y S X=$G(X),Y=""
I X="IT" S Y="The task number is not valid."
I X="I" S Y="The task does not exist on this volume set."
I X="IS" S Y="The volume set is not listed in the VOLUME SET (#14.5) file."
I X="LS" S Y="The link to that volume set is not available."
I X="U" S Y="An unexpected error occurred."
Q Y
;
WAIT ; -- end of action
N X W !!,"Press <return> to continue ..." R X:DTIME
Q
;
TSK ; -- TM display of task
I ZTSK="" W !!,"Task does not exist." H 2 Q
W ! D EN^XUTMTP(ZTSK),WAIT
Q
;
QUE ; -- Requeue the task
I ZTSK'=$G(@VPRPX@("ZTSK")) W !!,"Task #"_ZTSK_" is no longer current." G QD
I ZTSK&STS W !!,"The task is current and scheduled." G QD
I ZTSK="","ZTSK"[$O(@VPRPX@(0)) W !!,"There is no data awaiting transmission." G QD
W !!,"VPR Encounter task needs to be "_$S(ZTSK:"re",1:"")_"started."
I '$$ON^VPRHS W !,$C(7),"Data Monitoring must be enabled first!" G QD
I '$$REQUE W !,$C(7),"Please contact Health Product Support for assistance!" G QD
D QUE^VPRENC(5) S ZTSK=$G(@VPRPX@("ZTSK"))
W !!,"Task "_$S(ZTSK:"#"_ZTSK,1:" NOT")_" queued."
QD ;end
D WAIT
Q
REQUE() ; -- return 1 or 0, if ready to re-queue task
N X,Y,DIR,DTOUT,DUOUT
S DIR(0)="YA",DIR("A")="Restart task? ",DIR("B")="YES"
W ! D ^DIR S:Y["^"!$D(DTOUT) Y=0
Q Y
;
ENC ; -- display ^XTMP("VPRPX",VST~DFN)
N VPRV,VPRX,LCNT,DFN,X0,NAME,VPRT,VPRI,X,L,EXT
I '$O(@VPRPX@("AVST",0)) W !!,"No encounters are awaiting transmission." H 2 Q
D EHDR
M VPRV=@VPRPX@("AVST") S VPRX="VPRV"
S (LCNT,EXT)=0 F S VPRX=$Q(@VPRX) Q:VPRX="" D Q:EXT
. S VPRT=$QS(VPRX,1),VPRI=$QS(VPRX,2)
. S DFN=$P(VPRI,"~",2),X0=$G(^AUPNVSIT(+VPRI,0))
. S X=$P(X0,U,7),L=+$P(X0,U,22),NAME=$$VTYP(X,L)
. W !,$$FMTE^XLFDT(VPRT,"2FS"),?21,+VPRI,?32,DFN,?44,NAME
. S LCNT=LCNT+1 Q:LCNT#20 Q:$Q(@VPRX)=""
. W !!,"Press <return> to continue or ^ to exit ..."
. R X:DTIME I '$T!(X["^") S EXT=1 Q
. D EHDR
I 'EXT D WAIT
Q
;I $D(@VPRPX@(VPRI))>9 D ;Vfiles
;.. N IDX,VF,DA,STR,C S STR="",C=""
;.. S IDX=$NA(@VPRPX@(VPRI)) F S IDX=$Q(@IDX) Q:$QS(IDX,2)'=VPRI S VF=$QS(IDX,3),DA=$QS(IDX,4),STR=STR_C_$P($$NAME^VPRENC(VF,DA),U),C=", "
;.. S LCNT=LCNT+1 W !,@$S($L(STR)<59:"?20",1:"?"_(78-$L(STR))),"+ "_STR
;
VTYP(C,HL) ; -- return visit type for service Category & Hosp Loc
N Y S Y="VISIT"
S HL=+$G(HL),C=$G(C)
I "A^I^N^S^O^E^D^X"[C,HL S Y=$P($G(^SC(+HL,0)),U)
E S:$L(C) Y=$$CATG^VPRDVSIT(C)
Q Y
;
EHDR ; -- write encounter header
W @IOF," Last Updated Visit# DFN Location ",$$FMTE^XLFDT($$NOW^XLFDT)
W !,$$REPEAT^XLFSTR("-",79)
Q
;
DOC ; -- display ^XTMP("VPRPX","DOC",ien)
N VPRD,VPRX,LCNT,DFN,TTL,VPRT,VPRI,X,EXT
I '$O(@VPRPX@("ADOC",0)) W !!,"No documents are awaiting transmission." D WAIT Q
D DHDR
M VPRD=@VPRPX@("ADOC") S VPRX="VPRD"
S (LCNT,EXT)=0 F S VPRX=$Q(@VPRX) Q:VPRX="" D Q:EXT
. S VPRT=$QS(VPRX,1),VPRI=$QS(VPRX,2)
. S DFN=$$GET1^DIQ(8925,VPRI,.02,"I"),TTL=$$GET1^DIQ(8925,VPRI,.01)
. W !,$$FMTE^XLFDT(VPRT,"2FS"),?20,VPRI,?32,DFN,?44,$E(TTL,1,32)_$S($L(TTL)>32:"...",1:"")
. S LCNT=LCNT+1 Q:LCNT#20 Q:$Q(@VPRX)=""
. W !!,"Press <return> to continue or ^ to exit ..."
. R X:DTIME I '$T!(X["^") S EXT=1 Q
. D DHDR
I 'EXT D WAIT
Q
;
DHDR ; -- write doc header
W @IOF," Last Updated Doc# DFN Title ",$$FMTE^XLFDT($$NOW^XLFDT)
W !,$$REPEAT^XLFSTR("-",79)
Q
;
ACTION() ; -- select monitor action
N X,CODES
S CODES="UTED"_$S($G(VPRTEST):"",1:"R")
A1 W !,"Select monitor action: UPDATE// "
R X:DTIME I '$T!(X["^") Q "^"
I X["?" D ACTHLP G A1
S:$L(X) X=$$UP^XLFSTR($E(X)) S:X="" X="U" I X="Q" Q "^"
I CODES'[X W $C(7)," ??",! G A1
Q X
ACTHLP ; -- show choices
W !!?5,"Enter <RETURN> to refresh the monitor display."
W !?5,"Enter Q to exit the monitor."
W !?5,"Enter T to display the task."
W:'$G(VPRTEST) !?5,"Enter R to re-queue the transmission task."
W !?5,"Enter E to display the Encounter list."
W !?5,"Enter D to display the Document list."
W !?5,"Enter ? to see this message.",!
Q
;
BANNER ; -- banner(s) for mgt menu
I '$$ON^VPRHS,$$PROD^XUPROD W !!,$C(7),">> WARNING -- DATA MONITORING IS NOT ENABLED!!"
N ZTSK,STS S ZTSK=$G(^XTMP("VPRPX","ZTSK")) I ZTSK D
. D ISQED^%ZTLOAD S STS=$G(ZTSK(0))
. I 'STS W !!,">> WARNING -- VPR ENCOUNTER TASK IS NOT RUNNING!!"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPRHSX2 6342 printed Oct 16, 2024@18:45:56 Page 2
VPRHSX2 ;SLC/MKB -- Monitor Encounter Upload task ;09/18/18 4:36pm
+1 ;;1.0;VIRTUAL PATIENT RECORD;**25**;Sep 01, 2011;Build 12
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; External References DBIA#
+5 ; ------------------- -----
+6 ; ^AUPNVSIT 2028
+7 ; ^SC 10040
+8 ; %ZTLOAD 10063
+9 ; DIQ 2056
+10 ; DIR 10026
+11 ; XLFDT 10103
+12 ; XLFSTR 10104
+13 ; XUPROD 4440
+14 ; XUTMTP 3521
+15 ;
EN ; -- Monitor Encounter update task
+1 NEW VPRPX,DONE,ACT,ZTSK,STS
+2 SET VPRPX=$NAME(^XTMP("VPRPX"))
SET DONE=0
+3 FOR
Begin DoDot:1
+4 DO DISP
SET ACT=$$ACTION
+5 if "U"[ACT
QUIT
IF ACT="^"
SET DONE=1
QUIT
+6 DO @$SELECT(ACT="T":"TSK",ACT="R":"QUE",ACT="E":"ENC",ACT="D":"DOC",1:"ERR")
End DoDot:1
if DONE
QUIT
+7 QUIT
+8 ;
ERR QUIT
+1 ;
DISP ; -- show current status
+1 KILL ZTSK
SET ZTSK=$GET(@VPRPX@("ZTSK"))
+2 WRITE @IOF,!,"Current time: "_$$FMTE^XLFDT($$NOW^XLFDT)
+3 WRITE !!,"Data Monitoring System is "_$SELECT($$ON^VPRHS:"",1:"NOT ")_"ON."
+4 ;
+5 ; Task status
+6 WRITE !!,"Checking TaskMan ..."
+7 if ZTSK
DO ISQED^%ZTLOAD
SET STS=$GET(ZTSK(0))
+8 WRITE !!,?5,"VPR Encounter task is "_$SELECT('STS:"NOT ",1:"")_"SCHEDULED."
+9 if ZTSK=""
WRITE !?5,"There is NO task defined."
IF ZTSK
Begin DoDot:1
+10 WRITE !?5,"Task #"_ZTSK_" is "_$SELECT(STS:"SCHEDULED",STS="":"INVALID.",1:"")
+11 IF STS
SET X=$GET(ZTSK("D"))
IF X
WRITE " for "_$$HTE^XLFDT(X)
QUIT
+12 IF STS=""
WRITE !?5,$$TSKERR($GET(ZTSK("E")))
QUIT
+13 ;ZTSK(0)=0: task stopped
DO STAT^%ZTLOAD
WRITE $GET(ZTSK(2))
End DoDot:1
+14 ;
+15 ; Data waiting
+16 WRITE !!,"Checking the Transmission List ...",!
+17 WRITE !?5,"There are "_$SELECT($ORDER(@VPRPX@(0)):"",1:"no ")_"encounters awaiting transmission."
+18 WRITE !?5,"There are "_$SELECT($ORDER(@VPRPX@("DOC",0)):"",1:"no ")_"documents awaiting transmission."
+19 ; Q:ZTSK&STS Q:'DATA&(ZTSK="") ;ok
+20 IF ZTSK
IF 'STS
WRITE !!," *** VPR ENCOUNTER TASK MUST BE RESTARTED ***"
+21 WRITE !
+22 QUIT
TSKERR(X) ; -- return description for error code X
+1 NEW Y
SET X=$GET(X)
SET Y=""
+2 IF X="IT"
SET Y="The task number is not valid."
+3 IF X="I"
SET Y="The task does not exist on this volume set."
+4 IF X="IS"
SET Y="The volume set is not listed in the VOLUME SET (#14.5) file."
+5 IF X="LS"
SET Y="The link to that volume set is not available."
+6 IF X="U"
SET Y="An unexpected error occurred."
+7 QUIT Y
+8 ;
WAIT ; -- end of action
+1 NEW X
WRITE !!,"Press <return> to continue ..."
READ X:DTIME
+2 QUIT
+3 ;
TSK ; -- TM display of task
+1 IF ZTSK=""
WRITE !!,"Task does not exist."
HANG 2
QUIT
+2 WRITE !
DO EN^XUTMTP(ZTSK)
DO WAIT
+3 QUIT
+4 ;
QUE ; -- Requeue the task
+1 IF ZTSK'=$GET(@VPRPX@("ZTSK"))
WRITE !!,"Task #"_ZTSK_" is no longer current."
GOTO QD
+2 IF ZTSK&STS
WRITE !!,"The task is current and scheduled."
GOTO QD
+3 IF ZTSK=""
IF "ZTSK"[$ORDER(@VPRPX@(0))
WRITE !!,"There is no data awaiting transmission."
GOTO QD
+4 WRITE !!,"VPR Encounter task needs to be "_$SELECT(ZTSK:"re",1:"")_"started."
+5 IF '$$ON^VPRHS
WRITE !,$CHAR(7),"Data Monitoring must be enabled first!"
GOTO QD
+6 IF '$$REQUE
WRITE !,$CHAR(7),"Please contact Health Product Support for assistance!"
GOTO QD
+7 DO QUE^VPRENC(5)
SET ZTSK=$GET(@VPRPX@("ZTSK"))
+8 WRITE !!,"Task "_$SELECT(ZTSK:"#"_ZTSK,1:" NOT")_" queued."
QD ;end
+1 DO WAIT
+2 QUIT
REQUE() ; -- return 1 or 0, if ready to re-queue task
+1 NEW X,Y,DIR,DTOUT,DUOUT
+2 SET DIR(0)="YA"
SET DIR("A")="Restart task? "
SET DIR("B")="YES"
+3 WRITE !
DO ^DIR
if Y["^"!$DATA(DTOUT)
SET Y=0
+4 QUIT Y
+5 ;
ENC ; -- display ^XTMP("VPRPX",VST~DFN)
+1 NEW VPRV,VPRX,LCNT,DFN,X0,NAME,VPRT,VPRI,X,L,EXT
+2 IF '$ORDER(@VPRPX@("AVST",0))
WRITE !!,"No encounters are awaiting transmission."
HANG 2
QUIT
+3 DO EHDR
+4 MERGE VPRV=@VPRPX@("AVST")
SET VPRX="VPRV"
+5 SET (LCNT,EXT)=0
FOR
SET VPRX=$QUERY(@VPRX)
if VPRX=""
QUIT
Begin DoDot:1
+6 SET VPRT=$QSUBSCRIPT(VPRX,1)
SET VPRI=$QSUBSCRIPT(VPRX,2)
+7 SET DFN=$PIECE(VPRI,"~",2)
SET X0=$GET(^AUPNVSIT(+VPRI,0))
+8 SET X=$PIECE(X0,U,7)
SET L=+$PIECE(X0,U,22)
SET NAME=$$VTYP(X,L)
+9 WRITE !,$$FMTE^XLFDT(VPRT,"2FS"),?21,+VPRI,?32,DFN,?44,NAME
+10 SET LCNT=LCNT+1
if LCNT#20
QUIT
if $QUERY(@VPRX)=""
QUIT
+11 WRITE !!,"Press <return> to continue or ^ to exit ..."
+12 READ X:DTIME
IF '$TEST!(X["^")
SET EXT=1
QUIT
+13 DO EHDR
End DoDot:1
if EXT
QUIT
+14 IF 'EXT
DO WAIT
+15 QUIT
+16 ;I $D(@VPRPX@(VPRI))>9 D ;Vfiles
+17 ;.. N IDX,VF,DA,STR,C S STR="",C=""
+18 ;.. S IDX=$NA(@VPRPX@(VPRI)) F S IDX=$Q(@IDX) Q:$QS(IDX,2)'=VPRI S VF=$QS(IDX,3),DA=$QS(IDX,4),STR=STR_C_$P($$NAME^VPRENC(VF,DA),U),C=", "
+19 ;.. S LCNT=LCNT+1 W !,@$S($L(STR)<59:"?20",1:"?"_(78-$L(STR))),"+ "_STR
+20 ;
VTYP(C,HL) ; -- return visit type for service Category & Hosp Loc
+1 NEW Y
SET Y="VISIT"
+2 SET HL=+$GET(HL)
SET C=$GET(C)
+3 IF "A^I^N^S^O^E^D^X"[C
IF HL
SET Y=$PIECE($GET(^SC(+HL,0)),U)
+4 IF '$TEST
if $LENGTH(C)
SET Y=$$CATG^VPRDVSIT(C)
+5 QUIT Y
+6 ;
EHDR ; -- write encounter header
+1 WRITE @IOF," Last Updated Visit# DFN Location ",$$FMTE^XLFDT($$NOW^XLFDT)
+2 WRITE !,$$REPEAT^XLFSTR("-",79)
+3 QUIT
+4 ;
DOC ; -- display ^XTMP("VPRPX","DOC",ien)
+1 NEW VPRD,VPRX,LCNT,DFN,TTL,VPRT,VPRI,X,EXT
+2 IF '$ORDER(@VPRPX@("ADOC",0))
WRITE !!,"No documents are awaiting transmission."
DO WAIT
QUIT
+3 DO DHDR
+4 MERGE VPRD=@VPRPX@("ADOC")
SET VPRX="VPRD"
+5 SET (LCNT,EXT)=0
FOR
SET VPRX=$QUERY(@VPRX)
if VPRX=""
QUIT
Begin DoDot:1
+6 SET VPRT=$QSUBSCRIPT(VPRX,1)
SET VPRI=$QSUBSCRIPT(VPRX,2)
+7 SET DFN=$$GET1^DIQ(8925,VPRI,.02,"I")
SET TTL=$$GET1^DIQ(8925,VPRI,.01)
+8 WRITE !,$$FMTE^XLFDT(VPRT,"2FS"),?20,VPRI,?32,DFN,?44,$EXTRACT(TTL,1,32)_$SELECT($LENGTH(TTL)>32:"...",1:"")
+9 SET LCNT=LCNT+1
if LCNT#20
QUIT
if $QUERY(@VPRX)=""
QUIT
+10 WRITE !!,"Press <return> to continue or ^ to exit ..."
+11 READ X:DTIME
IF '$TEST!(X["^")
SET EXT=1
QUIT
+12 DO DHDR
End DoDot:1
if EXT
QUIT
+13 IF 'EXT
DO WAIT
+14 QUIT
+15 ;
DHDR ; -- write doc header
+1 WRITE @IOF," Last Updated Doc# DFN Title ",$$FMTE^XLFDT($$NOW^XLFDT)
+2 WRITE !,$$REPEAT^XLFSTR("-",79)
+3 QUIT
+4 ;
ACTION() ; -- select monitor action
+1 NEW X,CODES
+2 SET CODES="UTED"_$SELECT($GET(VPRTEST):"",1:"R")
A1 WRITE !,"Select monitor action: UPDATE// "
+1 READ X:DTIME
IF '$TEST!(X["^")
QUIT "^"
+2 IF X["?"
DO ACTHLP
GOTO A1
+3 if $LENGTH(X)
SET X=$$UP^XLFSTR($EXTRACT(X))
if X=""
SET X="U"
IF X="Q"
QUIT "^"
+4 IF CODES'[X
WRITE $CHAR(7)," ??",!
GOTO A1
+5 QUIT X
ACTHLP ; -- show choices
+1 WRITE !!?5,"Enter <RETURN> to refresh the monitor display."
+2 WRITE !?5,"Enter Q to exit the monitor."
+3 WRITE !?5,"Enter T to display the task."
+4 if '$GET(VPRTEST)
WRITE !?5,"Enter R to re-queue the transmission task."
+5 WRITE !?5,"Enter E to display the Encounter list."
+6 WRITE !?5,"Enter D to display the Document list."
+7 WRITE !?5,"Enter ? to see this message.",!
+8 QUIT
+9 ;
BANNER ; -- banner(s) for mgt menu
+1 IF '$$ON^VPRHS
IF $$PROD^XUPROD
WRITE !!,$CHAR(7),">> WARNING -- DATA MONITORING IS NOT ENABLED!!"
+2 NEW ZTSK,STS
SET ZTSK=$GET(^XTMP("VPRPX","ZTSK"))
IF ZTSK
Begin DoDot:1
+3 DO ISQED^%ZTLOAD
SET STS=$GET(ZTSK(0))
+4 IF 'STS
WRITE !!,">> WARNING -- VPR ENCOUNTER TASK IS NOT RUNNING!!"
End DoDot:1
+5 QUIT
