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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIULIP 1244 printed Dec 13, 2024@02:42:14 Page 2
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
