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

SROGMTS0.m

Go to the documentation of this file.
  1. SROGMTS0 ;BIR/ADM - SURGERY HEALTH SUMMARY ; [ 02/18/04 7:12 AM ]
  1. ;;3.0; Surgery ;**100**;24 Jun 93
  1. ;
  1. ;** NOTICE: This routine is part of an implementation of a nationally
  1. ;** controlled procedure. Local modifications to this routine
  1. ;** are prohibited.
  1. ;
  1. ; Reference to TGET^TIUSRVR1 supported by DBIA #2944
  1. ;
  1. Q
  1. ED(X) ; external date
  1. S X=$G(X) Q:'$L(X) ""
  1. S X=$TR($$FMTE^XLFDT(X,"5DZ"),"@"," ")
  1. Q X
  1. EDT(X) ; external date and time
  1. S X=$G(X) Q:'$L(X) ""
  1. S X=$TR($$FMTE^XLFDT(X,"2ZM"),"@"," ")
  1. Q X
  1. EN(X) ; Convert Case
  1. N Y,SROK,SROC,SRWORD,SRPC,SRLEAD,SRTLR,SRTR,SRCTR,SRPRE
  1. S (SRTR,SRWORD,SRPC)="",X=$$UP(X)
  1. ; Parse by Spaces
  1. F SRCTR=1:1:$L(X," ") D
  1. . S SRWORD=$P(X," ",SRCTR)
  1. . S (SRPC,SRLEAD,SRTLR)=""
  1. . I $E(SRWORD,1)="(" S SRWORD=$E(SRWORD,2,$L(SRWORD)),SRLEAD="("
  1. . I $E(SRWORD,$L(SRWORD))=")" S SRWORD=$E(SRWORD,1,($L(SRWORD)-1)),SRTLR=")"
  1. . ; String contains special characters
  1. . S SROK=1 F SROC="(",")","-","*","+","{","&","}","[","]","/","\","|",",","'" S:SRWORD[SROC SROK=0 Q:'SROK
  1. . I 'SROK D SP
  1. . I SROK D SRWORD
  1. . S:SRLEAD'="" SRWORD=SRLEAD_SRWORD
  1. . S:SRTLR'="" SRWORD=SRWORD_SRTLR
  1. . S SRTR=SRTR_" "_SRWORD
  1. S X=$$TRIM(SRTR) Q X
  1. EN2(X) ; Convert Case 2
  1. S X=$$CK($$EN($G(X))) Q X
  1. SP ; Special Characters
  1. ; Special Cases of Special Characters
  1. I $$UP(SRWORD)="W/&W/O" S SRWORD="w/&w/o" Q
  1. I $$UP(SRWORD)="W&W/O" S SRWORD="w&w/o" Q
  1. I $$UP(SRWORD)="&/OR" S SRWORD="&/or" Q
  1. I SRWORD="W/O" S SRWORD="w/o" Q
  1. N SROK,SRWD1,SRWD2,SRW,SRWCTR,SRCHR
  1. S SRWD1=SRWORD,SRWD2="",SRW=""
  1. F SRWCTR=1:1:$L(SRWD1) D
  1. . S SRCHR=$E(SRWD1,SRWCTR) I "()-*+{}'&[]/\|,"[SRCHR,$L(SRW) D Q
  1. . . S SRPRE=""
  1. . . S:$E(SRW,1,2)="ZZ"&($L(SRW)>2) SRPRE="ZZ",SRW=$E(SRW,3,$L(SRW))
  1. . . S SRW=SRPRE_$$CASE(SRW,SRCHR)
  1. . . S SRWD2=SRWD2_SRW_SRCHR,SRW=""
  1. . S SRW=SRW_SRCHR
  1. I $L(SRW) D
  1. . N SRPSN F SRPSN=1:1:$L(SRW) Q:"()-*+{}'&[]/\|,"'[$E(SRW,SRPSN)
  1. . N SROW,SRLW S SRLW=$E(SRW,0,(SRPSN-1))
  1. . S SROW=$E(SRW,SRPSN,$L(SRW))
  1. . S SRPRE="" S:$E(SROW,1,2)="ZZ"&($L(SROW)>2) SRPRE="ZZ",SROW=$E(SROW,3,$L(SROW))
  1. . S SROW=SRPRE_$$CASE(SROW,$E($G(SRWD2),$L($G(SRWD2))))
  1. . S SRW=SRLW_SROW
  1. . S SRWD2=SRWD2_SRW
  1. S SRWORD=SRWD2 S:SRCTR=1 SRWORD=$$LD(SRWORD)
  1. K SRWD1,SRWD2
  1. Q
  1. SRWORD ; Convert word
  1. S SRPRE="" S:$E(SRWORD,1,2)="ZZ"&($L(SRWORD)>2) SRPRE="ZZ",SRWORD=$E(SRWORD,3,$L(SRWORD))
  1. S SRWORD=SRPRE_$$CASE(SRWORD,"")
  1. Q
  1. CASE(X,J) ; Set to Mixed/lower/UPPER case
  1. N SRTAG,SRRTN,Y S X=$$UP($G(X)),Y="",SRTAG=$L(X),SRRTN="SROGMTS1"
  1. S:+SRTAG>4 SRRTN="SROGMTS2" S:+SRTAG>9 SRTAG="M"
  1. Q:+SRTAG=0&(SRTAG'="M") X
  1. S SRRTN=SRTAG_"^"_SRRTN D @SRRTN
  1. I $L(Y) S X=Y Q X
  1. S X=$$MX(X)
  1. Q X
  1. LO(X) Q $TR(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
  1. UP(X) Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1. MX(X) Q $TR($E(X,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$TR($E(X,2,$L(X)),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
  1. LD(X) Q $TR($E(X,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$E(X,2,$L(X))
  1. TRIM(X) S X=$G(X) F Q:$E(X,1)'=" " S X=$E(X,2,$L(X))
  1. F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1))
  1. Q X
  1. CK(X) ;
  1. S X=$G(X)
  1. F Q:X'["(S)" S X=$P(X,"(S)",1)_"(s)"_$P(X,"(S)",2,299)
  1. F Q:X'[" A " S X=$P(X," A ",1)_" a "_$P(X," A ",2,229)
  1. I X["Class a" F Q:X'["Class a" S X=$P(X,"Class a",1)_"Class A"_$P(X,"Class a",2,229)
  1. I X["Type a" F Q:X'["Type a" S X=$P(X,"Type a",1)_"Type A"_$P(X,"Type a",2,229)
  1. F Q:X'["'S" S X=$P(X,"'S",1)_"'s"_$P(X,"'S",2,229)
  1. I X["mg Diet" F Q:X'["mg Diet" S X=$P(X,"mg Diet",1)_"MG Diet"_$P(X,"mg Diet",2,229)
  1. I X["LO-Fat" F Q:X'["LO-Fat" S X=$P(X,"LO-Fat",1)_"Lo-Fat"_$P(X,"LO-Fat",2,229)
  1. I $E(X,1)="'" S X="'"_$$LD($E(X,2,$L(X)))
  1. S X=$TR($E(X,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$E(X,2,$L(X))
  1. Q X
  1. DICT ; get dictation from TIU completed
  1. N SRCT,SRL,SRNON,SRSTAT,SRSUM,SRTIU,SRTN,SROY,SRT
  1. S SRTN=IEN,SRNON=$S($P($G(^SRF(SRTN,"NON")),"^")="Y":1,1:0)
  1. S (SRSTAT,SRSUM)="" D STATUS I SRSTAT=7 K ^TMP("SRLQ",$J) D
  1. . S REC(130,SRTN,1.15,1)=SRSUM,REC(130,SRTN,1.15,2)="",SRCT=3
  1. . D TGET^TIUSRVR1(.SROY,SRTIU,"VIEW")
  1. . S SRT=0 F S SRT=$O(@SROY@(SRT)) Q:SRT="" D
  1. . . I $D(@SROY@(SRT))=10 S REC(130,SRTN,1.15,SRCT)=@SROY@(SRT,0)
  1. . . E S REC(130,SRTN,1.15,SRCT)=@SROY@(SRT)
  1. . . S SRCT=SRCT+1
  1. . K @SROY
  1. Q
  1. STATUS ; get status of summary in TIU
  1. I 'SRNON D Q
  1. .S SRTIU=$P($G(^SRF(SRTN,"TIU")),"^") I SRTIU S SRSTAT=$$STATUS^SROESUTL(SRTIU) D
  1. ..I SRSTAT=7 S SRSUM=" * * The Operation Report has been electronically signed. * *"
  1. I SRNON D
  1. .S SRTIU=$P($G(^SRF(SRTN,"TIU")),"^",3) I SRTIU S SRSTAT=$$STATUS^SROESUTL(SRTIU) D
  1. ..I SRSTAT=7 S SRSUM=" * * The Procedure Report (Non-OR) has been electronically signed. * *" Q
  1. Q