MAGVCHK ;WOIFO/EdM - Checksums of Imaging Routines ; 01/08/2007 10:39
;;3.0;IMAGING;**51,54**;03-July-2009;;Build 1424
;; Per VHA Directive 2004-038, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | The Food and Drug Administration classifies this software as |
;; | a medical device. As such, it may not be changed in any way. |
;; | Modifications to this software may result in an adulterated |
;; | medical device under 21CFR820, the use of which is considered |
;; | to be a violation of US Federal Statutes. |
;; +---------------------------------------------------------------+
;;
Q
; The entry below is called from ET-Phone-Home
;
GATEWAY(ZTSK,MAGDBB) ; RPC = MAG VISTA CHECKSUMS
N D0,X,ZTDESC,ZTDTH,ZTRTN,ZTSAVE
S ZTSK=0,D0=$O(^MAG(2006.1,0)) Q:'D0
Q:$G(MAGDBB)'["@" ; Must be valid e-mail address
L +^MAG(2006.1,"CHECKSUM"):10 Q:'$T ; Don't hold up other processing...
D:$G(^MAG(2006.1,D0,"LAST CHECKSUM"))<DT
. ;
. S ZTRTN="CHECK^"_$T(+0)
. S ZTDESC="Imaging Checksum Collection"
. S ZTDTH=$H ; Now!
. S ZTSAVE("MAGDBB")=MAGDBB
. D ^%ZTLOAD,HOME^%ZIS
. I '$D(ZTSK) S ZTSK=0 Q ; TaskMan did not Accept Request
. ; No matter how many sub-sites in the consolidated site,
. ; run this program only once per day:
. S D0=0 F S D0=$O(^MAG(2006.1,D0)) Q:'D0 S ^MAG(2006.1,D0,"LAST CHECKSUM")=DT
. Q
L -^MAG(2006.1,"CHECKSUM")
Q
;
CHECK ; Collect checksums for Imaging Routines
N CUR,I,MAGFM,R,SITE,X,XMERR,XMID,XMSUB,XMY,XMZ
Q:$G(MAGDBB)'["@" ; Must be valid e-mail address
D DT^DICRW
D
. N D1,D2,DATE,I,MAGDATA,MSG,N,PKG,PKT,PV
. S CUR=$$VERSION^XPDUTL("IMAGING")
. D LIST^DIC(9.7,,".01;2I;51I","K","*","MAG","MAG*","B",,,"MAGDATA","MSG")
. S I="" F S I=$O(MAGDATA("DILIST",2,I)) Q:I="" D
. . S I(+$G(MAGDATA("DILIST","ID",I,2)),I)=""
. . S X=$G(MAGDATA("DILIST","ID",I,.01)) Q:X=""
. . S D1=$G(MAGDATA("DILIST","ID",I,51)) Q:D1=""
. . S D2=$G(MAGDATA("DILIST","ID",I,2))
. . S CUR(X)=D1_"^"_D2
. . Q
. S N=0,DATE="" F S DATE=$O(I(DATE)) Q:DATE="" D
. . S I="" F S I=$O(I(DATE,I)) Q:I="" D
. . . S X=$G(MAGDATA("DILIST","ID",I,.01)) Q:$P(X,"*",2)'=CUR
. . . S PATCH=+$P(X,"*",3) Q:'PATCH
. . . K:$G(N(1,PATCH)) N(2,N(1,PATCH))
. . . S N=N+1,N(1,PATCH)=N,N(2,N)=PATCH
. . . S N(3,N)=$G(MAGDATA("DILIST","ID",I,51))
. . . Q
. . Q
. S CUR=CUR_";IMAGING;",I="**",X=""
. S N="" F S N=$O(N(2,N)) Q:N="" S CUR=CUR_I_N(2,N),X=N(3,N),I=","
. S:I'="**" CUR=CUR_"**"
. S:X'="" CUR=CUR_";"_$$FMDATE(X)
. Q
S SITE=0 S:$T(INST^XUPARAM)'="" SITE=$$KSP^XUPARAM("INST")
D:SITE FIND^DIC(4,"",.01,"A",SITE,"*",,,,"MAGFM")
S SITE=$G(MAGFM("DILIST",1,1)) S:SITE'="" SITE=SITE_" "
S SITE=SITE_"VistA System"
K ^TMP("MAG",$J,"CHECKSUM"),MAGFM
S I=0
K X D DOMAIN^MAGDRPC1(.X)
S I=I+1,^TMP("MAG",$J,"CHECKSUM",I)="SID="_X
S I=I+1,^TMP("MAG",$J,"CHECKSUM",I)="DT="_DT
S I=I+1,^TMP("MAG",$J,"CHECKSUM",I)="IP=VistA"
S I=I+1,^TMP("MAG",$J,"CHECKSUM",I)="BLD="_CUR
S CUR="" F S CUR=$O(CUR(CUR)) Q:CUR="" D
. S I=I+1,^TMP("MAG",$J,"CHECKSUM",I)="PAT="_CUR_"^"_CUR(CUR)
. Q
S I=I+1,^TMP("MAG",$J,"CHECKSUM",I)="TTL="_SITE
S I=I+1,^TMP("MAG",$J,"CHECKSUM",I)="PHY=VistA"
S R="MAG" F S R=$O(^$R(R)) Q:$E(R,1,3)'="MAG" D
. S I=I+1,^TMP("MAG",$J,"CHECKSUM",I)="RTN="_R
. S I=I+1,^TMP("MAG",$J,"CHECKSUM",I)="CHK="_$$CHK1(R)_"^"_$$CHK2(R)
. Q
S I=I+1,^TMP("MAG",$J,"CHECKSUM",I)=""
S XMSUB="Daily Report"
S XMID=$G(DUZ) S:'XMID XMID=.5
S XMY(XMID)=""
S XMY(MAGDBB)=""
D SENDMSG^XMXAPI(XMID,XMSUB,$NAME(^TMP("MAG",$J,"CHECKSUM")),.XMY,,.XMZ,)
I $G(XMERR) M XMERR=^TMP("XMERR",$J) S $EC=",U13-Cannot send MailMan message,"
K ^TMP("MAG",$J,"CHECKSUM")
Q
;
CHK1(R) N K,X,Y
S Y=0
F K=1:1 S X=$T(+K^@R) Q:X="" S:K'=2 Y=Y+$$C1(X)
Q Y
;
C1(X) N F,I,Y
S Y=0
S F=$F(X," "),F=$S($E(X,F)'=";":$L(X),$E(X,F+1)=";":$L(X),1:F-2)
F I=1:1:F S Y=$A(X,I)*I+Y
Q Y
;
CHK2(R) N K,X,Y
S Y=0
F K=1:1 S X=$T(+K^@R) Q:X="" S:K'=2 Y=Y+$$C2(X,K)
Q Y
;
C2(X,K) N F,I,Y
S Y=0
S F=$F(X," "),F=$S($E(X,F)'=";":$L(X),$E(X,F+1)=";":$L(X),1:F-2)
F I=1:1:F S Y=$A(X,I)*(I+K)+Y
Q Y
;
FMDATE(X) N D,M,Y
S X=X\1,D=X#100,M=X\100#100,Y=X\10000+1700
Q D_"-"_$P("January February March April May June July August September October November December"," ",M)_"-"_Y
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGVCHK 4851 printed Apr 09, 2024@21:06:53 Page 2
MAGVCHK ;WOIFO/EdM - Checksums of Imaging Routines ; 01/08/2007 10:39
+1 ;;3.0;IMAGING;**51,54**;03-July-2009;;Build 1424
+2 ;; Per VHA Directive 2004-038, this routine should not be modified.
+3 ;; +---------------------------------------------------------------+
+4 ;; | Property of the US Government. |
+5 ;; | No permission to copy or redistribute this software is given. |
+6 ;; | Use of unreleased versions of this software requires the user |
+7 ;; | to execute a written test agreement with the VistA Imaging |
+8 ;; | Development Office of the Department of Veterans Affairs, |
+9 ;; | telephone (301) 734-0100. |
+10 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 QUIT
+18 ; The entry below is called from ET-Phone-Home
+19 ;
GATEWAY(ZTSK,MAGDBB) ; RPC = MAG VISTA CHECKSUMS
+1 NEW D0,X,ZTDESC,ZTDTH,ZTRTN,ZTSAVE
+2 SET ZTSK=0
SET D0=$ORDER(^MAG(2006.1,0))
if 'D0
QUIT
+3 ; Must be valid e-mail address
if $GET(MAGDBB)'["@"
QUIT
+4 ; Don't hold up other processing...
LOCK +^MAG(2006.1,"CHECKSUM"):10
if '$TEST
QUIT
+5 if $GET(^MAG(2006.1,D0,"LAST CHECKSUM"))<DT
Begin DoDot:1
+6 ;
+7 SET ZTRTN="CHECK^"_$TEXT(+0)
+8 SET ZTDESC="Imaging Checksum Collection"
+9 ; Now!
SET ZTDTH=$HOROLOG
+10 SET ZTSAVE("MAGDBB")=MAGDBB
+11 DO ^%ZTLOAD
DO HOME^%ZIS
+12 ; TaskMan did not Accept Request
IF '$DATA(ZTSK)
SET ZTSK=0
QUIT
+13 ; No matter how many sub-sites in the consolidated site,
+14 ; run this program only once per day:
+15 SET D0=0
FOR
SET D0=$ORDER(^MAG(2006.1,D0))
if 'D0
QUIT
SET ^MAG(2006.1,D0,"LAST CHECKSUM")=DT
+16 QUIT
End DoDot:1
+17 LOCK -^MAG(2006.1,"CHECKSUM")
+18 QUIT
+19 ;
CHECK ; Collect checksums for Imaging Routines
+1 NEW CUR,I,MAGFM,R,SITE,X,XMERR,XMID,XMSUB,XMY,XMZ
+2 ; Must be valid e-mail address
if $GET(MAGDBB)'["@"
QUIT
+3 DO DT^DICRW
+4 Begin DoDot:1
+5 NEW D1,D2,DATE,I,MAGDATA,MSG,N,PKG,PKT,PV
+6 SET CUR=$$VERSION^XPDUTL("IMAGING")
+7 DO LIST^DIC(9.7,,".01;2I;51I","K","*","MAG","MAG*","B",,,"MAGDATA","MSG")
+8 SET I=""
FOR
SET I=$ORDER(MAGDATA("DILIST",2,I))
if I=""
QUIT
Begin DoDot:2
+9 SET I(+$GET(MAGDATA("DILIST","ID",I,2)),I)=""
+10 SET X=$GET(MAGDATA("DILIST","ID",I,.01))
if X=""
QUIT
+11 SET D1=$GET(MAGDATA("DILIST","ID",I,51))
if D1=""
QUIT
+12 SET D2=$GET(MAGDATA("DILIST","ID",I,2))
+13 SET CUR(X)=D1_"^"_D2
+14 QUIT
End DoDot:2
+15 SET N=0
SET DATE=""
FOR
SET DATE=$ORDER(I(DATE))
if DATE=""
QUIT
Begin DoDot:2
+16 SET I=""
FOR
SET I=$ORDER(I(DATE,I))
if I=""
QUIT
Begin DoDot:3
+17 SET X=$GET(MAGDATA("DILIST","ID",I,.01))
if $PIECE(X,"*",2)'=CUR
QUIT
+18 SET PATCH=+$PIECE(X,"*",3)
if 'PATCH
QUIT
+19 if $GET(N(1,PATCH))
KILL N(2,N(1,PATCH))
+20 SET N=N+1
SET N(1,PATCH)=N
SET N(2,N)=PATCH
+21 SET N(3,N)=$GET(MAGDATA("DILIST","ID",I,51))
+22 QUIT
End DoDot:3
+23 QUIT
End DoDot:2
+24 SET CUR=CUR_";IMAGING;"
SET I="**"
SET X=""
+25 SET N=""
FOR
SET N=$ORDER(N(2,N))
if N=""
QUIT
SET CUR=CUR_I_N(2,N)
SET X=N(3,N)
SET I=","
+26 if I'="**"
SET CUR=CUR_"**"
+27 if X'=""
SET CUR=CUR_";"_$$FMDATE(X)
+28 QUIT
End DoDot:1
+29 SET SITE=0
if $TEXT(INST^XUPARAM)'=""
SET SITE=$$KSP^XUPARAM("INST")
+30 if SITE
DO FIND^DIC(4,"",.01,"A",SITE,"*",,,,"MAGFM")
+31 SET SITE=$GET(MAGFM("DILIST",1,1))
if SITE'=""
SET SITE=SITE_" "
+32 SET SITE=SITE_"VistA System"
+33 KILL ^TMP("MAG",$JOB,"CHECKSUM"),MAGFM
+34 SET I=0
+35 KILL X
DO DOMAIN^MAGDRPC1(.X)
+36 SET I=I+1
SET ^TMP("MAG",$JOB,"CHECKSUM",I)="SID="_X
+37 SET I=I+1
SET ^TMP("MAG",$JOB,"CHECKSUM",I)="DT="_DT
+38 SET I=I+1
SET ^TMP("MAG",$JOB,"CHECKSUM",I)="IP=VistA"
+39 SET I=I+1
SET ^TMP("MAG",$JOB,"CHECKSUM",I)="BLD="_CUR
+40 SET CUR=""
FOR
SET CUR=$ORDER(CUR(CUR))
if CUR=""
QUIT
Begin DoDot:1
+41 SET I=I+1
SET ^TMP("MAG",$JOB,"CHECKSUM",I)="PAT="_CUR_"^"_CUR(CUR)
+42 QUIT
End DoDot:1
+43 SET I=I+1
SET ^TMP("MAG",$JOB,"CHECKSUM",I)="TTL="_SITE
+44 SET I=I+1
SET ^TMP("MAG",$JOB,"CHECKSUM",I)="PHY=VistA"
+45 SET R="MAG"
FOR
SET R=$ORDER(^$RANDOM(R))
if $EXTRACT(R,1,3)'="MAG"
QUIT
Begin DoDot:1
+46 SET I=I+1
SET ^TMP("MAG",$JOB,"CHECKSUM",I)="RTN="_R
+47 SET I=I+1
SET ^TMP("MAG",$JOB,"CHECKSUM",I)="CHK="_$$CHK1(R)_"^"_$$CHK2(R)
+48 QUIT
End DoDot:1
+49 SET I=I+1
SET ^TMP("MAG",$JOB,"CHECKSUM",I)=""
+50 SET XMSUB="Daily Report"
+51 SET XMID=$GET(DUZ)
if 'XMID
SET XMID=.5
+52 SET XMY(XMID)=""
+53 SET XMY(MAGDBB)=""
+54 DO SENDMSG^XMXAPI(XMID,XMSUB,$NAME(^TMP("MAG",$JOB,"CHECKSUM")),.XMY,,.XMZ,)
+55 IF $GET(XMERR)
MERGE XMERR=^TMP("XMERR",$JOB)
SET $ECODE=",U13-Cannot send MailMan message,"
+56 KILL ^TMP("MAG",$JOB,"CHECKSUM")
+57 QUIT
+58 ;
CHK1(R) NEW K,X,Y
+1 SET Y=0
+2 FOR K=1:1
SET X=$TEXT(+K^@R)
if X=""
QUIT
if K'=2
SET Y=Y+$$C1(X)
+3 QUIT Y
+4 ;
C1(X) NEW F,I,Y
+1 SET Y=0
+2 SET F=$FIND(X," ")
SET F=$SELECT($EXTRACT(X,F)'=";":$LENGTH(X),$EXTRACT(X,F+1)=";":$LENGTH(X),1:F-2)
+3 FOR I=1:1:F
SET Y=$ASCII(X,I)*I+Y
+4 QUIT Y
+5 ;
CHK2(R) NEW K,X,Y
+1 SET Y=0
+2 FOR K=1:1
SET X=$TEXT(+K^@R)
if X=""
QUIT
if K'=2
SET Y=Y+$$C2(X,K)
+3 QUIT Y
+4 ;
C2(X,K) NEW F,I,Y
+1 SET Y=0
+2 SET F=$FIND(X," ")
SET F=$SELECT($EXTRACT(X,F)'=";":$LENGTH(X),$EXTRACT(X,F+1)=";":$LENGTH(X),1:F-2)
+3 FOR I=1:1:F
SET Y=$ASCII(X,I)*(I+K)+Y
+4 QUIT Y
+5 ;
FMDATE(X) NEW D,M,Y
+1 SET X=X\1
SET D=X#100
SET M=X\100#100
SET Y=X\10000+1700
+2 QUIT D_"-"_$PIECE("January February March April May June July August September October November December"," ",M)_"-"_Y
+3 ;
