DG53558M ;ALB/GN - DG*5.3*558 CLEANUP UTILITES ; 7/16/04 11:14am
;;5.3;Registration;**558,579,688**;Aug 13, 1993;Build 29
;
;DG*53.*579 - add line for records modified vs. deleted ones
; Misc cleanup utilities
;
DELMT(IEN,DFN,PUR,DELETED,LINK) ; Kill duplicate MT
S DELETED=0
Q:'$G(IEN)
S TESTING=+$G(TESTING,1),DFN=$G(DFN)
S DELETED=$$DEL^DG53558M(IEN,.LINK,DFN)
Q:'DELETED
S PUR=PUR+1
I '$D(ZTQUEUED) W !,"Deleting Dupe IEN in 408.31 > ",IEN," for DFN > ",DFN
Q
;
DEL(IVMMTIEN,IVMLINK,DFN) ; delete 408.31 ien only, no income related files killed here
; input: ien to be deleted
; output: 1 = was deleted
; 0 = was not deleted
N DA,DIK,IVMTYP
S DFN=$G(DFN)
S IVMTYP=$P($G(^DGMT(408.31,IVMMTIEN,0)),"^",19) ;test type
S IVMLINK=$P($G(^DGMT(408.31,IVMMTIEN,2)),"^",6)
;don't delete copay test linked to valid means test directly
I IVMTYP=2,IVMLINK,$D(^DGMT(408.31,IVMLINK,0)) Q 0
;
S DA=IVMMTIEN,DIK="^DGMT(408.31," D:'$G(TESTING) ^DIK ;del MT here
D:DFN D4081275(DFN)
;
;delete linked RXCT here after above delete of the MT
I IVMTYP=1,IVMLINK D
. S DA=IVMLINK,DIK="^DGMT(408.31," D:'$G(TESTING) ^DIK
. D:DFN D4081275(DFN)
;
Q 1
;
D4081275(DFN) ; Deletes SPOUSE Effective date multiple entries that may exist
; and point to the MT just deleted.
;
Q:'$D(^DPT(DFN,0))
N R12,EIEN,ENODE,QUIT,DA,DIK
S R12=0
F S R12=$O(^DGPR(408.12,"B",DFN,R12)) Q:'R12 D
. Q:$P($G(^DGPR(408.12,R12,0)),"^",2)'=2 ;only process spouse
. ; drive through the Effective Date Multiple in ien reverse order
. S EIEN="A",QUIT=0
. F S EIEN=$O(^DGPR(408.12,R12,"E",EIEN),-1) Q:'EIEN D Q:QUIT
. . S ENODE=$G(^DGPR(408.12,R12,"E",EIEN,0))
. . Q:+$P(ENODE,"^",2) ;active flag
. . Q:'+$P(ENODE,"^",4) ;no MT ien
. . Q:$D(^DGMT(408.31,$P(ENODE,"^",4),0)) ;points to valid MT
. . ; if inactive and does not point to a valid MT, delete this
. . ; effective date multiple rec from 408.1275
. . S DA=EIEN,DA(1)=R12,DIK="^DGPR(408.12,"_DA(1)_",""E"","
. . D:'$G(TESTING) ^DIK
. . I '$D(ZTQUEUED) W !,"Deleting BAD 408.1275 > ",R12,",",EIEN
. . S QUIT=1
Q
;
MAIL ; mail stats
N BTIME,HTEXT,TEXT,NAMSPC,LIN,TYPNAM,MSGNO,IVMBAD,IVMPUR,IVMTOT,IVMPFL
S MSGNO=0
S NAMSPC=$$NAMSPC^DG53558
S IVMTOT=$P($G(^XTMP(NAMSPC,0,0)),U,2)
S IVMPUR=$P($G(^XTMP(NAMSPC,0,0)),U,3)
S BTIME=$P($G(^XTMP(NAMSPC,0,0)),U,4)
S STAT=$P($G(^XTMP(NAMSPC,0,0)),U,5)
S STIME=$P($G(^XTMP(NAMSPC,0,0)),U,6)
S IVMBAD=$P($G(^XTMP(NAMSPC,0,0)),U,7)
S IVMPFL=$P($G(^XTMP(NAMSPC,0,0)),U,8)
;
D HDNG(.HTEXT,.MSGNO,.LIN)
D SUMRY(.LIN)
D MAILIT(HTEXT)
;
D SNDDET
Q
;
HDNG(HTEXT,MSGNO,LIN) ;build heading lines for mail message
K ^TMP(NAMSPC,$J,"MSG")
S LIN=0
S HTEXT="Cleanup Dupes in the Means Test file "_STAT_" on "
S HTEXT=HTEXT_$$FMTE^XLFDT(STIME)
D BLDLINE(HTEXT,.LIN)
D BLDLINE("",.LIN)
I TESTING S TEXT="** TESTING **" D BLDLINE(TEXT,.LIN)
I MSGNO S TEXT="Message number: "_MSGNO D BLDLINE(TEXT,.LIN)
D BLDLINE("",.LIN)
I MSGNO D
. S TEXT="* = modified due to IVM Converted Test scenario"
. D BLDLINE(TEXT,.LIN) ;DG*5.3*579
S MSGNO=MSGNO+1
Q
;
SUMRY(LIN) ;build summary lines for mail message
S TEXT=" Records Processed: "_$J($FN(IVMTOT,","),11)
D BLDLINE(TEXT,.LIN)
S TEXT="Duplicate Tests Purged: "_$J($FN(IVMPUR,","),11)
D BLDLINE(TEXT,.LIN)
S TEXT=" Null Tests Purged: "_$J($FN(IVMBAD,","),11)
D BLDLINE(TEXT,.LIN)
S TEXT="Primary status changed: "_$J($FN(IVMPFL,","),11)
D BLDLINE(TEXT,.LIN)
D BLDLINE("",.LIN)
D BLDLINE("",.LIN)
D BLDLINE("",.LIN)
;
I (IVMPUR+IVMBAD+IVMPFL) D
. D BLDLINE("Detail changes to follow in subsequent mail messages.",.LIN)
Q
;
SNDDET ;build and send detail messages limit under 2000 lines each
N BAD,DATE,GL,MAXLIN,MORE,NAME,SSN,MTVER
S MAXLIN=1995,MORE=0
D HDNG(.HTEXT,.MSGNO,.LIN)
;
S GL=$NA(^XTMP(NAMSPC_".DET",1)),TYPNAM=""
F S GL=$Q(@GL) Q:GL="" Q:$QS(GL,1)'=(NAMSPC_".DET") D
. S MORE=1 ;at least 1 more line to send
. S DFN=$QS(GL,2)
. S ICDT=$QS(GL,3)
. S MTVER=$QS(GL,4)
. S MTIEN=$QS(GL,5)
. S BAD=$QS(GL,6)
. S SSN=$P($G(^DPT(DFN,0)),"^",9),NAME=$P($G(^DPT(DFN,0)),"^")
. S DATE=$$FMTE^XLFDT(ICDT)
. S TYPNAM=$G(@GL)
. S TEXT=$S(TYPNAM["PRIMARY":"* Prim> ",1:" Dupe> ")
. S:BAD="BAD" TEXT=" Null> "
. S TEXT=TEXT_"ssn: "_SSN_" "_$J(TYPNAM,22)_" date: "_DATE_" ien: "_MTIEN_" ver: "_+MTVER
. D BLDLINE(TEXT,.LIN)
. ;max lines reached, print a msg
. I LIN>MAXLIN D MAILIT(HTEXT),HDNG(.HTEXT,.MSGNO,.LIN) S MORE=0
;
;print final message if any to print
D MAILIT(HTEXT):MORE
Q
;
BLDLINE(TEXT,LIN) ;build a single line into TMP message global
S LIN=LIN+1
S ^TMP(NAMSPC,$J,"MSG",LIN)=TEXT
Q
MAILIT(HTEXT) ; send the mail message
N XMY,XMDUZ,XMSUB,XMTEXT
S XMY(DUZ)="",XMDUZ=.5
S XMSUB=HTEXT_" Results"
S XMTEXT="^TMP(NAMSPC,$J,""MSG"","
D ^XMD
Q
;
MONITOR ; Monitor job while running
N IOINORM,IOINHI,IOUON,IOUOFF,IOBON,IOBOFF,IORVON,IORVOFF,IOHOME
N IOELEOL,NAMSPC,REC,IVMTOT,IVMPUR,STIME,IVMEND,RUN,IVMTOTAL,IVMLST
N STAT,IVMLINE,IVMBLNK,NOWTIM,%H,DTOUT,I,IVMLEN,IVMQUIT,TITLE,TLEN,X
N NOWTIME,PCT,TMP
S:'$D(U) U="^"
S NAMSPC=$$NAMSPC^DG53558
S TMP=0 F IVMTOTAL=0:1 S TMP=$O(^DGMT(408.31,"C",TMP)) Q:'TMP
S IVMQUIT=0
D SCRNSET
;
F D Q:IVMQUIT
. ;check lock status
. L +^XTMP(NAMSPC):0
. I '$T S RUN=1
. E S RUN=0
. L -^XTMP(NAMSPC)
. S REC=$G(^XTMP(NAMSPC,0,0))
. S STAT=$P(REC,U,5) S:STAT="" STAT="NOT RUNNING"
. S IVMLST=$P(REC,U,1),IVMTOT=$P(REC,U,2),IVMPUR=$P(REC,U,3)
. S STIME=$P(REC,U,6),IVMBAD=$P(REC,U,7)
. S:IVMTOTAL>0 PCT=IVMTOT/IVMTOTAL
. S PCT=PCT*100
. S NOWTIME=$$NOW^XLFDT
. I (RUN&(STAT'="RUNNING"))!('RUN&(STAT="RUNNING")) D
. . S STAT="ERRORED"
. D CLRSCR
. S $P(IVMBLNK," ",81)=""
. S IVMLINE=IVMBLNK
. S TITLE="Cleanup Duplicates in the Means Test file"
. S TLEN=(80-$L(TITLE)\2)
. W $$FMTE^XLFDT($$NOW^XLFDT,"2P")
. W ?65,"Completed ",$FN(PCT,"",0),"%",!!
. W ?TLEN,IOINHI,IOUON,TITLE,IOUOFF,IOINORM,!
. S IVMLINE=IVMBLNK
. S IVMLINE=$$FMTLINE(IVMLINE,4,"Status")
. S IVMLINE=$$FMTLINE(IVMLINE,12,"Total recs")
. S IVMLINE=$$FMTLINE(IVMLINE,24,"Dupes Purged")
. S IVMLINE=$$FMTLINE(IVMLINE,38,"Nulls Purged")
. S IVMLINE=$$FMTLINE(IVMLINE,52,"Last DFN")
. S IVMLINE=$$FMTLINE(IVMLINE,66,"Completed Time")
. W !!,IORVON,IVMLINE,IORVOFF
. S IVMLINE=IVMBLNK
. S IVMLINE=$$FMTLINE(IVMLINE,2,STAT)
. S IVMLINE=$$FMTLINE(IVMLINE,15,IVMTOT)
. S IVMLINE=$$FMTLINE(IVMLINE,28,IVMPUR)
. S IVMLINE=$$FMTLINE(IVMLINE,40,IVMBAD)
. S IVMLINE=$$FMTLINE(IVMLINE,52,IVMLST)
. S IVMLINE=$$FMTLINE(IVMLINE,64,$$FMTE^XLFDT(STIME,2))
. W !,IVMLINE
. S IVMLINE=IVMBLNK
. W !,IVMLINE,!!!!!!
. K DIR
. S DIR("T")=5
. W ?13,"screen refreshes automatically every "_DIR("T")_" seconds",!
. W !!,"Press "_IORVON_"<Enter>"_IORVOFF_" to Stop Monitor...",!
. S DIR(0)="EA"
. D ^DIR
. I '$D(DTOUT) S IVMQUIT=1
. I STAT'="RUNNING" S IVMQUIT=1
W @IOF
Q
;
FMTLINE(IVMLINE,IVMTB,IVMTX) ; format a line
S IVMLEN=$L(IVMTX)
S IVMEND=IVMTB+IVMLEN-1
S $E(IVMLINE,IVMTB,IVMEND)=IVMTX
Q IVMLINE
;
SCRNSET ; setup screen variables
S:'$D(IOST(0)) IOST(0)="C-VT320"
S X="IOINORM;IOINHI;IOUON;IOUOFF;IOBON;IOBOFF;IORVON;IORVOFF;IOHOME"
S X=X_";IOELEOL" D ENDR^%ZISS
Q
;
CLRSCR ; clear screen and return to normal
W IOHOME,IORVOFF,IOBOFF,IOUOFF,IOINORM,@IOF
S $X=0,$Y=0
Q
;
SETUPX(EXPDAY) ;Setup XTMP's according to standards and set expiration days
N BEGTIME,PURGDT,NAMSPC
S NAMSPC=$$NAMSPC^DG53558
S BEGTIME=$$NOW^XLFDT()
S PURGDT=$$FMADD^XLFDT(BEGTIME,EXPDAY)
S ^XTMP(NAMSPC,0)=PURGDT_U_BEGTIME
S $P(^XTMP(NAMSPC,0),U,3)="Cleanup Duplicate Means Test File"
S ^XTMP(NAMSPC_".DET",0)=PURGDT_U_BEGTIME
S $P(^XTMP(NAMSPC_".DET",0),U,3)="Cleanup Duplicate Means Test File detail"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53558M 8065 printed Nov 22, 2024@17:47:48 Page 2
DG53558M ;ALB/GN - DG*5.3*558 CLEANUP UTILITES ; 7/16/04 11:14am
+1 ;;5.3;Registration;**558,579,688**;Aug 13, 1993;Build 29
+2 ;
+3 ;DG*53.*579 - add line for records modified vs. deleted ones
+4 ; Misc cleanup utilities
+5 ;
DELMT(IEN,DFN,PUR,DELETED,LINK) ; Kill duplicate MT
+1 SET DELETED=0
+2 if '$GET(IEN)
QUIT
+3 SET TESTING=+$GET(TESTING,1)
SET DFN=$GET(DFN)
+4 SET DELETED=$$DEL^DG53558M(IEN,.LINK,DFN)
+5 if 'DELETED
QUIT
+6 SET PUR=PUR+1
+7 IF '$DATA(ZTQUEUED)
WRITE !,"Deleting Dupe IEN in 408.31 > ",IEN," for DFN > ",DFN
+8 QUIT
+9 ;
DEL(IVMMTIEN,IVMLINK,DFN) ; delete 408.31 ien only, no income related files killed here
+1 ; input: ien to be deleted
+2 ; output: 1 = was deleted
+3 ; 0 = was not deleted
+4 NEW DA,DIK,IVMTYP
+5 SET DFN=$GET(DFN)
+6 ;test type
SET IVMTYP=$PIECE($GET(^DGMT(408.31,IVMMTIEN,0)),"^",19)
+7 SET IVMLINK=$PIECE($GET(^DGMT(408.31,IVMMTIEN,2)),"^",6)
+8 ;don't delete copay test linked to valid means test directly
+9 IF IVMTYP=2
IF IVMLINK
IF $DATA(^DGMT(408.31,IVMLINK,0))
QUIT 0
+10 ;
+11 ;del MT here
SET DA=IVMMTIEN
SET DIK="^DGMT(408.31,"
if '$GET(TESTING)
DO ^DIK
+12 if DFN
DO D4081275(DFN)
+13 ;
+14 ;delete linked RXCT here after above delete of the MT
+15 IF IVMTYP=1
IF IVMLINK
Begin DoDot:1
+16 SET DA=IVMLINK
SET DIK="^DGMT(408.31,"
if '$GET(TESTING)
DO ^DIK
+17 if DFN
DO D4081275(DFN)
End DoDot:1
+18 ;
+19 QUIT 1
+20 ;
D4081275(DFN) ; Deletes SPOUSE Effective date multiple entries that may exist
+1 ; and point to the MT just deleted.
+2 ;
+3 if '$DATA(^DPT(DFN,0))
QUIT
+4 NEW R12,EIEN,ENODE,QUIT,DA,DIK
+5 SET R12=0
+6 FOR
SET R12=$ORDER(^DGPR(408.12,"B",DFN,R12))
if 'R12
QUIT
Begin DoDot:1
+7 ;only process spouse
if $PIECE($GET(^DGPR(408.12,R12,0)),"^",2)'=2
QUIT
+8 ; drive through the Effective Date Multiple in ien reverse order
+9 SET EIEN="A"
SET QUIT=0
+10 FOR
SET EIEN=$ORDER(^DGPR(408.12,R12,"E",EIEN),-1)
if 'EIEN
QUIT
Begin DoDot:2
+11 SET ENODE=$GET(^DGPR(408.12,R12,"E",EIEN,0))
+12 ;active flag
if +$PIECE(ENODE,"^",2)
QUIT
+13 ;no MT ien
if '+$PIECE(ENODE,"^",4)
QUIT
+14 ;points to valid MT
if $DATA(^DGMT(408.31,$PIECE(ENODE,"^",4),0))
QUIT
+15 ; if inactive and does not point to a valid MT, delete this
+16 ; effective date multiple rec from 408.1275
+17 SET DA=EIEN
SET DA(1)=R12
SET DIK="^DGPR(408.12,"_DA(1)_",""E"","
+18 if '$GET(TESTING)
DO ^DIK
+19 IF '$DATA(ZTQUEUED)
WRITE !,"Deleting BAD 408.1275 > ",R12,",",EIEN
+20 SET QUIT=1
End DoDot:2
if QUIT
QUIT
End DoDot:1
+21 QUIT
+22 ;
MAIL ; mail stats
+1 NEW BTIME,HTEXT,TEXT,NAMSPC,LIN,TYPNAM,MSGNO,IVMBAD,IVMPUR,IVMTOT,IVMPFL
+2 SET MSGNO=0
+3 SET NAMSPC=$$NAMSPC^DG53558
+4 SET IVMTOT=$PIECE($GET(^XTMP(NAMSPC,0,0)),U,2)
+5 SET IVMPUR=$PIECE($GET(^XTMP(NAMSPC,0,0)),U,3)
+6 SET BTIME=$PIECE($GET(^XTMP(NAMSPC,0,0)),U,4)
+7 SET STAT=$PIECE($GET(^XTMP(NAMSPC,0,0)),U,5)
+8 SET STIME=$PIECE($GET(^XTMP(NAMSPC,0,0)),U,6)
+9 SET IVMBAD=$PIECE($GET(^XTMP(NAMSPC,0,0)),U,7)
+10 SET IVMPFL=$PIECE($GET(^XTMP(NAMSPC,0,0)),U,8)
+11 ;
+12 DO HDNG(.HTEXT,.MSGNO,.LIN)
+13 DO SUMRY(.LIN)
+14 DO MAILIT(HTEXT)
+15 ;
+16 DO SNDDET
+17 QUIT
+18 ;
HDNG(HTEXT,MSGNO,LIN) ;build heading lines for mail message
+1 KILL ^TMP(NAMSPC,$JOB,"MSG")
+2 SET LIN=0
+3 SET HTEXT="Cleanup Dupes in the Means Test file "_STAT_" on "
+4 SET HTEXT=HTEXT_$$FMTE^XLFDT(STIME)
+5 DO BLDLINE(HTEXT,.LIN)
+6 DO BLDLINE("",.LIN)
+7 IF TESTING
SET TEXT="** TESTING **"
DO BLDLINE(TEXT,.LIN)
+8 IF MSGNO
SET TEXT="Message number: "_MSGNO
DO BLDLINE(TEXT,.LIN)
+9 DO BLDLINE("",.LIN)
+10 IF MSGNO
Begin DoDot:1
+11 SET TEXT="* = modified due to IVM Converted Test scenario"
+12 ;DG*5.3*579
DO BLDLINE(TEXT,.LIN)
End DoDot:1
+13 SET MSGNO=MSGNO+1
+14 QUIT
+15 ;
SUMRY(LIN) ;build summary lines for mail message
+1 SET TEXT=" Records Processed: "_$JUSTIFY($FNUMBER(IVMTOT,","),11)
+2 DO BLDLINE(TEXT,.LIN)
+3 SET TEXT="Duplicate Tests Purged: "_$JUSTIFY($FNUMBER(IVMPUR,","),11)
+4 DO BLDLINE(TEXT,.LIN)
+5 SET TEXT=" Null Tests Purged: "_$JUSTIFY($FNUMBER(IVMBAD,","),11)
+6 DO BLDLINE(TEXT,.LIN)
+7 SET TEXT="Primary status changed: "_$JUSTIFY($FNUMBER(IVMPFL,","),11)
+8 DO BLDLINE(TEXT,.LIN)
+9 DO BLDLINE("",.LIN)
+10 DO BLDLINE("",.LIN)
+11 DO BLDLINE("",.LIN)
+12 ;
+13 IF (IVMPUR+IVMBAD+IVMPFL)
Begin DoDot:1
+14 DO BLDLINE("Detail changes to follow in subsequent mail messages.",.LIN)
End DoDot:1
+15 QUIT
+16 ;
SNDDET ;build and send detail messages limit under 2000 lines each
+1 NEW BAD,DATE,GL,MAXLIN,MORE,NAME,SSN,MTVER
+2 SET MAXLIN=1995
SET MORE=0
+3 DO HDNG(.HTEXT,.MSGNO,.LIN)
+4 ;
+5 SET GL=$NAME(^XTMP(NAMSPC_".DET",1))
SET TYPNAM=""
+6 FOR
SET GL=$QUERY(@GL)
if GL=""
QUIT
if $QSUBSCRIPT(GL,1)'=(NAMSPC_".DET")
QUIT
Begin DoDot:1
+7 ;at least 1 more line to send
SET MORE=1
+8 SET DFN=$QSUBSCRIPT(GL,2)
+9 SET ICDT=$QSUBSCRIPT(GL,3)
+10 SET MTVER=$QSUBSCRIPT(GL,4)
+11 SET MTIEN=$QSUBSCRIPT(GL,5)
+12 SET BAD=$QSUBSCRIPT(GL,6)
+13 SET SSN=$PIECE($GET(^DPT(DFN,0)),"^",9)
SET NAME=$PIECE($GET(^DPT(DFN,0)),"^")
+14 SET DATE=$$FMTE^XLFDT(ICDT)
+15 SET TYPNAM=$GET(@GL)
+16 SET TEXT=$SELECT(TYPNAM["PRIMARY":"* Prim> ",1:" Dupe> ")
+17 if BAD="BAD"
SET TEXT=" Null> "
+18 SET TEXT=TEXT_"ssn: "_SSN_" "_$JUSTIFY(TYPNAM,22)_" date: "_DATE_" ien: "_MTIEN_" ver: "_+MTVER
+19 DO BLDLINE(TEXT,.LIN)
+20 ;max lines reached, print a msg
+21 IF LIN>MAXLIN
DO MAILIT(HTEXT)
DO HDNG(.HTEXT,.MSGNO,.LIN)
SET MORE=0
End DoDot:1
+22 ;
+23 ;print final message if any to print
+24 if MORE
DO MAILIT(HTEXT)
+25 QUIT
+26 ;
BLDLINE(TEXT,LIN) ;build a single line into TMP message global
+1 SET LIN=LIN+1
+2 SET ^TMP(NAMSPC,$JOB,"MSG",LIN)=TEXT
+3 QUIT
MAILIT(HTEXT) ; send the mail message
+1 NEW XMY,XMDUZ,XMSUB,XMTEXT
+2 SET XMY(DUZ)=""
SET XMDUZ=.5
+3 SET XMSUB=HTEXT_" Results"
+4 SET XMTEXT="^TMP(NAMSPC,$J,""MSG"","
+5 DO ^XMD
+6 QUIT
+7 ;
MONITOR ; Monitor job while running
+1 NEW IOINORM,IOINHI,IOUON,IOUOFF,IOBON,IOBOFF,IORVON,IORVOFF,IOHOME
+2 NEW IOELEOL,NAMSPC,REC,IVMTOT,IVMPUR,STIME,IVMEND,RUN,IVMTOTAL,IVMLST
+3 NEW STAT,IVMLINE,IVMBLNK,NOWTIM,%H,DTOUT,I,IVMLEN,IVMQUIT,TITLE,TLEN,X
+4 NEW NOWTIME,PCT,TMP
+5 if '$DATA(U)
SET U="^"
+6 SET NAMSPC=$$NAMSPC^DG53558
+7 SET TMP=0
FOR IVMTOTAL=0:1
SET TMP=$ORDER(^DGMT(408.31,"C",TMP))
if 'TMP
QUIT
+8 SET IVMQUIT=0
+9 DO SCRNSET
+10 ;
+11 FOR
Begin DoDot:1
+12 ;check lock status
+13 LOCK +^XTMP(NAMSPC):0
+14 IF '$TEST
SET RUN=1
+15 IF '$TEST
SET RUN=0
+16 LOCK -^XTMP(NAMSPC)
+17 SET REC=$GET(^XTMP(NAMSPC,0,0))
+18 SET STAT=$PIECE(REC,U,5)
if STAT=""
SET STAT="NOT RUNNING"
+19 SET IVMLST=$PIECE(REC,U,1)
SET IVMTOT=$PIECE(REC,U,2)
SET IVMPUR=$PIECE(REC,U,3)
+20 SET STIME=$PIECE(REC,U,6)
SET IVMBAD=$PIECE(REC,U,7)
+21 if IVMTOTAL>0
SET PCT=IVMTOT/IVMTOTAL
+22 SET PCT=PCT*100
+23 SET NOWTIME=$$NOW^XLFDT
+24 IF (RUN&(STAT'="RUNNING"))!('RUN&(STAT="RUNNING"))
Begin DoDot:2
+25 SET STAT="ERRORED"
End DoDot:2
+26 DO CLRSCR
+27 SET $PIECE(IVMBLNK," ",81)=""
+28 SET IVMLINE=IVMBLNK
+29 SET TITLE="Cleanup Duplicates in the Means Test file"
+30 SET TLEN=(80-$LENGTH(TITLE)\2)
+31 WRITE $$FMTE^XLFDT($$NOW^XLFDT,"2P")
+32 WRITE ?65,"Completed ",$FNUMBER(PCT,"",0),"%",!!
+33 WRITE ?TLEN,IOINHI,IOUON,TITLE,IOUOFF,IOINORM,!
+34 SET IVMLINE=IVMBLNK
+35 SET IVMLINE=$$FMTLINE(IVMLINE,4,"Status")
+36 SET IVMLINE=$$FMTLINE(IVMLINE,12,"Total recs")
+37 SET IVMLINE=$$FMTLINE(IVMLINE,24,"Dupes Purged")
+38 SET IVMLINE=$$FMTLINE(IVMLINE,38,"Nulls Purged")
+39 SET IVMLINE=$$FMTLINE(IVMLINE,52,"Last DFN")
+40 SET IVMLINE=$$FMTLINE(IVMLINE,66,"Completed Time")
+41 WRITE !!,IORVON,IVMLINE,IORVOFF
+42 SET IVMLINE=IVMBLNK
+43 SET IVMLINE=$$FMTLINE(IVMLINE,2,STAT)
+44 SET IVMLINE=$$FMTLINE(IVMLINE,15,IVMTOT)
+45 SET IVMLINE=$$FMTLINE(IVMLINE,28,IVMPUR)
+46 SET IVMLINE=$$FMTLINE(IVMLINE,40,IVMBAD)
+47 SET IVMLINE=$$FMTLINE(IVMLINE,52,IVMLST)
+48 SET IVMLINE=$$FMTLINE(IVMLINE,64,$$FMTE^XLFDT(STIME,2))
+49 WRITE !,IVMLINE
+50 SET IVMLINE=IVMBLNK
+51 WRITE !,IVMLINE,!!!!!!
+52 KILL DIR
+53 SET DIR("T")=5
+54 WRITE ?13,"screen refreshes automatically every "_DIR("T")_" seconds",!
+55 WRITE !!,"Press "_IORVON_"<Enter>"_IORVOFF_" to Stop Monitor...",!
+56 SET DIR(0)="EA"
+57 DO ^DIR
+58 IF '$DATA(DTOUT)
SET IVMQUIT=1
+59 IF STAT'="RUNNING"
SET IVMQUIT=1
End DoDot:1
if IVMQUIT
QUIT
+60 WRITE @IOF
+61 QUIT
+62 ;
FMTLINE(IVMLINE,IVMTB,IVMTX) ; format a line
+1 SET IVMLEN=$LENGTH(IVMTX)
+2 SET IVMEND=IVMTB+IVMLEN-1
+3 SET $EXTRACT(IVMLINE,IVMTB,IVMEND)=IVMTX
+4 QUIT IVMLINE
+5 ;
SCRNSET ; setup screen variables
+1 if '$DATA(IOST(0))
SET IOST(0)="C-VT320"
+2 SET X="IOINORM;IOINHI;IOUON;IOUOFF;IOBON;IOBOFF;IORVON;IORVOFF;IOHOME"
+3 SET X=X_";IOELEOL"
DO ENDR^%ZISS
+4 QUIT
+5 ;
CLRSCR ; clear screen and return to normal
+1 WRITE IOHOME,IORVOFF,IOBOFF,IOUOFF,IOINORM,@IOF
+2 SET $X=0
SET $Y=0
+3 QUIT
+4 ;
SETUPX(EXPDAY) ;Setup XTMP's according to standards and set expiration days
+1 NEW BEGTIME,PURGDT,NAMSPC
+2 SET NAMSPC=$$NAMSPC^DG53558
+3 SET BEGTIME=$$NOW^XLFDT()
+4 SET PURGDT=$$FMADD^XLFDT(BEGTIME,EXPDAY)
+5 SET ^XTMP(NAMSPC,0)=PURGDT_U_BEGTIME
+6 SET $PIECE(^XTMP(NAMSPC,0),U,3)="Cleanup Duplicate Means Test File"
+7 SET ^XTMP(NAMSPC_".DET",0)=PURGDT_U_BEGTIME
+8 SET $PIECE(^XTMP(NAMSPC_".DET",0),U,3)="Cleanup Duplicate Means Test File detail"
+9 QUIT
