| 1 | PXRMEXCS ; SLC/PKR - Routines to compute checksums. ;12/21/2004
|
|---|
| 2 | ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
|
|---|
| 3 | ;====================================================
|
|---|
| 4 | FILE(FILENUM,IEN) ;Return checksum for entry IEN in file FILENUM.
|
|---|
| 5 | N CS,LC,REF,ROOT,TARGET
|
|---|
| 6 | D FILE^DID(FILENUM,"","GLOBAL NAME","TARGET")
|
|---|
| 7 | S ROOT=$$CREF^DILF(TARGET("GLOBAL NAME"))
|
|---|
| 8 | K ^TMP($J,"PXRMEXCS")
|
|---|
| 9 | M ^TMP($J,"PXRMEXCS")=@ROOT@(IEN)
|
|---|
| 10 | S REF="^TMP($J,""PXRMEXCS"")"
|
|---|
| 11 | S REF=$NA(@REF)
|
|---|
| 12 | S (CS,LC)=0
|
|---|
| 13 | F S REF=$Q(@REF) Q:REF'["PXRMEXCS" S LC=LC+1,CS=CS+$$LINECS(LC,@REF)
|
|---|
| 14 | K ^TMP($J,"PXRMEXCS")
|
|---|
| 15 | Q CS
|
|---|
| 16 | ;
|
|---|
| 17 | ;====================================================
|
|---|
| 18 | HFCS(PATH,FILENAME) ;Return checksum for host file.
|
|---|
| 19 | N CS,GBL,GBLZISH,SUCCESS
|
|---|
| 20 | K ^TMP($J,"PXRMHFCS")
|
|---|
| 21 | S GBL="^TMP($J,""PXRMHFCS"")"
|
|---|
| 22 | S GBLZISH="^TMP($J,""PXRMHFCS"",1)"
|
|---|
| 23 | S GBLZISH=$NA(@GBLZISH)
|
|---|
| 24 | S SUCCESS=$$FTG^%ZISH(PATH,FILENAME,GBLZISH,3)
|
|---|
| 25 | S CS=$S(SUCCESS:$$HFCSGBL(GBL),1:-1)
|
|---|
| 26 | K ^TMP($J,"PXRMHFCS")
|
|---|
| 27 | Q CS
|
|---|
| 28 | ;
|
|---|
| 29 | ;====================================================
|
|---|
| 30 | HFCSGBL(GBL) ;Return checksum for host file loaded into global GBL.
|
|---|
| 31 | N CS,IND,LINE
|
|---|
| 32 | S (CS,IND)=0
|
|---|
| 33 | F S IND=$O(@GBL@(IND)) Q:+IND=0 S LINE=@GBL@(IND),CS=CS+$$LINECS(IND,LINE)
|
|---|
| 34 | Q CS
|
|---|
| 35 | ;
|
|---|
| 36 | ;====================================================
|
|---|
| 37 | LINECS(LINENUM,STRING) ;Return checksum of line number LINEUM whose contents
|
|---|
| 38 | ;is STRING.
|
|---|
| 39 | N CS,IND,LEN
|
|---|
| 40 | S CS=0
|
|---|
| 41 | S LEN=$L(STRING)
|
|---|
| 42 | F IND=1:1:LEN S CS=CS+($A(STRING,IND)*(LINENUM+IND))
|
|---|
| 43 | Q CS
|
|---|
| 44 | ;
|
|---|
| 45 | ;====================================================
|
|---|
| 46 | MMCS(XMZ) ;Return checksum for MailMan message ien XMZ.
|
|---|
| 47 | N CS,IND,LINE,NLINES
|
|---|
| 48 | S NLINES=+$P($G(^XMB(3.9,XMZ,2,0)),U,3)
|
|---|
| 49 | S CS=0
|
|---|
| 50 | F IND=1:1:NLINES S LINE=$G(^XMB(3.9,XMZ,2,IND,0)),CS=CS+$$LINECS(IND,LINE)
|
|---|
| 51 | Q CS
|
|---|
| 52 | ;
|
|---|
| 53 | ;====================================================
|
|---|
| 54 | ROUTINE(RA) ;Return checksum for a routine loaded in array RA. RA has the
|
|---|
| 55 | ;form created by ^%ZOSF("LOAD") i.e, RA(1,0) ... RA(N,0).
|
|---|
| 56 | N CS,IND,LINE
|
|---|
| 57 | S (CS,IND)=0
|
|---|
| 58 | F S IND=$O(RA(IND)) Q:+IND=0 S CS=CS+$$LINECS(IND,RA(IND,0))
|
|---|
| 59 | Q CS
|
|---|
| 60 | ;
|
|---|
| 61 | ;====================================================
|
|---|
| 62 | RTN(ROUTINE) ;Return checksum for a routine ROUTINE.
|
|---|
| 63 | N CS,DIF,RA,X,XCNP
|
|---|
| 64 | S XCNP=0
|
|---|
| 65 | S DIF="RA("
|
|---|
| 66 | S X=ROUTINE
|
|---|
| 67 | ;Make sure the routine exists.
|
|---|
| 68 | X ^%ZOSF("TEST")
|
|---|
| 69 | I $T D
|
|---|
| 70 | . X ^%ZOSF("LOAD")
|
|---|
| 71 | . S CS=$$ROUTINE(.RA)
|
|---|
| 72 | E S CS=-1
|
|---|
| 73 | Q CS
|
|---|
| 74 | ;
|
|---|
