- 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
