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

VPRHSX2.m

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