PXRMEXCS ; SLC/PKR - Routines to compute checksums. ;02/25/2016
;;2.0;CLINICAL REMINDERS;**6,12,26,47**;Feb 04, 2005;Build 291
;====================================================
CHECKSUM(ATTR,START,END) ;Get the the checksum for a packed reminder
;component and load it into the attribute array.
N CS,LINE
;If checksum is in packed component return it otherwise calculate it.
I ATTR("FILE NUMBER")=0 D
. S LINE=^PXD(811.8,PXRMRIEN,100,START-3,0)
. S CS=$$GETTAGV^PXRMEXU3(LINE,"<CHECKSUM>")
. I CS="" S CS=$$PRTNCS(PXRMRIEN,START,END)
I ATTR("FILE NUMBER")>0 D
. S LINE=^PXD(811.8,PXRMRIEN,100,START-4,0)
. S CS=$$GETTAGV^PXRMEXU3(LINE,"<CHECKSUM>")
. I CS="" S CS=$$PFDACS(PXRMRIEN,START,END)
S ATTR("CHECKSUM")=CS
Q
;
;====================================================
DIQOUTCS(DIQOUT) ;Return checksum for a processed DIQOUT array.
N CS,DATA,EHCL,FIELD,FNUM,IENS,IND,SFN,STRING,TARGET,TEXT,WP
S FNUM=$O(DIQOUT(""))
;Ignore the EDIT HISTORY / CHANGE LOG
S EHCL=$S(FNUM=811.2:"CHANGE LOG",1:"EDIT HISTORY")
D FIELD^DID(FNUM,EHCL,"","SPECIFIER","TARGET")
S SFN=+$G(TARGET("SPECIFIER"))
S (CS,FNUM)=0
F S FNUM=$O(DIQOUT(FNUM)) Q:FNUM="" D
. I FNUM=SFN Q
. S IENS=""
. F S IENS=$O(DIQOUT(FNUM,IENS)) Q:IENS="" D
.. S FIELD=0
.. F S FIELD=$O(DIQOUT(FNUM,IENS,FIELD)) Q:FIELD="" D
... S DATA=DIQOUT(FNUM,IENS,FIELD)
... S TEXT=FNUM_$L(IENS,",")_FIELD_DATA
... S CS=$$CRC32^XLFCRC(TEXT,CS)
... I DATA["WP-start" F IND=1:1:$P(DATA,"~",2) D
.... S TEXT=DIQOUT(FNUM,IENS,FIELD,IND)
.... S CS=$$CRC32^XLFCRC(TEXT,CS)
Q CS
;
;====================================================
FILE(FILENUM,IEN) ;Return checksum for entry IEN in file FILENUM.
;Make sure the entry exists.
I +$$FIND1^DIC(FILENUM,,"AU","`"_IEN)=0 Q 0
N CS,DIQOUT,IENROOT,MSG
D GETS^DIQ(FILENUM,IEN,"**","N","DIQOUT","MSG")
D CLDIQOUT^PXRMEXPD(FILENUM,IEN,"**",.IENROOT,.DIQOUT)
S CS=$$DIQOUTCS(.DIQOUT)
Q CS
;
;====================================================
HFCS(PATH,FILENAME) ;Return checksum for host file.
N CS,GBL,GBLZISH,SUCCESS
K ^TMP($J,"PXRMHFCS")
S GBL="^TMP($J,""PXRMHFCS"")"
S GBLZISH="^TMP($J,""PXRMHFCS"",1)"
S GBLZISH=$NA(@GBLZISH)
S SUCCESS=$$FTG^%ZISH(PATH,FILENAME,GBLZISH,3)
S CS=$S(SUCCESS:$$HFCSGBL(GBL),1:-1)
K ^TMP($J,"PXRMHFCS")
Q CS
;
;====================================================
HFCSGBL(GBL) ;Return checksum for host file loaded into global GBL.
N CS,IND,LINE
S (CS,IND)=0
F S IND=$O(@GBL@(IND)) Q:+IND=0 S LINE=@GBL@(IND),CS=$$CRC32^XLFCRC(LINE,CS)
Q CS
;
;====================================================
MMCS(XMZ) ;Return checksum for MailMan message ien XMZ.
N CS,IND,LINE,NLINES
S NLINES=+$P($G(^XMB(3.9,XMZ,2,0)),U,3)
S CS=0
F IND=1:1:NLINES S LINE=$G(^XMB(3.9,XMZ,2,IND,0)),CS=$$CRC32^XLFCRC(LINE,CS)
Q CS
;
;====================================================
PFDACS(IEN,FDASTART,FDAEND) ;Return checksum for FDA array of packed
;reminder component.
N CS,DATA,EHCL,IENS,IND,JND,FIELD,FNUM,SFN,TARGET,TEMP,TEXT
S TEMP=^PXD(811.8,IEN,100,FDASTART,0)
S FNUM=$P(TEMP,";",1)
;Ignore the EDIT HISTORY / CHANGE LOG
S EHCL=$S(FNUM=811.2:"CHANGE LOG",1:"EDIT HISTORY")
D FIELD^DID(FNUM,EHCL,"","SPECIFIER","TARGET")
S SFN=+$G(TARGET("SPECIFIER"))
S CS=0
F IND=FDASTART:1:FDAEND D
. S TEMP=^PXD(811.8,IEN,100,IND,0)
. S DATA=$P(TEMP,"~",2,99)
. S TEMP=$P(TEMP,"~",1)
. S FNUM=$P(TEMP,";",1)
. I FNUM=SFN Q
. I FNUM="Exchange Stub" Q
. S IENS=$P(TEMP,";",2)
. S FIELD=$P(TEMP,";",3)
. S TEXT=FNUM_$L(IENS,",")_FIELD_DATA
. S CS=$$CRC32^XLFCRC(TEXT,CS)
. I DATA["WP-start" F JND=1:1:$P(DATA,"~",2) D
.. S IND=IND+1
.. S TEXT=^PXD(811.8,IEN,100,IND,0)
.. S CS=$$CRC32^XLFCRC(TEXT,CS)
Q CS
;
;====================================================
ROUTINE(RA) ;Return checksum for a routine loaded in array RA. RA has the
;form created by ^%ZOSF("LOAD") i.e, RA(1,0) ... RA(N,0).
N CS,IND,TEXT
S (CS,IND)=0
;Get rid of the build number on the second line.
S RA(2,0)=$P(RA(2,0),";",1,6)
F S IND=$O(RA(IND)) Q:+IND=0 D
. S TEXT=RA(IND,0)
. S CS=$$CRC32^XLFCRC(RA(IND,0),CS)
Q CS
;
;====================================================
RTNCS(ROUTINE) ;Return checksum for a routine ROUTINE.
N CS,DIF,RA,X,XCNP
S XCNP=0
S DIF="RA("
S X=ROUTINE
;Make sure the routine exists.
X ^%ZOSF("TEST")
I $T D
. X ^%ZOSF("LOAD")
. S CS=$$ROUTINE(.RA)
E S CS=-1
Q CS
;
;====================================================
PRTNCS(IEN,START,END) ;Return checksum for a packed routine.
N CS,IND,SL,TEXT
S CS=0,SL=START+1
F IND=START:1:END D
. S TEXT=^PXD(811.8,IEN,100,IND,0)
. ;Get rid of the build number on the second line.
. I IND=SL S TEXT=$P(TEXT,";",1,6)
. S CS=$$CRC32^XLFCRC(TEXT,CS)
Q CS
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMEXCS 4870 printed Oct 16, 2024@17:45:43 Page 2
PXRMEXCS ; SLC/PKR - Routines to compute checksums. ;02/25/2016
+1 ;;2.0;CLINICAL REMINDERS;**6,12,26,47**;Feb 04, 2005;Build 291
+2 ;====================================================
CHECKSUM(ATTR,START,END) ;Get the the checksum for a packed reminder
+1 ;component and load it into the attribute array.
+2 NEW CS,LINE
+3 ;If checksum is in packed component return it otherwise calculate it.
+4 IF ATTR("FILE NUMBER")=0
Begin DoDot:1
+5 SET LINE=^PXD(811.8,PXRMRIEN,100,START-3,0)
+6 SET CS=$$GETTAGV^PXRMEXU3(LINE,"<CHECKSUM>")
+7 IF CS=""
SET CS=$$PRTNCS(PXRMRIEN,START,END)
End DoDot:1
+8 IF ATTR("FILE NUMBER")>0
Begin DoDot:1
+9 SET LINE=^PXD(811.8,PXRMRIEN,100,START-4,0)
+10 SET CS=$$GETTAGV^PXRMEXU3(LINE,"<CHECKSUM>")
+11 IF CS=""
SET CS=$$PFDACS(PXRMRIEN,START,END)
End DoDot:1
+12 SET ATTR("CHECKSUM")=CS
+13 QUIT
+14 ;
+15 ;====================================================
DIQOUTCS(DIQOUT) ;Return checksum for a processed DIQOUT array.
+1 NEW CS,DATA,EHCL,FIELD,FNUM,IENS,IND,SFN,STRING,TARGET,TEXT,WP
+2 SET FNUM=$ORDER(DIQOUT(""))
+3 ;Ignore the EDIT HISTORY / CHANGE LOG
+4 SET EHCL=$SELECT(FNUM=811.2:"CHANGE LOG",1:"EDIT HISTORY")
+5 DO FIELD^DID(FNUM,EHCL,"","SPECIFIER","TARGET")
+6 SET SFN=+$GET(TARGET("SPECIFIER"))
+7 SET (CS,FNUM)=0
+8 FOR
SET FNUM=$ORDER(DIQOUT(FNUM))
if FNUM=""
QUIT
Begin DoDot:1
+9 IF FNUM=SFN
QUIT
+10 SET IENS=""
+11 FOR
SET IENS=$ORDER(DIQOUT(FNUM,IENS))
if IENS=""
QUIT
Begin DoDot:2
+12 SET FIELD=0
+13 FOR
SET FIELD=$ORDER(DIQOUT(FNUM,IENS,FIELD))
if FIELD=""
QUIT
Begin DoDot:3
+14 SET DATA=DIQOUT(FNUM,IENS,FIELD)
+15 SET TEXT=FNUM_$LENGTH(IENS,",")_FIELD_DATA
+16 SET CS=$$CRC32^XLFCRC(TEXT,CS)
+17 IF DATA["WP-start"
FOR IND=1:1:$PIECE(DATA,"~",2)
Begin DoDot:4
+18 SET TEXT=DIQOUT(FNUM,IENS,FIELD,IND)
+19 SET CS=$$CRC32^XLFCRC(TEXT,CS)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+20 QUIT CS
+21 ;
+22 ;====================================================
FILE(FILENUM,IEN) ;Return checksum for entry IEN in file FILENUM.
+1 ;Make sure the entry exists.
+2 IF +$$FIND1^DIC(FILENUM,,"AU","`"_IEN)=0
QUIT 0
+3 NEW CS,DIQOUT,IENROOT,MSG
+4 DO GETS^DIQ(FILENUM,IEN,"**","N","DIQOUT","MSG")
+5 DO CLDIQOUT^PXRMEXPD(FILENUM,IEN,"**",.IENROOT,.DIQOUT)
+6 SET CS=$$DIQOUTCS(.DIQOUT)
+7 QUIT CS
+8 ;
+9 ;====================================================
HFCS(PATH,FILENAME) ;Return checksum for host file.
+1 NEW CS,GBL,GBLZISH,SUCCESS
+2 KILL ^TMP($JOB,"PXRMHFCS")
+3 SET GBL="^TMP($J,""PXRMHFCS"")"
+4 SET GBLZISH="^TMP($J,""PXRMHFCS"",1)"
+5 SET GBLZISH=$NAME(@GBLZISH)
+6 SET SUCCESS=$$FTG^%ZISH(PATH,FILENAME,GBLZISH,3)
+7 SET CS=$SELECT(SUCCESS:$$HFCSGBL(GBL),1:-1)
+8 KILL ^TMP($JOB,"PXRMHFCS")
+9 QUIT CS
+10 ;
+11 ;====================================================
HFCSGBL(GBL) ;Return checksum for host file loaded into global GBL.
+1 NEW CS,IND,LINE
+2 SET (CS,IND)=0
+3 FOR
SET IND=$ORDER(@GBL@(IND))
if +IND=0
QUIT
SET LINE=@GBL@(IND)
SET CS=$$CRC32^XLFCRC(LINE,CS)
+4 QUIT CS
+5 ;
+6 ;====================================================
MMCS(XMZ) ;Return checksum for MailMan message ien XMZ.
+1 NEW CS,IND,LINE,NLINES
+2 SET NLINES=+$PIECE($GET(^XMB(3.9,XMZ,2,0)),U,3)
+3 SET CS=0
+4 FOR IND=1:1:NLINES
SET LINE=$GET(^XMB(3.9,XMZ,2,IND,0))
SET CS=$$CRC32^XLFCRC(LINE,CS)
+5 QUIT CS
+6 ;
+7 ;====================================================
PFDACS(IEN,FDASTART,FDAEND) ;Return checksum for FDA array of packed
+1 ;reminder component.
+2 NEW CS,DATA,EHCL,IENS,IND,JND,FIELD,FNUM,SFN,TARGET,TEMP,TEXT
+3 SET TEMP=^PXD(811.8,IEN,100,FDASTART,0)
+4 SET FNUM=$PIECE(TEMP,";",1)
+5 ;Ignore the EDIT HISTORY / CHANGE LOG
+6 SET EHCL=$SELECT(FNUM=811.2:"CHANGE LOG",1:"EDIT HISTORY")
+7 DO FIELD^DID(FNUM,EHCL,"","SPECIFIER","TARGET")
+8 SET SFN=+$GET(TARGET("SPECIFIER"))
+9 SET CS=0
+10 FOR IND=FDASTART:1:FDAEND
Begin DoDot:1
+11 SET TEMP=^PXD(811.8,IEN,100,IND,0)
+12 SET DATA=$PIECE(TEMP,"~",2,99)
+13 SET TEMP=$PIECE(TEMP,"~",1)
+14 SET FNUM=$PIECE(TEMP,";",1)
+15 IF FNUM=SFN
QUIT
+16 IF FNUM="Exchange Stub"
QUIT
+17 SET IENS=$PIECE(TEMP,";",2)
+18 SET FIELD=$PIECE(TEMP,";",3)
+19 SET TEXT=FNUM_$LENGTH(IENS,",")_FIELD_DATA
+20 SET CS=$$CRC32^XLFCRC(TEXT,CS)
+21 IF DATA["WP-start"
FOR JND=1:1:$PIECE(DATA,"~",2)
Begin DoDot:2
+22 SET IND=IND+1
+23 SET TEXT=^PXD(811.8,IEN,100,IND,0)
+24 SET CS=$$CRC32^XLFCRC(TEXT,CS)
End DoDot:2
End DoDot:1
+25 QUIT CS
+26 ;
+27 ;====================================================
ROUTINE(RA) ;Return checksum for a routine loaded in array RA. RA has the
+1 ;form created by ^%ZOSF("LOAD") i.e, RA(1,0) ... RA(N,0).
+2 NEW CS,IND,TEXT
+3 SET (CS,IND)=0
+4 ;Get rid of the build number on the second line.
+5 SET RA(2,0)=$PIECE(RA(2,0),";",1,6)
+6 FOR
SET IND=$ORDER(RA(IND))
if +IND=0
QUIT
Begin DoDot:1
+7 SET TEXT=RA(IND,0)
+8 SET CS=$$CRC32^XLFCRC(RA(IND,0),CS)
End DoDot:1
+9 QUIT CS
+10 ;
+11 ;====================================================
RTNCS(ROUTINE) ;Return checksum for a routine ROUTINE.
+1 NEW CS,DIF,RA,X,XCNP
+2 SET XCNP=0
+3 SET DIF="RA("
+4 SET X=ROUTINE
+5 ;Make sure the routine exists.
+6 XECUTE ^%ZOSF("TEST")
+7 IF $TEST
Begin DoDot:1
+8 XECUTE ^%ZOSF("LOAD")
+9 SET CS=$$ROUTINE(.RA)
End DoDot:1
+10 IF '$TEST
SET CS=-1
+11 QUIT CS
+12 ;
+13 ;====================================================
PRTNCS(IEN,START,END) ;Return checksum for a packed routine.
+1 NEW CS,IND,SL,TEXT
+2 SET CS=0
SET SL=START+1
+3 FOR IND=START:1:END
Begin DoDot:1
+4 SET TEXT=^PXD(811.8,IEN,100,IND,0)
+5 ;Get rid of the build number on the second line.
+6 IF IND=SL
SET TEXT=$PIECE(TEXT,";",1,6)
+7 SET CS=$$CRC32^XLFCRC(TEXT,CS)
End DoDot:1
+8 QUIT CS
+9 ;
