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 | ;
|
---|