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

DG53558M.m

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