MPIFP41 ;;BIR/CML-MPI VISTA build post-init to search for bad ICN Checksums ;Jun 10, 2005
;;1.0; MASTER PATIENT INDEX VISTA ;**41**;30 Apr 99
;
EN ;
D BMES^XPDUTL("Post-init will look for patients with erroneous ICN Checksum values.")
;
S QUEDUZ=$S($G(DUZ)="":.5,1:DUZ)
S ZTSAVE("QUEDUZ")="",ZTRTN="QUE^MPIFP41",ZTDESC="MPI/PD - Search for Bad ICN Checksums",ZTIO="",ZTDTH=$$NOW^XLFDT D ^%ZTLOAD
I $D(ZTSK) D BMES^XPDUTL("Job was queued as Task #"_ZTSK_".")
;
QUIT ;
K ZTSK S:$D(ZTQUEUED) ZTREQ="@"
K QUEDUZ,ZTDESC,ZTIO,ZTREQ,ZTRTN,ZTSAVE,ZTDTH
Q
;
QUE ;entry point for background job
N ARR,CHKSUM,DA,DFN,DIFF,DR,ERRCNT,I,ICN,LTH,MPI,NODE,OLDSUM,SITENM,SITENUM,TXTCNT,START,STOP
S (ERRCNT,DFN)=0,START=$$NOW^XLFDT
F S DFN=$O(^DPT(DFN)) Q:'DFN S NODE=$G(^DPT(DFN,"MPI")) S ICN=$P(NODE,"^") I ICN D
.S CHKSUM=$$CHECKDG^MPIFSPC(ICN),OLDSUM=$P(NODE,"^",2)
.I +OLDSUM,$L(OLDSUM)'=6 S LTH=($L(OLDSUM)+1) F I=LTH:1:6 S OLDSUM="0"_OLDSUM
.I CHKSUM'=OLDSUM D
..S ERRCNT=ERRCNT+1,ARR(ICN)=CHKSUM_"^"_OLDSUM
..S DIE="^DPT(",DA=DFN,DR="991.02///^S X=CHKSUM" D ^DIE K DIE
;
;calculate run time
S STOP=$$NOW^XLFDT
S DIFF=($$FMDIFF^XLFDT(STOP,START,2))/3600
;
;send results back to MPI
N XMDUZ,XMSUB,SITENM,SITENUM,MPI,XMY,XMTEXT
S SITENM=$P($$SITE^VASITE,"^",2),SITENUM=$P($$SITE^VASITE,"^",3)
S XMDUZ="MPI AUSTIN"
S XMSUB="MPIF*1.0*41 Post Init - "_SITENUM_"/"_SITENM
S XMY("G.MPI POST INIT MONITOR@MPI-AUSTIN.DOMAIN.EXT")="",XMTEXT="MPI(1,"
S MPI(1,1)=SITENUM_"/"_SITENM_": (Run Time = "_$J(DIFF,5,2)_" hrs)"
S MPI(1,2)="Found "_ERRCNT_" patients with bad ICN checksums"_$S(ERRCNT>0:" -- all have been fixed.",1:".")
S MPI(1,3)=""
I ERRCNT>0 S MPI(1,4)="(ICN/GOOD CHECKSUM^CURRENT BAD CHECKSUM)"
S TXTCNT=4
S ICN=0 F S ICN=$O(ARR(ICN)) Q:'ICN S TXTCNT=TXTCNT+1,MPI(1,TXTCNT)=ICN_"/"_ARR(ICN)
D ^XMD
;send e-mail to local user who queued this job
N XMDUZ,XMSUB,MPI,XMY,XMTEXT
S XMDUZ="MPI AUSTIN"
S XMSUB="MPIF*1.0*41 Post Init Complete."
S XMY("`"_QUEDUZ_"@"_^XMB("NETNAME"))="",XMTEXT="MPI(1,"
S MPI(1,1)="Post Init for patch MPIF*1.0*41 has run to completion."
S MPI(1,2)="You should now delete routine ^MPIFP41."
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMPIFP41 2217 printed Apr 09, 2024@21:13:53 Page 2
MPIFP41 ;;BIR/CML-MPI VISTA build post-init to search for bad ICN Checksums ;Jun 10, 2005
+1 ;;1.0; MASTER PATIENT INDEX VISTA ;**41**;30 Apr 99
+2 ;
EN ;
+1 DO BMES^XPDUTL("Post-init will look for patients with erroneous ICN Checksum values.")
+2 ;
+3 SET QUEDUZ=$SELECT($GET(DUZ)="":.5,1:DUZ)
+4 SET ZTSAVE("QUEDUZ")=""
SET ZTRTN="QUE^MPIFP41"
SET ZTDESC="MPI/PD - Search for Bad ICN Checksums"
SET ZTIO=""
SET ZTDTH=$$NOW^XLFDT
DO ^%ZTLOAD
+5 IF $DATA(ZTSK)
DO BMES^XPDUTL("Job was queued as Task #"_ZTSK_".")
+6 ;
QUIT ;
+1 KILL ZTSK
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 KILL QUEDUZ,ZTDESC,ZTIO,ZTREQ,ZTRTN,ZTSAVE,ZTDTH
+3 QUIT
+4 ;
QUE ;entry point for background job
+1 NEW ARR,CHKSUM,DA,DFN,DIFF,DR,ERRCNT,I,ICN,LTH,MPI,NODE,OLDSUM,SITENM,SITENUM,TXTCNT,START,STOP
+2 SET (ERRCNT,DFN)=0
SET START=$$NOW^XLFDT
+3 FOR
SET DFN=$ORDER(^DPT(DFN))
if 'DFN
QUIT
SET NODE=$GET(^DPT(DFN,"MPI"))
SET ICN=$PIECE(NODE,"^")
IF ICN
Begin DoDot:1
+4 SET CHKSUM=$$CHECKDG^MPIFSPC(ICN)
SET OLDSUM=$PIECE(NODE,"^",2)
+5 IF +OLDSUM
IF $LENGTH(OLDSUM)'=6
SET LTH=($LENGTH(OLDSUM)+1)
FOR I=LTH:1:6
SET OLDSUM="0"_OLDSUM
+6 IF CHKSUM'=OLDSUM
Begin DoDot:2
+7 SET ERRCNT=ERRCNT+1
SET ARR(ICN)=CHKSUM_"^"_OLDSUM
+8 SET DIE="^DPT("
SET DA=DFN
SET DR="991.02///^S X=CHKSUM"
DO ^DIE
KILL DIE
End DoDot:2
End DoDot:1
+9 ;
+10 ;calculate run time
+11 SET STOP=$$NOW^XLFDT
+12 SET DIFF=($$FMDIFF^XLFDT(STOP,START,2))/3600
+13 ;
+14 ;send results back to MPI
+15 NEW XMDUZ,XMSUB,SITENM,SITENUM,MPI,XMY,XMTEXT
+16 SET SITENM=$PIECE($$SITE^VASITE,"^",2)
SET SITENUM=$PIECE($$SITE^VASITE,"^",3)
+17 SET XMDUZ="MPI AUSTIN"
+18 SET XMSUB="MPIF*1.0*41 Post Init - "_SITENUM_"/"_SITENM
+19 SET XMY("G.MPI POST INIT MONITOR@MPI-AUSTIN.DOMAIN.EXT")=""
SET XMTEXT="MPI(1,"
+20 SET MPI(1,1)=SITENUM_"/"_SITENM_": (Run Time = "_$JUSTIFY(DIFF,5,2)_" hrs)"
+21 SET MPI(1,2)="Found "_ERRCNT_" patients with bad ICN checksums"_$SELECT(ERRCNT>0:" -- all have been fixed.",1:".")
+22 SET MPI(1,3)=""
+23 IF ERRCNT>0
SET MPI(1,4)="(ICN/GOOD CHECKSUM^CURRENT BAD CHECKSUM)"
+24 SET TXTCNT=4
+25 SET ICN=0
FOR
SET ICN=$ORDER(ARR(ICN))
if 'ICN
QUIT
SET TXTCNT=TXTCNT+1
SET MPI(1,TXTCNT)=ICN_"/"_ARR(ICN)
+26 DO ^XMD
+27 ;send e-mail to local user who queued this job
+28 NEW XMDUZ,XMSUB,MPI,XMY,XMTEXT
+29 SET XMDUZ="MPI AUSTIN"
+30 SET XMSUB="MPIF*1.0*41 Post Init Complete."
+31 SET XMY("`"_QUEDUZ_"@"_^XMB("NETNAME"))=""
SET XMTEXT="MPI(1,"
+32 SET MPI(1,1)="Post Init for patch MPIF*1.0*41 has run to completion."
+33 SET MPI(1,2)="You should now delete routine ^MPIFP41."
+34 DO ^XMD
+35 QUIT
