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