source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LR7OSAP3.m@ 1006

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

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1LR7OSAP3 ;DALOI/WTY - Silent AP Rpt from TIU;3/27/02
2 ;;5.2;LAB SERVICE;**259**;Sep 27, 1994
3 ;
4 ;Reference to EXTRACT^TIULQ supported by IA #2693
5 ;
6MAIN(LRPTR) ;Main subrouting
7 K ^TMP("LRTIU",$J),^TMP("LRTIUTXT",$J)
8 D EXTRACT
9 D DISSECT
10 Q:LRQUIT
11 ;Calculate LR and TIU checksums,if they don't match, set flag
12 ; to scramble signature on the report.
13 D CHKSUM
14 I LRCKSUM'=0,LRCKSUM'=TIUCKSUM S LRENCRYP=1
15 ;
16 D GLOSET
17 K ^TMP("LRTIU",$J),^TMP("LRTIUTXT",$J)
18 Q
19EXTRACT ;Extract the report from TIU
20 N LRQUIT,LRFLG,LRTXT,LROR,LRCNT,LRCNTT,LRHFLG
21 Q:'+$G(LRPTR)
22 D EXTRACT^TIULQ(LRPTR,"^TMP(""LRTIU"",$J)",,,,1,,1)
23 Q:'+$P($G(^TMP("LRTIU",$J,LRPTR,"TEXT",0)),"^",3)
24 M ^TMP("LRTIUTXT",$J)=^TMP("LRTIU",$J,LRPTR,"TEXT")
25DISSECT ;Dissect the report into header,body, and footer
26 S (LROR,LRCNT,LRCNTT,LRHFLG,LRQUIT)=0,LRFLG="H"
27 F S LROR=$O(^TMP("LRTIUTXT",$J,LROR)) Q:LROR'>0!(LRQUIT) D
28 .S LRTXT=$G(^TMP("LRTIUTXT",$J,LROR,0))
29 .I 'LRHFLG,LRTXT'="$APHDR" D Q
30 ..S LRQUIT=1
31 .I LRTXT="$APHDR" D Q
32 ..S LRHFLG=1
33 ..K ^TMP("LRTIUTXT",$J,LROR)
34 .I LRFLG="H" D Q:LRFLG="T"
35 ..I LRTXT="$TEXT" D Q
36 ...S ^TMP("LRTIUTXT",$J,"HDR")=LRCNT,LRCNT=0
37 ...K ^TMP("LRTIUTXT",$J,LROR)
38 ...S LRFLG="T",LRCNT=0
39 ..Q:LRFLG="T"
40 ..S LRCNT=LRCNT+1,LRCNTT=LRCNTT+1
41 ..S ^TMP("LRTIUTXT",$J,"HDR",LRCNT)=LRTXT
42 ..K ^TMP("LRTIUTXT",$J,LROR)
43 .I LRFLG="T" D Q:LRFLG="F"
44 ..I LRTXT="$FTR" D Q:LRFLG="F"
45 ...S ^TMP("LRTIUTXT",$J,"TEXT")=LRCNT,LRCNT=0
46 ...K ^TMP("LRTIUTXT",$J,LROR)
47 ...S LRFLG="F"
48 ..Q:LRFLG="F"
49 ..S LRCNT=LRCNT+1,LRCNTT=LRCNTT+1
50 ..S ^TMP("LRTIUTXT",$J,"TEXT",LRCNT)=LRTXT
51 ..K ^TMP("LRTIUTXT",$J,LROR)
52 .I LRFLG="F" D
53 ..S LRCNT=LRCNT+1,LRCNTT=LRCNTT+1
54 ..S ^TMP("LRTIUTXT",$J,"FTR",LRCNT)=LRTXT
55 ..K ^TMP("LRTIUTXT",$J,LROR)
56 S ^TMP("LRTIUTXT",$J,"FTR")=LRCNT
57 S ^TMP("LRTIUTXT",$J,0)=LRCNTT
58 Q
59GLOSET ;
60 S LROR=0
61 Q:'$D(^TMP("LRTIUTXT",$J,"HDR"))
62 S LROR=0 F S LROR=$O(^TMP("LRTIUTXT",$J,"HDR",LROR)) Q:LROR'>0 D
63 .S LRTXT=$G(^TMP("LRTIUTXT",$J,"HDR",LROR))
64 .D LN S ^TMP("LRC",$J,GCNT,0)=LRTXT
65 Q:'$D(^TMP("LRTIUTXT",$J,"TEXT"))
66 S LROR=0
67 F S LROR=$O(^TMP("LRTIUTXT",$J,"TEXT",LROR)) Q:LROR'>0!(LRQUIT) D
68 .S LRTXT=$G(^TMP("LRTIUTXT",$J,"TEXT",LROR))
69 .;If signature line, and marked for encryption, scramble signature
70 .I LRTXT["/es/",+$G(LRENCRYP) S LRTXT=$$ENCRYP^XUSRB1(LRTXT)
71 .D LN S ^TMP("LRC",$J,GCNT,0)=LRTXT
72 Q:'$D(^TMP("LRTIUTXT",$J,"FTR"))
73 S LROR=0
74 F S LROR=$O(^TMP("LRTIUTXT",$J,"FTR",LROR)) Q:LROR'>0 D
75 .S LRTXT=$G(^TMP("LRTIUTXT",$J,"FTR",LROR))
76 .D LN S ^TMP("LRC",$J,GCNT,0)=LRTXT
77 Q
78LN ;Increment the counter
79 S GCNT=GCNT+1,CCNT=1
80 Q
81CHKSUM ;Compare LR and TIU checksums
82 ;Get original checksum value from file 63
83 N LRTREC,LRROOT,LRFILE,LRIENS,LRFLD,LRREL
84 S (LRENCRYP,LRTREC)=0
85 I LRSS="AU" D
86 .S LRTREC=$O(^LR(LRDFN,101,"C",LRPTR,LRTREC))
87 .S LRIENS=LRDFN_","
88 .S LRFILE=63.101
89 I LRSS'="AU" D
90 .S LRTREC=$O(^LR(LRDFN,LRSS,LRI,.05,"C",LRPTR,LRTREC))
91 .S LRIENS=LRI_","_LRDFN_","
92 .S LRFILE=$S(LRSS="SP":63.19,LRSS="CY":63.47,LRSS="EM":63.49,1:"")
93 I LRFILE=""!(LRTREC=0) S LRCKSUM=0 Q
94 ;Retrieve LR checksum
95 S LRIENS=LRTREC_","_LRIENS
96 S LRCKSUM=$$GET1^DIQ(LRFILE,LRIENS,2)
97 I LRCKSUM="" S LRCKSUM=0
98 ;Calculate TIU checksum
99 S TIUVAL="^TIU(8925,"_LRPTR_",""TEXT"")"
100 S TIUCKSUM=$$CHKSUM^XUSESIG1(TIUVAL)
101 Q
Note: See TracBrowser for help on using the repository browser.