| 1 | LR7OSAP3 ;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 | ;
|
|---|
| 6 | MAIN(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
|
|---|
| 19 | EXTRACT ;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")
|
|---|
| 25 | DISSECT ;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
|
|---|
| 59 | GLOSET ;
|
|---|
| 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
|
|---|
| 78 | LN ;Increment the counter
|
|---|
| 79 | S GCNT=GCNT+1,CCNT=1
|
|---|
| 80 | Q
|
|---|
| 81 | CHKSUM ;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
|
|---|
