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

PXRMEXCS.m

Go to the documentation of this file. 
  1. PXRMEXCS ; SLC/PKR - Routines to compute checksums. ;02/25/2016
  1.  ;;2.0;CLINICAL REMINDERS;**6,12,26,47**;Feb 04, 2005;Build 291
  1.  ;====================================================
  1. CHECKSUM(ATTR,START,END) ;Get the the checksum for a packed reminder
  1.  ;component and load it into the attribute array.
  1.  N CS,LINE
  1.  ;If checksum is in packed component return it otherwise calculate it.
  1.  I ATTR("FILE NUMBER")=0 D
  1.  . S LINE=^PXD(811.8,PXRMRIEN,100,START-3,0)
  1.  . S CS=$$GETTAGV^PXRMEXU3(LINE,"<CHECKSUM>")
  1.  . I CS="" S CS=$$PRTNCS(PXRMRIEN,START,END)
  1.  I ATTR("FILE NUMBER")>0 D
  1.  . S LINE=^PXD(811.8,PXRMRIEN,100,START-4,0)
  1.  . S CS=$$GETTAGV^PXRMEXU3(LINE,"<CHECKSUM>")
  1.  . I CS="" S CS=$$PFDACS(PXRMRIEN,START,END)
  1.  S ATTR("CHECKSUM")=CS
  1.  Q
  1.  ;
  1.  ;====================================================
  1. DIQOUTCS(DIQOUT) ;Return checksum for a processed DIQOUT array.
  1.  N CS,DATA,EHCL,FIELD,FNUM,IENS,IND,SFN,STRING,TARGET,TEXT,WP
  1.  S FNUM=$O(DIQOUT(""))
  1.  ;Ignore the EDIT HISTORY / CHANGE LOG
  1.  S EHCL=$S(FNUM=811.2:"CHANGE LOG",1:"EDIT HISTORY")
  1.  D FIELD^DID(FNUM,EHCL,"","SPECIFIER","TARGET")
  1.  S SFN=+$G(TARGET("SPECIFIER"))
  1.  S (CS,FNUM)=0
  1.  F  S FNUM=$O(DIQOUT(FNUM)) Q:FNUM=""  D
  1.  . I FNUM=SFN Q
  1.  . S IENS=""
  1.  . F  S IENS=$O(DIQOUT(FNUM,IENS)) Q:IENS=""  D
  1.  .. S FIELD=0
  1.  .. F  S FIELD=$O(DIQOUT(FNUM,IENS,FIELD)) Q:FIELD=""  D
  1.  ... S DATA=DIQOUT(FNUM,IENS,FIELD)
  1.  ... S TEXT=FNUM_$L(IENS,",")_FIELD_DATA
  1.  ... S CS=$$CRC32^XLFCRC(TEXT,CS)
  1.  ... I DATA["WP-start" F IND=1:1:$P(DATA,"~",2) D
  1.  .... S TEXT=DIQOUT(FNUM,IENS,FIELD,IND)
  1.  .... S CS=$$CRC32^XLFCRC(TEXT,CS)
  1.  Q CS
  1.  ;
  1.  ;====================================================
  1. FILE(FILENUM,IEN) ;Return checksum for entry IEN in file FILENUM.
  1.  ;Make sure the entry exists.
  1.  I +$$FIND1^DIC(FILENUM,,"AU","`"_IEN)=0 Q 0
  1.  N CS,DIQOUT,IENROOT,MSG
  1.  D GETS^DIQ(FILENUM,IEN,"**","N","DIQOUT","MSG")
  1.  D CLDIQOUT^PXRMEXPD(FILENUM,IEN,"**",.IENROOT,.DIQOUT)
  1.  S CS=$$DIQOUTCS(.DIQOUT)
  1.  Q CS
  1.  ;
  1.  ;====================================================
  1. HFCS(PATH,FILENAME) ;Return checksum for host file.
  1.  N CS,GBL,GBLZISH,SUCCESS
  1.  K ^TMP($J,"PXRMHFCS")
  1.  S GBL="^TMP($J,""PXRMHFCS"")"
  1.  S GBLZISH="^TMP($J,""PXRMHFCS"",1)"
  1.  S GBLZISH=$NA(@GBLZISH)
  1.  S SUCCESS=$$FTG^%ZISH(PATH,FILENAME,GBLZISH,3)
  1.  S CS=$S(SUCCESS:$$HFCSGBL(GBL),1:-1)
  1.  K ^TMP($J,"PXRMHFCS")
  1.  Q CS
  1.  ;
  1.  ;====================================================
  1. HFCSGBL(GBL) ;Return checksum for host file loaded into global GBL.
  1.  N CS,IND,LINE
  1.  S (CS,IND)=0
  1.  F  S IND=$O(@GBL@(IND)) Q:+IND=0  S LINE=@GBL@(IND),CS=$$CRC32^XLFCRC(LINE,CS)
  1.  Q CS
  1.  ;
  1.  ;====================================================
  1. MMCS(XMZ) ;Return checksum for MailMan message ien XMZ.
  1.  N CS,IND,LINE,NLINES
  1.  S NLINES=+$P($G(^XMB(3.9,XMZ,2,0)),U,3)
  1.  S CS=0
  1.  F IND=1:1:NLINES S LINE=$G(^XMB(3.9,XMZ,2,IND,0)),CS=$$CRC32^XLFCRC(LINE,CS)
  1.  Q CS
  1.  ;
  1.  ;====================================================
  1. PFDACS(IEN,FDASTART,FDAEND) ;Return checksum for FDA array of packed
  1.  ;reminder component.
  1.  N CS,DATA,EHCL,IENS,IND,JND,FIELD,FNUM,SFN,TARGET,TEMP,TEXT
  1.  S TEMP=^PXD(811.8,IEN,100,FDASTART,0)
  1.  S FNUM=$P(TEMP,";",1)
  1.  ;Ignore the EDIT HISTORY / CHANGE LOG
  1.  S EHCL=$S(FNUM=811.2:"CHANGE LOG",1:"EDIT HISTORY")
  1.  D FIELD^DID(FNUM,EHCL,"","SPECIFIER","TARGET")
  1.  S SFN=+$G(TARGET("SPECIFIER"))
  1.  S CS=0
  1.  F IND=FDASTART:1:FDAEND D
  1.  . S TEMP=^PXD(811.8,IEN,100,IND,0)
  1.  . S DATA=$P(TEMP,"~",2,99)
  1.  . S TEMP=$P(TEMP,"~",1)
  1.  . S FNUM=$P(TEMP,";",1)
  1.  . I FNUM=SFN Q
  1.  . I FNUM="Exchange Stub" Q
  1.  . S IENS=$P(TEMP,";",2)
  1.  . S FIELD=$P(TEMP,";",3)
  1.  . S TEXT=FNUM_$L(IENS,",")_FIELD_DATA
  1.  . S CS=$$CRC32^XLFCRC(TEXT,CS)
  1.  . I DATA["WP-start" F JND=1:1:$P(DATA,"~",2) D
  1.  .. S IND=IND+1
  1.  .. S TEXT=^PXD(811.8,IEN,100,IND,0)
  1.  .. S CS=$$CRC32^XLFCRC(TEXT,CS)
  1.  Q CS
  1.  ;
  1.  ;====================================================
  1. 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).
  1.  N CS,IND,TEXT
  1.  S (CS,IND)=0
  1.  ;Get rid of the build number on the second line.
  1.  S RA(2,0)=$P(RA(2,0),";",1,6)
  1.  F  S IND=$O(RA(IND)) Q:+IND=0  D
  1.  . S TEXT=RA(IND,0)
  1.  . S CS=$$CRC32^XLFCRC(RA(IND,0),CS)
  1.  Q CS
  1.  ;
  1.  ;====================================================
  1. RTNCS(ROUTINE) ;Return checksum for a routine ROUTINE.
  1.  N CS,DIF,RA,X,XCNP
  1.  S XCNP=0
  1.  S DIF="RA("
  1.  S X=ROUTINE
  1.  ;Make sure the routine exists.
  1.  X ^%ZOSF("TEST")
  1.  I $T D
  1.  . X ^%ZOSF("LOAD")
  1.  . S CS=$$ROUTINE(.RA)
  1.  E  S CS=-1
  1.  Q CS
  1.  ;
  1.  ;====================================================
  1. PRTNCS(IEN,START,END) ;Return checksum for a packed routine.
  1.  N CS,IND,SL,TEXT
  1.  S CS=0,SL=START+1
  1.  F IND=START:1:END D
  1.  . S TEXT=^PXD(811.8,IEN,100,IND,0)
  1.  . ;Get rid of the build number on the second line.
  1.  . I IND=SL S TEXT=$P(TEXT,";",1,6)
  1.  . S CS=$$CRC32^XLFCRC(TEXT,CS)
  1.  Q CS
  1.  ;