Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LR7OSAP3

LR7OSAP3.m

Go to the documentation of this file.
  1. LR7OSAP3 ;DALOI/CKA - Silent AP Rpt from TIU;3/27/02
  1. ;;5.2;LAB SERVICE;**259,315**;Sep 27, 1994;Build 25
  1. ;
  1. ;Reference to EXTRACT^TIULQ supported by IA #2693
  1. ;Reference to TGET^TIUSRVR1 supported by IA #2944
  1. ;
  1. MAIN(LRPTR) ;Main subrouting
  1. K ^TMP("LRTIU",$J),^TMP("LRTIUTXT",$J)
  1. D EXTRACT
  1. D DISSECT
  1. Q:LRQUIT
  1. ;Calculate LR and TIU checksums,if they don't match, set flag
  1. ; to scramble signature on the report.
  1. D CHKSUM
  1. I LRCKSUM'=0,LRCKSUM'=TIUCKSUM S LRENCRYP=1
  1. ;
  1. D GLOSET
  1. K ^TMP("LRTIU",$J),^TMP("LRTIUTXT",$J)
  1. Q
  1. EXTRACT ;Extract the report from TIU
  1. N LRQUIT,LRFLG,LRTXT,LROR,LRCNT,LRCNTT,LRHFLG
  1. Q:'+$G(LRPTR)
  1. D EXTRACT^TIULQ(LRPTR,"^TMP(""LRTIU"",$J)",,,,1,,1)
  1. Q:'+$P($G(^TMP("LRTIU",$J,LRPTR,"TEXT",0)),"^",3)
  1. M ^TMP("LRTIUTXT",$J)=^TMP("LRTIU",$J,LRPTR,"TEXT")
  1. DISSECT ;Dissect the report into header,body, and footer
  1. S (LROR,LRCNT,LRCNTT,LRHFLG,LRQUIT)=0,LRFLG="H"
  1. F S LROR=$O(^TMP("LRTIUTXT",$J,LROR)) Q:LROR'>0!(LRQUIT) D
  1. .S LRTXT=$G(^TMP("LRTIUTXT",$J,LROR,0))
  1. .I 'LRHFLG,LRTXT'="$APHDR" D Q
  1. ..S LRQUIT=1
  1. .I LRTXT="$APHDR" D Q
  1. ..S LRHFLG=1
  1. ..K ^TMP("LRTIUTXT",$J,LROR)
  1. .I LRFLG="H" D Q:LRFLG="T"
  1. ..I LRTXT="$TEXT" D Q
  1. ...S ^TMP("LRTIUTXT",$J,"HDR")=LRCNT,LRCNT=0
  1. ...K ^TMP("LRTIUTXT",$J,LROR)
  1. ...S LRFLG="T",LRCNT=0
  1. ..Q:LRFLG="T"
  1. ..S LRCNT=LRCNT+1,LRCNTT=LRCNTT+1
  1. ..S ^TMP("LRTIUTXT",$J,"HDR",LRCNT)=LRTXT
  1. ..K ^TMP("LRTIUTXT",$J,LROR)
  1. .I LRFLG="T" D Q:LRFLG="F"
  1. ..I LRTXT="$FTR" D Q:LRFLG="F"
  1. ...S ^TMP("LRTIUTXT",$J,"TEXT")=LRCNT,LRCNT=0
  1. ...K ^TMP("LRTIUTXT",$J,LROR)
  1. ...S LRFLG="F"
  1. ..Q:LRFLG="F"
  1. ..S LRCNT=LRCNT+1,LRCNTT=LRCNTT+1
  1. ..S ^TMP("LRTIUTXT",$J,"TEXT",LRCNT)=LRTXT
  1. ..K ^TMP("LRTIUTXT",$J,LROR)
  1. .I LRFLG="F" D
  1. ..S LRCNT=LRCNT+1,LRCNTT=LRCNTT+1
  1. ..S ^TMP("LRTIUTXT",$J,"FTR",LRCNT)=LRTXT
  1. ..K ^TMP("LRTIUTXT",$J,LROR)
  1. S ^TMP("LRTIUTXT",$J,"FTR")=LRCNT
  1. S ^TMP("LRTIUTXT",$J,0)=LRCNTT
  1. Q
  1. GLOSET ;
  1. S LROR=0
  1. Q:'$D(^TMP("LRTIUTXT",$J,"HDR"))
  1. S LROR=0 F S LROR=$O(^TMP("LRTIUTXT",$J,"HDR",LROR)) Q:LROR'>0 D
  1. .S LRTXT=$G(^TMP("LRTIUTXT",$J,"HDR",LROR))
  1. .D LN S ^TMP("LRC",$J,GCNT,0)=LRTXT
  1. Q:'$D(^TMP("LRTIUTXT",$J,"TEXT"))
  1. S LROR=0
  1. F S LROR=$O(^TMP("LRTIUTXT",$J,"TEXT",LROR)) Q:LROR'>0!(LRQUIT) D
  1. .S LRTXT=$G(^TMP("LRTIUTXT",$J,"TEXT",LROR))
  1. .;If signature line, and marked for encryption, scramble signature
  1. .I LRTXT["/es/",+$G(LRENCRYP) S LRTXT=$$ENCRYP^XUSRB1(LRTXT)
  1. .D LN S ^TMP("LRC",$J,GCNT,0)=LRTXT
  1. Q:'$D(^TMP("LRTIUTXT",$J,"FTR"))
  1. S LROR=0
  1. F S LROR=$O(^TMP("LRTIUTXT",$J,"FTR",LROR)) Q:LROR'>0 D
  1. .S LRTXT=$G(^TMP("LRTIUTXT",$J,"FTR",LROR))
  1. .D LN S ^TMP("LRC",$J,GCNT,0)=LRTXT
  1. Q
  1. LN ;Increment the counter
  1. S GCNT=GCNT+1,CCNT=1
  1. Q
  1. CHKSUM ;Compare LR and TIU checksums
  1. ;Get original checksum value from file 63
  1. N LRTREC,LRROOT,LRFILE,LRIENS,LRFLD,LRREL
  1. S (LRENCRYP,LRTREC)=0
  1. I LRSS="AU" D
  1. .S LRTREC=$O(^LR(LRDFN,101,"C",LRPTR,LRTREC))
  1. .S LRIENS=LRDFN_","
  1. .S LRFILE=63.101
  1. I LRSS'="AU" D
  1. .S LRTREC=$O(^LR(LRDFN,LRSS,LRI,.05,"C",LRPTR,LRTREC))
  1. .S LRIENS=LRI_","_LRDFN_","
  1. .S LRFILE=$S(LRSS="SP":63.19,LRSS="CY":63.47,LRSS="EM":63.49,1:"")
  1. I LRFILE=""!(LRTREC=0) S LRCKSUM=0 Q
  1. ;Retrieve LR checksum
  1. S LRIENS=LRTREC_","_LRIENS
  1. S LRCKSUM=$$GET1^DIQ(LRFILE,LRIENS,2)
  1. I LRCKSUM="" S LRCKSUM=0
  1. ;Calculate TIU checksum
  1. S $P(^TMP("LRTIU",$J,LRPTR,"TEXT",0),U,5)=$P(^TMP("LRTIU",$J,LRPTR,1201,"I"),".")
  1. S LRVAL="^TMP(""LRTIU"","_$J_","_LRPTR_",""TEXT"")"
  1. S TIUCKSUM=$$CHKSUM^XUSESIG1(LRVAL)
  1. Q