source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXCS.m@ 619

Last change on this file since 619 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.5 KB
RevLine 
[613]1PXRMEXCS ; SLC/PKR - Routines to compute checksums. ;07/27/2007
2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
3 ;====================================================
4CHECKSUM(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 ;====================================================
20DIQOUTCS(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 ;====================================================
41FILE(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 ;====================================================
52HFCS(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 ;====================================================
64HFCSGBL(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 ;====================================================
71MMCS(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 ;====================================================
79PFDACS(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 ;====================================================
105ROUTINE(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 ;====================================================
117RTNCS(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 ;====================================================
131PRTNCS(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 ;
Note: See TracBrowser for help on using the repository browser.