Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXCS.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXCS.m
r613 r623 1 PXRMEXCS ; SLC/PKR - Routines to compute checksums. ;07/27/2007 2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123 3 ;==================================================== 4 CHECKSUM(ATTR,START,END) ;Get the the checksum for a packed reminder 5 ;component and load it into the attribute array. 6 N CS,LINE 7 ;If checksum is in packed component return it otherwise calculate it. 8 I ATTR("FILE NUMBER")=0 D 9 . S LINE=^PXD(811.8,PXRMRIEN,100,START-3,0) 10 . S CS=$$GETTAGV^PXRMEXU3(LINE,"<CHECKSUM>") 11 . I CS="" S CS=$$PRTNCS(PXRMRIEN,START,END) 12 I ATTR("FILE NUMBER")>0 D 13 . S LINE=^PXD(811.8,PXRMRIEN,100,START-2,0) 14 . S CS=$$GETTAGV^PXRMEXU3(LINE,"<CHECKSUM>") 15 . I CS="" S CS=$$PFDACS(PXRMRIEN,START,END) 16 S ATTR("CHECKSUM")=CS 17 Q 18 ; 19 ;==================================================== 20 DIQOUTCS(DIQOUT) ;Return checksum for a processed DIQOUT array. 21 N CS,DATA,FIELD,FNUM,IENS,IND,SFN,STRING,TARGET,TEXT,WP 22 S FNUM=$O(DIQOUT("")) 23 D FIELD^DID(FNUM,"EDIT HISTORY","","SPECIFIER","TARGET") 24 S SFN=+$G(TARGET("SPECIFIER")) 25 S (CS,FNUM)=0 26 F S FNUM=$O(DIQOUT(FNUM)) Q:FNUM="" D 27 . I FNUM=SFN Q 28 . S IENS="" 29 . F S IENS=$O(DIQOUT(FNUM,IENS)) Q:IENS="" D 30 .. S FIELD=0 31 .. F S FIELD=$O(DIQOUT(FNUM,IENS,FIELD)) Q:FIELD="" D 32 ... S DATA=DIQOUT(FNUM,IENS,FIELD) 33 ... S TEXT=FNUM_$L(IENS,",")_FIELD_DATA 34 ... S CS=$$CRC32^XLFCRC(TEXT,CS) 35 ... I DATA["WP-start" F IND=1:1:$P(DATA,"~",2) D 36 .... S TEXT=DIQOUT(FNUM,IENS,FIELD,IND) 37 .... S CS=$$CRC32^XLFCRC(TEXT,CS) 38 Q CS 39 ; 40 ;==================================================== 41 FILE(FILENUM,IEN) ;Return checksum for entry IEN in file FILENUM. 42 N CS,DIQOUT,IENROOT,MSG 43 D GETS^DIQ(FILENUM,IEN,"**","N","DIQOUT","MSG") 44 ;Remove edit history from all reminder files. 45 D RMEH^PXRMEXPU(FILENUM,.DIQOUT,1) 46 ;Convert the iens to the FDA adding form. 47 D CONTOFDA^PXRMEXPU(.DIQOUT,.IENROOT) 48 S CS=$$DIQOUTCS(.DIQOUT) 49 Q CS 50 ; 51 ;==================================================== 52 HFCS(PATH,FILENAME) ;Return checksum for host file. 53 N CS,GBL,GBLZISH,SUCCESS 54 K ^TMP($J,"PXRMHFCS") 55 S GBL="^TMP($J,""PXRMHFCS"")" 56 S GBLZISH="^TMP($J,""PXRMHFCS"",1)" 57 S GBLZISH=$NA(@GBLZISH) 58 S SUCCESS=$$FTG^%ZISH(PATH,FILENAME,GBLZISH,3) 59 S CS=$S(SUCCESS:$$HFCSGBL(GBL),1:-1) 60 K ^TMP($J,"PXRMHFCS") 61 Q CS 62 ; 63 ;==================================================== 64 HFCSGBL(GBL) ;Return checksum for host file loaded into global GBL. 65 N CS,IND,LINE 66 S (CS,IND)=0 67 F S IND=$O(@GBL@(IND)) Q:+IND=0 S LINE=@GBL@(IND),CS=$$CRC32^XLFCRC(LINE,CS) 68 Q CS 69 ; 70 ;==================================================== 71 MMCS(XMZ) ;Return checksum for MailMan message ien XMZ. 72 N CS,IND,LINE,NLINES 73 S NLINES=+$P($G(^XMB(3.9,XMZ,2,0)),U,3) 74 S CS=0 75 F IND=1:1:NLINES S LINE=$G(^XMB(3.9,XMZ,2,IND,0)),CS=$$CRC32^XLFCRC(LINE,CS) 76 Q CS 77 ; 78 ;==================================================== 79 PFDACS(IEN,FDASTART,FDAEND) ;Return checksum for FDA array of packed 80 ;reminder component. 81 N CS,DATA,IENS,IND,JND,FIELD,FNUM,SFN,TARGET,TEMP,TEXT 82 S TEMP=^PXD(811.8,IEN,100,FDASTART,0) 83 S FNUM=$P(TEMP,";",1) 84 D FIELD^DID(FNUM,"EDIT HISTORY","","SPECIFIER","TARGET") 85 S SFN=+$G(TARGET("SPECIFIER")) 86 S CS=0 87 F IND=FDASTART:1:FDAEND D 88 . S TEMP=^PXD(811.8,IEN,100,IND,0) 89 . S DATA=$P(TEMP,"~",2,99) 90 . S TEMP=$P(TEMP,"~",1) 91 . S FNUM=$P(TEMP,";",1) 92 . I FNUM=SFN Q 93 . I FNUM="Exchange Stub" Q 94 . S IENS=$P(TEMP,";",2) 95 . S FIELD=$P(TEMP,";",3) 96 . S TEXT=FNUM_$L(IENS,",")_FIELD_DATA 97 . S CS=$$CRC32^XLFCRC(TEXT,CS) 98 . I DATA["WP-start" F JND=1:1:$P(DATA,"~",2) D 99 .. S IND=IND+1 100 .. S TEXT=^PXD(811.8,IEN,100,IND,0) 101 .. S CS=$$CRC32^XLFCRC(TEXT,CS) 102 Q CS 103 ; 104 ;==================================================== 105 ROUTINE(RA) ;Return checksum for a routine loaded in array RA. RA has the 106 ;form created by ^%ZOSF("LOAD") i.e, RA(1,0) ... RA(N,0). 107 N CS,IND,TEXT 108 S (CS,IND)=0 109 ;Get rid of the build number on the second line. 110 S RA(2,0)=$P(RA(2,0),";",1,6) 111 F S IND=$O(RA(IND)) Q:+IND=0 D 112 . S TEXT=RA(IND,0) 113 . S CS=$$CRC32^XLFCRC(RA(IND,0),CS) 114 Q CS 115 ; 116 ;==================================================== 117 RTNCS(ROUTINE) ;Return checksum for a routine ROUTINE. 118 N CS,DIF,RA,X,XCNP 119 S XCNP=0 120 S DIF="RA(" 121 S X=ROUTINE 122 ;Make sure the routine exists. 123 X ^%ZOSF("TEST") 124 I $T D 125 . X ^%ZOSF("LOAD") 126 . S CS=$$ROUTINE(.RA) 127 E S CS=-1 128 Q CS 129 ; 130 ;==================================================== 131 PRTNCS(IEN,START,END) ;Return checksum for a packed routine. 132 N CS,IND,SL,TEXT 133 S CS=0,SL=START+1 134 F IND=START:1:END D 135 . S TEXT=^PXD(811.8,IEN,100,IND,0) 136 . ;Get rid of the build number on the second line. 137 . I IND=SL S TEXT=$P(TEXT,";",1,6) 138 . S CS=$$CRC32^XLFCRC(TEXT,CS) 139 Q CS 140 ; 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 ;
Note:
See TracChangeset
for help on using the changeset viewer.
