VPRHST2 ;OIT/CMF - Monitor SDA upload global ;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#
; ------------------- -----
; XLFDT 10103
; XLFSTR 10104
;
EN ; -- Monitor upload global, write results to screen
N DFN,TYPE
S DFN(0)=0,TYPE(0)=0
S DFN=$$PATIENT^VPRHST Q:$D(DUOUT)!$D(DTOUT) S:+DFN>0 DFN(0)=1
S TYPE=$$CONTNR^VPRHST Q:$D(DUOUT)!$D(DTOUT) S:TYPE'="" TYPE(0)=1
D RUN(.DFN,.TYPE)
Q
;
RUN(DFN,TYPE) ; -- display list
N VPR,I,J,K,X,Y,DIR,DUOUT,DTOUT,LCNT,DONE
;S VIEW=0,MAX=9999 ;$$TOTAL()
S DIR(0)="YA",DIR("B")="YES" ;,DIR("T")=5
S DIR("A")="Do you wish to continue to monitor the upload global? "
S DIR("?")="Enter YES to refresh the list, or NO to exit"
LOOP K VPR,I,J,K
M VPR=^VPR("AVPR")
D HDR S DONE=0
S I=0 F S I=$O(VPR(I)) Q:+I<1 D Q:DONE
. S J=+$O(VPR(I,0)) Q:(DFN(0)=1)&(J'=+DFN)
. S K=$P($G(VPR(I,J)),U,2) Q:(TYPE(0)=1)&(K'=TYPE)
. W !,I,?10,J,?20,VPR(I,J)
. S LCNT=LCNT+1 Q:LCNT#22
. W !!,"Press <return> to continue or ^ to exit ..."
. R X:DTIME I '$T!(X["^") S DONE=1 Q
. D HDR
W !!,"Current Sequence#: ",$G(^VPR(1,1))
D ^DIR
Q:'Y!$D(DUOUT)!$D(DTOUT)
G LOOP ;G:Y=1!($D(DTOUT))&(VIEW<MAX) LOOP
Q
;
HDR ; -- write header
;S VIEW=VIEW+1
W @IOF,"VPR Global Upload Monitor",?55,$$FMTE^XLFDT($$NOW^XLFDT)
W !,"SEQ",?10,"DFN",?20,$S(TYPE(0):TYPE,1:"All containers")
W " for "_$S(DFN(0):$P(DFN,U,2),1:"all patients")
W !,$$REPEAT^XLFSTR("-",79) S LCNT=3
;W !,$$FMTE^XLFDT($$NOW^XLFDT)_" View: "_VIEW_" of "_MAX_".",!
Q
;
TOTAL() ; -- select the max# of iterations
N X,Y,DIR,DUOUT,DTOUT
S DIR(0)="NAO^1:9999",DIR("A")="Select the maximum number of views to process: ",DIR("B")=9999
S DIR("?")="Enter the maximum number of iterations for the upload global to be read, up to 240"
D ^DIR S:$D(DTOUT) Y="^"
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPRHST2 2009 printed Sep 23, 2025@20:21:40 Page 2
VPRHST2 ;OIT/CMF - Monitor SDA upload global ;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 ; XLFDT 10103
+7 ; XLFSTR 10104
+8 ;
EN ; -- Monitor upload global, write results to screen
+1 NEW DFN,TYPE
+2 SET DFN(0)=0
SET TYPE(0)=0
+3 SET DFN=$$PATIENT^VPRHST
if $DATA(DUOUT)!$DATA(DTOUT)
QUIT
if +DFN>0
SET DFN(0)=1
+4 SET TYPE=$$CONTNR^VPRHST
if $DATA(DUOUT)!$DATA(DTOUT)
QUIT
if TYPE'=""
SET TYPE(0)=1
+5 DO RUN(.DFN,.TYPE)
+6 QUIT
+7 ;
RUN(DFN,TYPE) ; -- display list
+1 NEW VPR,I,J,K,X,Y,DIR,DUOUT,DTOUT,LCNT,DONE
+2 ;S VIEW=0,MAX=9999 ;$$TOTAL()
+3 ;,DIR("T")=5
SET DIR(0)="YA"
SET DIR("B")="YES"
+4 SET DIR("A")="Do you wish to continue to monitor the upload global? "
+5 SET DIR("?")="Enter YES to refresh the list, or NO to exit"
LOOP KILL VPR,I,J,K
+1 MERGE VPR=^VPR("AVPR")
+2 DO HDR
SET DONE=0
+3 SET I=0
FOR
SET I=$ORDER(VPR(I))
if +I<1
QUIT
Begin DoDot:1
+4 SET J=+$ORDER(VPR(I,0))
if (DFN(0)=1)&(J'=+DFN)
QUIT
+5 SET K=$PIECE($GET(VPR(I,J)),U,2)
if (TYPE(0)=1)&(K'=TYPE)
QUIT
+6 WRITE !,I,?10,J,?20,VPR(I,J)
+7 SET LCNT=LCNT+1
if LCNT#22
QUIT
+8 WRITE !!,"Press <return> to continue or ^ to exit ..."
+9 READ X:DTIME
IF '$TEST!(X["^")
SET DONE=1
QUIT
+10 DO HDR
End DoDot:1
if DONE
QUIT
+11 WRITE !!,"Current Sequence#: ",$GET(^VPR(1,1))
+12 DO ^DIR
+13 if 'Y!$DATA(DUOUT)!$DATA(DTOUT)
QUIT
+14 ;G:Y=1!($D(DTOUT))&(VIEW<MAX) LOOP
GOTO LOOP
+15 QUIT
+16 ;
HDR ; -- write header
+1 ;S VIEW=VIEW+1
+2 WRITE @IOF,"VPR Global Upload Monitor",?55,$$FMTE^XLFDT($$NOW^XLFDT)
+3 WRITE !,"SEQ",?10,"DFN",?20,$SELECT(TYPE(0):TYPE,1:"All containers")
+4 WRITE " for "_$SELECT(DFN(0):$PIECE(DFN,U,2),1:"all patients")
+5 WRITE !,$$REPEAT^XLFSTR("-",79)
SET LCNT=3
+6 ;W !,$$FMTE^XLFDT($$NOW^XLFDT)_" View: "_VIEW_" of "_MAX_".",!
+7 QUIT
+8 ;
TOTAL() ; -- select the max# of iterations
+1 NEW X,Y,DIR,DUOUT,DTOUT
+2 SET DIR(0)="NAO^1:9999"
SET DIR("A")="Select the maximum number of views to process: "
SET DIR("B")=9999
+3 SET DIR("?")="Enter the maximum number of iterations for the upload global to be read, up to 240"
+4 DO ^DIR
if $DATA(DTOUT)
SET Y="^"
+5 QUIT Y
