source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LR7OSAP1.m@ 1800

LR7OSAP1 ;slc/dcm/wty/kll - Silent AP rpt cont. ;3/28/2002
 ;;5.2;LAB SERVICE;**121,227,230,259,317**;Sep 27, 1994
 Q:'$D(^XUSEC("LRLAB",DUZ))
 D LN
 S $P(LR("%"),"-",GIOM)="",^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,LR("%"))
 D LN
 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"SNOMED/ICD codes:")
 S C=0
 F  S C=$O(^LR(LRDFN,LRSS,LRI,2,C)) Q:'C  S T=+^(C,0),T=^LAB(61,T,0) D
 . D LN
 . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"T-"_$P(T,"^",2)_": "),X=$P(T,"^")
 . D:LR(69.2,.05) C^LRUA
 . S ^(0)=^TMP("LRC",$J,GCNT,0)_X
 . D M
 D LINE^LR7OSUM4
 S C=0
 F  S C=$O(^LR(LRDFN,LRSS,LRI,3,C)) Q:'C  S X=+^(C,0),X=$G(^ICD9(X,0)) I $L(X) D
 . S X(9)=$P(X,"^"),X=$P(X,"^",3)
 . D LN
 . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"ICD code: "_X(9))
 . D:LR(69.2,.05) C^LRUA
 . S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(20,CCNT,X)
 Q
M ;
 S B=0
 F  S B=$O(^LR(LRDFN,LRSS,LRI,2,C,2,B)) Q:'B  S M=+^(B,0),M=$G(^LAB(61.1,M,0)) I $L(M) D
 . D LN
 . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(5,CCNT,"M-"_$P(M,"^",2)_": "),X=$P(M,"^")
 . D:LR(69.2,.05) C^LRUA
 . S ^(0)=^TMP("LRC",$J,GCNT,0)_X
 . D EX
 F B=1.4,3.3,4.5 S F=0 F  S F=$O(^LR(LRDFN,LRSS,LRI,2,C,$P(B,"."),F)) Q:'F  D A
 Q
A ;
 S M=+^LR(LRDFN,LRSS,LRI,2,C,$P(B,"."),F,0),E="61."_$P(B,".",2),M=^LAB(E,M,0)
 D LN
 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(5,CCNT,$S(B=1.4:"D-",B=3.3:"F-",B=4.5:"P-",1:"")_$P(M,"^",2)),X=$P(M,"^")
 D:LR(69.2,.05) C^LRUA
 S ^(0)=^TMP("LRC",$J,GCNT,0)_": "_X
 Q
EX ;
 S G=0
 F  S G=$O(^LR(LRDFN,LRSS,LRI,2,C,2,B,1,G)) Q:'G  S E=+^(G,0),E=$G(^LAB(61.2,E,0)) I $L(E) D
 . D LN
 . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(10,CCNT,"E-"_$P(E,"^",2)_": "),X=$P(E,"^")
 . D:LR(69.2,.05) C^LRUA
 . S ^(0)=^TMP("LRC",$J,GCNT,0)_X
 Q
LN ;Increment the counter
 S GCNT=GCNT+1,CCNT=1
 Q
MOD ;Modified report stuff
 N A,B
 D LN
 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(28,CCNT,"*+* MODIFIED REPORT *+*")
 D LN
 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"(Last modified: ")
 S B=0
 F A=0:0 S A=$O(^LR(LRDFN,LRSS,LRI,LR(0),A)) Q:'A  S B=A
 Q:'$D(^LR(LRDFN,LRSS,LRI,LR(0),B,0))  S A=^(0),Y=+A,A=$P(A,"^",2),A=$P($G(^VA(200,A,0),A),"^")
 D D^LRU
 S ^(0)=^TMP("LRC",$J,GCNT,0)_Y_" typed by "_A_")"
 D:$D(LRQ(9)) M1
 Q
MODSR ;Modified Supplementary Report Audit Info
 N LRTEXT,LRSP1,LRSP2,LRFILE,LRIENS,LRR1,LRR2
 S LRFILE=$S(LRSS="CY":63.9072,LRSS="SP":63.8172,LRSS="EM":63.2072,1:"")
 Q:LRFILE=""
 D LN
 S LRTEXT="SUPPLEMENTARY REPORT HAS BEEN ADDED/MODIFIED"
 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(14,CCNT,"*+* "_LRTEXT_" *+*")
 D LN
 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"(Added/Last modified: ")
 S LRIENS=C_","_LRI_","_LRDFN_","
 S LRSP1=0
 F  S LRSP1=$O(^LR(LRDFN,LRSS,LRI,1.2,C,2,LRSP1)) Q:'LRSP1  D
 .S LRSP2=LRSP1
 Q:'$D(^LR(LRDFN,LRSS,LRI,1.2,C,2,LRSP2,0))
 S LRS2=^(0),Y=+LRS2,LRS2A=$P(LRS2,"^",2),LRSGN=" typed by "
 ;If supp rpt is released, display 'signed by' instead of 'typed by'
 I $P(LRS2,"^",3) S Y=$P(LRS2,"^",4),LRS2A=$P(LRS2,"^",3),LRSGN=" signed by "
 D D^LRU
 S LRS2A=$S($D(^VA(200,LRS2A,0)):$P(^(0),"^"),1:LRS2A)
 S LRR1=Y,LRR2=LRS2A
 S ^(0)=^TMP("LRC",$J,GCNT,0)_LRR1_LRSGN_LRR2_")"
 ;If RELEASED SUPP REPORT MODIFIED set to 1, display "NOT VERIFIED"
 I $P(^LR(LRDFN,LRSS,LRI,1.2,C,0),"^",3)=1 D
 .D LN
 .S LRTEXT="NOT VERIFIED"
 .S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(25,CCNT,"**-* "_LRTEXT_" *-**")
 Q
M1 ;
 S A=0
 F  S A=$O(^LR(LRDFN,LRSS,LRI,LR(0),A)) Q:'A  S LRT=^(A,0),Y=+LRT,X=$P(LRT,"^",2),X=$P($G(^VA(200,X,0),X),"^") D
 . D D^LRU,LN
 . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Date modified:"_Y_" typed by "_X)
 . D F
 S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(13,CCNT,"==========Text below appears on final report==========")
 Q
 ;
F ;
 S B=0
 F  S B=$O(^LR(LRDFN,LRSS,LRI,LR(0),A,1,B)) Q:'B  S LRT=^(B,0),X=LRT D LN S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,X)
 Q
WRAP(ROOT,FMT) ;Wrap text
 I '$L($G(ROOT)) Q ""
 S:'$G(FMT) FMT=79
 N X,LRI,LRTX,LRINDX
 S LRINDX=0,LRI=0
 F  S LRI=$O(@ROOT@(LRI)) Q:LRI'>0  D
 . S X=$S($L($G(@ROOT@(LRI))):@ROOT@(LRI),$L($G(@ROOT@(LRI,0))):@ROOT@(LRI,0),1:""),LRINDX=LRINDX+1
 . S X=$$FMT(FMT,.LRINDX,X)
 S LRI=0
 F  S LRI=$O(LRTX(LRI)) Q:'LRI  D LN^LR7OSAP S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,LRTX(LRI))
 Q
FMT(LENGTH,INDEX,TEXT) ;Format text
 N X,Y,J
 S Y=1
 S:'$D(LRTX(INDEX)) LRTX(INDEX)=""
 S X=$L(TEXT)+$L(LRTX(INDEX))+1
 I X<255 S TEXT=$S($L(LRTX(INDEX)):LRTX(INDEX)_" "_TEXT,1:TEXT)
 I X'<255 S INDEX=INDEX+1,LRTX(INDEX)=""
 S LRTX(INDEX)=""
 F J=1:1 S X=$P(TEXT," ",J) Q:J>$L(TEXT," ")  D
 . Q:'$L(X)
 . I ($L(X)+$L(LRTX(INDEX)))>LENGTH S Y=1,INDEX=INDEX+1,LRTX(INDEX)=""
 . S LRTX(INDEX)=$S(Y:X,1:LRTX(INDEX)_" "_X),Y=0
 S LRTX(INDEX)=$$STRIP(LRTX(INDEX))
 Q INDEX
STRIP(TEXT) ; Strips white space from text
 N LRI,LRX
 S LRX="" F LRI=1:1:$L(TEXT," ") S:$A($P(TEXT," ",LRI))>0 LRX=LRX_$S(LRI=1:"",1:" ")_$P(TEXT," ",LRI)
 S TEXT=LRX
 Q TEXT