TIULIP.m

TIULIP ; SLC/JER - Lipid Profile Loader ;7/7/95  15:22

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

MAIN(DFN,EARLY,LATE,DISPLAY,TARGET,LINE) ; Control branching

 N TIUI,TIUCNT,TIUDT,TIUY S TIUCNT=0

 K ^TMP("LRAPI",$J)

 I '$D(^DPT(DFN,"LR")) D NOLABS G LABX

 S LRDFN=+^DPT(DFN,"LR") I '$D(^LR(LRDFN)) D NOLABS G LABX

 I +$G(DISPLAY) W !,"Gathering Laboratory Data."

 D LIPIDS^TIULO(.TIUY,DFN,$G(EARLY),$G(LATE))

 I $G(TIUY(1))="No Lab Data" D NOLABS G LABX

 S TIUI="" F  S TIUI=$O(TIUY(TIUI)) Q:TIUI=""  D

 . N TIUX

 . S TIUDT=0 F  S TIUDT=$O(TIUY(TIUI,TIUDT)) Q:+TIUDT'>0  D

 . . S TIUCNT=TIUCNT+1 D LINE

LABX Q "~@"_$NA(@TARGET)

NOLABS ; Handles Case Where no Labs are found to satisfy criteria

 S LINE=$S(+$G(LINE):+$G(LINE),1:1),@TARGET@(LINE,0)="No data available"

 S LINE=+$G(LINE)+1,@TARGET@(LINE,0)=" "

 S @TARGET@(0)="^^"_LINE_"^"_LINE_"^"_DT_"^^"

 Q

LINE ; Line-wrap with comma-delimited data

 N X,Y

 I TIUCNT#2'>0 Q

 S TIUX=$$SETSTR^VALM1(TIUI_":","",15,24)

 S TIUX=$$SETSTR^VALM1($G(TIUY(TIUI,TIUDT)),TIUX,47,8)

 S TIUX=$$SETSTR^VALM1($G(TIUY(TIUI,+$O(TIUY(TIUI,TIUDT)))),TIUX,63,8)

 S LINE=+$G(LINE)+1

 S @TARGET@(LINE,0)=TIUX

 S @TARGET@(0)="^^"_LINE_"^"_LINE_"^"_DT_"^^"

 I +$G(DISPLAY) W "."

 Q

TIULIP    ; SLC/JER - Lipid Profile Loader ;7/7/95  15:22

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

MAIN(DFN,EARLY,LATE,DISPLAY,TARGET,LINE) ; Control branching

 +1        NEW TIUI,TIUCNT,TIUDT,TIUY

           SET TIUCNT=0

 +2        KILL ^TMP("LRAPI",$JOB)

 +3        IF '$DATA(^DPT(DFN,"LR"))

               DO NOLABS

               GOTO LABX

 +4        SET LRDFN=+^DPT(DFN,"LR")

           IF '$DATA(^LR(LRDFN))

               DO NOLABS

               GOTO LABX

 +5        IF +$GET(DISPLAY)

               WRITE !,"Gathering Laboratory Data."

 +6        DO LIPIDS^TIULO(.TIUY,DFN,$GET(EARLY),$GET(LATE))

 +7        IF $GET(TIUY(1))="No Lab Data"

               DO NOLABS

               GOTO LABX

 +8        SET TIUI=""

           FOR 

               SET TIUI=$ORDER(TIUY(TIUI))

               IF TIUI=""

                   QUIT 

               Begin DoDot:1

 +9                NEW TIUX

 +10               SET TIUDT=0

                   FOR 

                       SET TIUDT=$ORDER(TIUY(TIUI,TIUDT))

                       IF +TIUDT'>0

                           QUIT 

                       Begin DoDot:2

 +11                       SET TIUCNT=TIUCNT+1

                           DO LINE

                       End DoDot:2

               End DoDot:1

LABX       QUIT "~@"_$NAME(@TARGET)

NOLABS    ; Handles Case Where no Labs are found to satisfy criteria

 +1        SET LINE=$SELECT(+$GET(LINE):+$GET(LINE),1:1)

           SET @TARGET@(LINE,0)="No data available"

 +2        SET LINE=+$GET(LINE)+1

           SET @TARGET@(LINE,0)=" "

 +3        SET @TARGET@(0)="^^"_LINE_"^"_LINE_"^"_DT_"^^"

 +4        QUIT 

LINE      ; Line-wrap with comma-delimited data

 +1        NEW X,Y

 +2        IF TIUCNT#2'>0

               QUIT 

 +3        SET TIUX=$$SETSTR^VALM1(TIUI_":","",15,24)

 +4        SET TIUX=$$SETSTR^VALM1($GET(TIUY(TIUI,TIUDT)),TIUX,47,8)

 +5        SET TIUX=$$SETSTR^VALM1($GET(TIUY(TIUI,+$ORDER(TIUY(TIUI,TIUDT)))),TIUX,63,8)

 +6        SET LINE=+$GET(LINE)+1

 +7        SET @TARGET@(LINE,0)=TIUX

 +8        SET @TARGET@(0)="^^"_LINE_"^"_LINE_"^"_DT_"^^"

 +9        IF +$GET(DISPLAY)

               WRITE "."

 +10       QUIT