- 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 Jan 18, 2025@03:46:28 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