TIULF.m

TIULF ; SLC/JER - More computational functions ; 4/2/03

 ;;1.0;TEXT INTEGRATION UTILITIES;**162**;Jun 20, 1997

 ;

STATUS(TIUDA) ; Returns external status for document TIUDA

 Q $$GET1^DIQ(8925,TIUDA_",",.05)

 ;

EMPTYDOC(DA) ;Checks to see if text for DCS is blank

 ; returns a 1 if empty

 ; returns a 0 if contains data

 N TIULINE,TIUQUIT,TIUSTART,TIUX,TIUY,TIUCHAR,TIUDATA

 S TIUY=1

 I +$O(^TIU(8925,+DA,"TEXT",0))'>0,+$O(^TIU(8925,"DAD",+DA,0))'>0 G EMPTYX ;Text not entered

 S TIULINE=0 F  S TIULINE=$O(^TIU(8925,+DA,"TEXT",TIULINE)) Q:TIULINE'>0!(TIUY=0)  D  Q:TIUY=0

 . S TIUDATA=$G(^TIU(8925,+DA,"TEXT",TIULINE,0)),TIUQUIT=$L(TIUDATA)

 . I TIUQUIT>0 S TIUSTART=1 D  ;Line contains data

 . . ;Checks a char at a time for valid data. If found, TIUY set to 0

 . . ;Data between two | indicates format command and not valid data 

 . . F TIUSTART=TIUSTART:1:TIUQUIT S TIUCHAR=$E(TIUDATA,TIUSTART) D  Q:(TIUY=0)

 . . . ;Char is not a control char or | char

 . . . I $A(TIUCHAR)'<33&($A(TIUCHAR)'>123)!($A(TIUCHAR)=125) S TIUY=0 Q

 . . . I $A(TIUCHAR)=124 D  ;Char is a |

 . . . . S TIUX=$F(TIUDATA,"|",TIUSTART+1) ;Find second |

 . . . . I TIUX>TIUSTART S TIUSTART=TIUX-1 ;Making sure there is a second |

 I +TIUY,$O(^TIU(8925,"DAD",+DA,0)) D

 . N TIUC S TIUC=0

 . F TIUC=$O(^TIU(8925,"DAD",+DA,TIUC)) Q:+TIUC'>0  D  Q:+TIUY=0

 . . S TIUY=$$EMPTYDOC(TIUC)

EMPTYX ; EXIT

 Q TIUY

DOCTYPE(TIUDA) ; Evaluates Definition of a Document

 N TYPE S TYPE=+$G(^TIU(8925,+TIUDA,0))

 S TYPE=$P($G(^TIU(8925.1,+TYPE,0)),U,4)_U_$$PNAME^TIULC1(+TYPE)

 Q TYPE

TIULF     ; SLC/JER - More computational functions ; 4/2/03

 +1       ;;1.0;TEXT INTEGRATION UTILITIES;**162**;Jun 20, 1997

 +2       ;

STATUS(TIUDA) ; Returns external status for document TIUDA

 +1        QUIT $$GET1^DIQ(8925,TIUDA_",",.05)

 +2       ;

EMPTYDOC(DA) ;Checks to see if text for DCS is blank

 +1       ; returns a 1 if empty

 +2       ; returns a 0 if contains data

 +3        NEW TIULINE,TIUQUIT,TIUSTART,TIUX,TIUY,TIUCHAR,TIUDATA

 +4        SET TIUY=1

 +5       ;Text not entered

           IF +$ORDER(^TIU(8925,+DA,"TEXT",0))'>0

               IF +$ORDER(^TIU(8925,"DAD",+DA,0))'>0

                   GOTO EMPTYX

 +6        SET TIULINE=0

           FOR 

               SET TIULINE=$ORDER(^TIU(8925,+DA,"TEXT",TIULINE))

               IF TIULINE'>0!(TIUY=0)

                   QUIT 

               Begin DoDot:1

 +7                SET TIUDATA=$GET(^TIU(8925,+DA,"TEXT",TIULINE,0))

                   SET TIUQUIT=$LENGTH(TIUDATA)

 +8       ;Line contains data

                   IF TIUQUIT>0

                       SET TIUSTART=1

                       Begin DoDot:2

 +9       ;Checks a char at a time for valid data. If found, TIUY set to 0

 +10      ;Data between two | indicates format command and not valid data 

 +11                       FOR TIUSTART=TIUSTART:1:TIUQUIT

                               SET TIUCHAR=$EXTRACT(TIUDATA,TIUSTART)

                               Begin DoDot:3

 +12      ;Char is not a control char or | char

 +13                               IF $ASCII(TIUCHAR)'<33&($ASCII(TIUCHAR)'>123)!($ASCII(TIUCHAR)=125)

                                       SET TIUY=0

                                       QUIT 

 +14      ;Char is a |

                                   IF $ASCII(TIUCHAR)=124

                                       Begin DoDot:4

 +15      ;Find second |

                                           SET TIUX=$FIND(TIUDATA,"|",TIUSTART+1)

 +16      ;Making sure there is a second |

                                           IF TIUX>TIUSTART

                                               SET TIUSTART=TIUX-1

                                       End DoDot:4

                               End DoDot:3

                               IF (TIUY=0)

                                   QUIT 

                       End DoDot:2

               End DoDot:1

               IF TIUY=0

                   QUIT 

 +17       IF +TIUY

               IF $ORDER(^TIU(8925,"DAD",+DA,0))

                   Begin DoDot:1

 +18                   NEW TIUC

                       SET TIUC=0

 +19                   FOR TIUC=$ORDER(^TIU(8925,"DAD",+DA,TIUC))

                           IF +TIUC'>0

                               QUIT 

                           Begin DoDot:2

 +20                           SET TIUY=$$EMPTYDOC(TIUC)

                           End DoDot:2

                           IF +TIUY=0

                               QUIT 

                   End DoDot:1

EMPTYX    ; EXIT

 +1        QUIT TIUY

DOCTYPE(TIUDA) ; Evaluates Definition of a Document

 +1        NEW TYPE

           SET TYPE=+$GET(^TIU(8925,+TIUDA,0))

 +2        SET TYPE=$PIECE($GET(^TIU(8925.1,+TYPE,0)),U,4)_U_$$PNAME^TIULC1(+TYPE)

 +3        QUIT TYPE