TIUWRIIS ;SLC/AJB,AGP - War Related Illness and Injury Study Center ; 08/18/03
;;1.0;TEXT INTEGRATION UTILITIES;**159,286**;Jun 20, 1997;Build 10
;;Per VA Directive 6402, this routine should not be modified
;
Q
ADDRESS(DFN) ;
N TIUCNT,TIUI,TIUY,VAPA S TIUI=0
N TIUCITY,TIUST,TIUZIP
D ADD^VADPT
S TIUY=$NA(^TMP("TIUWRIISC",$J))
F TIUCNT=1:1:3 D
. Q:VAPA(TIUCNT)=""
. S TIUI=TIUI+1
. S @TIUY@(TIUI,0)=VAPA(TIUCNT) I TIUCNT>1 S @TIUY@(TIUI,0)=" "_@TIUY@(TIUI,0)
S TIUCITY=" "_VAPA(4)
S TIUST=$$GET1^DIQ(5,+VAPA(5),1)
S TIUZIP=VAPA(6)
;286 - Format address for Philippines
I +VAPA(25)=167 D
. S TIUST=VAPA(23)
. S TIUZIP=VAPA(24)
S @TIUY@(4,0)=TIUCITY_", "_TIUST_" "_TIUZIP
Q "~@"_$NA(@TIUY)
LAB2(DFN,TIUTEST,COUNT,TPERIOD,TIUEDT,TIULDT) ; Get Lab Results
N CNT,DRANGE,INDATE,LABIEN,NUM,OUTPUT,REGDATE,SEQ,SEQ1,SUB,STRING
N TIULOUT,TIUY,TIUTST,TIUX,TMP1,TMP2
K ^TMP($J,"TIUWRIIS","LABOUT"),^TMP("LRRR",$J)
I $G(TPERIOD)="",$G(TIUEDT)="",$G(TIULDT)="" Q "<Invalid Date or Time Period Entered>"
I ($G(TPERIOD)?1"T-"1N.N) D
. S TIULDT=$$NOW^XLFDT D DT^DILF("P",TPERIOD,.DRANGE) S TIUEDT=$G(DRANGE)
I $G(COUNT)="" S COUNT=1
I $G(TIUTEST)="" Q "LAB NAME NOT FOUND"
S LABIEN=+$O(^LAB(60,"B",TIUTEST,0))
I '+$G(LABIEN) Q "INVALID LAB TEST NAME"
D RR^LR7OR1(DFN,"",$G(TIUEDT),$G(TIULDT),"",LABIEN,"",$G(COUNT),"",0)
I '$D(^TMP("LRRR",$J)) Q "No Lab Information Found for "_TIUTEST
S TIULOUT="^TMP($J,""TIUWRIIS"",""LABOUT"")",CNT=1,@TIULOUT@(CNT,0)="Lab Information for "_TIUTEST
S STRING=$$LJ^XLFSTR("Collection Date/Time",25),STRING=STRING_$$LJ^XLFSTR("Specimen",10)
S STRING=STRING_$$LJ^XLFSTR("Test",8),STRING=STRING_$$LJ^XLFSTR("Result",12)
S STRING=STRING_$$LJ^XLFSTR("Range",10),CNT=CNT+1,@TIULOUT@(CNT,0)=STRING
S SUB="" F S SUB=$O(^TMP("LRRR",$J,DFN,SUB)) Q:SUB="" D
. S INDATE="" F S INDATE=$O(^TMP("LRRR",$J,DFN,SUB,INDATE)) Q:+INDATE'>0 D
. . S SEQ="" F S SEQ=$O(^TMP("LRRR",$J,DFN,SUB,INDATE,SEQ)) Q:SEQ="" D
. . . I SEQ'="N" D
. . . . S CNT=CNT+1
. . . . S REGDATE=$$FMTE^XLFDT(9999999-INDATE)
. . . . S NODE=$G(^TMP("LRRR",$J,DFN,SUB,INDATE,SEQ))
. . . . S STRING=$$LJ^XLFSTR(REGDATE,25)
. . . . S STRING=STRING_$$LJ^XLFSTR($$GET1^DIQ(61,$P($G(NODE),U,19)_",",.01),10)
. . . . S STRING=STRING_$$LJ^XLFSTR($P($G(NODE),U,15),8)
. . . . S STRING=STRING_$$LJ^XLFSTR($P($G(NODE),U,2)_" "_$P($G(NODE),U,3)_$P($G(NODE),U,4),12)
. . . . S STRING=STRING_$$LJ^XLFSTR($P($G(NODE),U,5),10)
. . . . S @TIULOUT@(CNT,0)=STRING
. . . I SEQ="N" S SEQ1="" F S SEQ1=$O(^TMP("LRRR",$J,DFN,SUB,INDATE,SEQ,SEQ1)) Q:+SEQ1'>0 D
. . . . S NODE=$G(^TMP("LRRR",$J,DFN,SUB,INDATE,SEQ,SEQ1))
. . . . I $G(NODE)["[" D
. . . . . S NAME=$P($G(NODE),"[",2),NAME=$P($G(NAME),"]",1)
. . . . . S NAME=$$GET1^DIQ(200,$G(NAME)_",",.01)
. . . . . S TMP1=$P($G(NODE),"["),TMP2=$P($G(NODE),"]",2)
. . . . . S NODE=TMP1_" "_NAME_" "_TMP2
. . . . S CNT=CNT+1,@TIULOUT@(CNT,0)="Comment: "_NODE
K ^TMP("LRRR",$J)
LABQ Q "~@"_$NA(@TIULOUT)
PNOK(DFN) ;
N CNT,PNOK,VAOA
K ^TMP($J,"TIUWRIIS","PNOK")
D OAD^VADPT
S CNT=1
S PNOK="^TMP($J,""TIUWRIIS"",""PNOK"")"
I $D(VAOA) D
. S @PNOK@(CNT,0)="Primary Next of Kin Information"
. S CNT=CNT+1
. S @PNOK@(CNT,0)=$S($G(VAOA(9))'="":$G(VAOA(9)),1:"No Next of Kin Enter")
. S CNT=CNT+1
. S @PNOK@(CNT,0)=$S($G(VAOA(10))'="":"Relationship to Patient: "_VAOA(10),1:"Relationship Unknown")
. S CNT=CNT+1
. I $G(VAOA(1))=""&($G(VAOA(2))="")&($G(VAOA(3))="") S @PNOK@(CNT,0)="No Address Information Enter"
. E D
. . S @PNOK@(CNT,0)=$G(VAOA(1))
. . I $G(VAOA(2))'="" S @PNOK@(CNT,0)=@PNOK@(CNT,0)_" "_VAOA(2)
. . I $G(VAOA(3))'="" S CNT=CNT+1 S @PNOK@(CNT,0)=VAOA(3)
. S CNT=CNT+1
. I $G(VAOA(4))'="" S @PNOK@(CNT,0)=$G(VAOA(4))_", "_$P($G(VAOA(5)),U,2)_" "_$G(VAOA(6))
. I $G(VAOA(8))'="" S CNT=CNT+1 S @PNOK@(CNT,0)="Home Phone Number: "_VAOA(8)
E Q "No Next Kin Information Found"
Q "~@"_$NA(@PNOK)
;
SNOK(DFN) ;
N CNT,VAOA
K ^TMP($J,"TIUWRIIS","SNOK")
S VAOA("A")=3
D OAD^VADPT
S CNT=1
S PNOK="^TMP($J,""TIUWRIIS"",""SNOK"")"
I $D(VAOA) D
. S @PNOK@(CNT,0)="Secondary Next of Kin Information"
. S CNT=CNT+1
. S @PNOK@(CNT,0)=$S($G(VAOA(9))'="":$G(VAOA(9)),1:"No Next of Kin Enter")
. S CNT=CNT+1
. S @PNOK@(CNT,0)=$S($G(VAOA(10))'="":"Relationship to Patient: "_VAOA(10),1:"Relationship Unknown")
. S CNT=CNT+1
. I $G(VAOA(1))=""&($G(VAOA(2))="")&($G(VAOA(3))="") S @PNOK@(CNT,0)="No Address Information Enter"
. E D
. . S @PNOK@(CNT,0)=$G(VAOA(1))
. . I $G(VAOA(2))'="" S @PNOK@(CNT,0)=@PNOK@(CNT,0)_" "_VAOA(2)
. . I $G(VAOA(3))'="" S CNT=CNT+1 S @PNOK@(CNT,0)=VAOA(3)
. S CNT=CNT+1
. I $G(VAOA(4))'="" S @PNOK@(CNT,0)=$G(VAOA(4))_", "_$P($G(VAOA(5)),U,2)_" "_$G(VAOA(6))
. I $G(VAOA(8))'="" S CNT=CNT+1 S @PNOK@(CNT,0)="Home Phone Number: "_VAOA(8)
E Q "No Next Kin Information Found"
Q "~@"_$NA(@PNOK)
;
VITALS(DFN,TEST,COUNT,TPERIOD) ; Return vitals for last 24 hours.
N %,CNT,DATE,END,GMRVSTR,IEN,INVDATE,NODE,START,TIUVITAL,VITAL,VITALS
K ^TMP($J,"TIUWRIIS","VITALS")
K ^UTILITY($J,"GMRVD")
I ($G(TPERIOD)?1"T-"1N.N) D
. D NOW^%DTC S END=%
. D DT^DILF("P",TPERIOD,.DRANGE)
. S START=$G(DRANGE)_"."_$P(END,".",2)
E I $G(TPERIOD)'="" Q "INVALID DATE TIME PERIOD ENTER"
S CNT=1
S DATE=0
S TIUVITAL="^TMP($J,""TIUWRIIS"",""VITALS"")"
S GMRVSTR=$G(TEST)
S GMRVSTR(0)=START_U_END_U_COUNT_U_"1"
D EN1^GMRVUT0
I '$D(^UTILITY($J,"GMRVD")) S @TIUVITAL@(CNT,0)="No Vitals Were Found" Q "~@"_$NA(@TIUVITAL)
S INVDATE="" F S INVDATE=$O(^UTILITY($J,"GMRVD",INVDATE)) Q:+INVDATE=0 D
. S VITAL="" F S VITAL=$O(^UTILITY($J,"GMRVD",INVDATE,VITAL)) Q:VITAL="" D
. .S IEN="" F S IEN=$O(^UTILITY($J,"GMRVD",INVDATE,VITAL,IEN)) Q:+IEN=0 D
. . . S NODE=^UTILITY($J,"GMRVD",INVDATE,VITAL,IEN)
. . . I DATE'=INVDATE D Q
. . . . S @TIUVITAL@(CNT,0)="Vitals Enter at: "_$$FMTE^XLFDT(9999999-INVDATE)
. . . . S CNT=CNT+1
. . . . S DATE=INVDATE
. . . . S @TIUVITAL@(CNT,0)=VITAL_": "_$P($G(NODE),U,8)
. . . . S CNT=CNT+1
. . . I DATE=INVDATE D
. . . . S @TIUVITAL@(CNT,0)=VITAL_": "_$P($G(NODE),U,8)
. . . . S CNT=CNT+1
K ^UTILITY($J,"GMRVD")
Q "~@"_$NA(@TIUVITAL)
PROB(DFN) ; Get total active problem list for a patient
N CNT,CNT1,ROOT,NODE,STRING,TIUPOUT
K ^TMP($J,"TIUWRIIS","PROB")
S TIUPOUT="^TMP($J,""TIUWRIIS"",""PROB"")"
S CNT1=1
D LIST^GMPLUTL2(.ROOT,+DFN,"A")
I '$D(ROOT) Q "No Active Problem Found"
S @TIUPOUT@(CNT1,0)=$$LJ^XLFSTR("Code",10)_$$LJ^XLFSTR("Description",63) S CNT1=CNT1+1
S CNT=0 F S CNT=$O(ROOT(CNT)) Q:'CNT D
. S NODE=$G(ROOT(CNT)) Q:$P($G(NODE),U,10)["$"!($P($G(NODE),U,3)="")
. S STRING=$$LJ^XLFSTR($P($G(NODE),U,4),10)_$P($G(NODE),U,3)
. S @TIUPOUT@(CNT1,0)=STRING
. S CNT1=CNT1+1
Q "~@"_$NA(@TIUPOUT)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUWRIIS 6858 printed Sep 23, 2025@20:22:53 Page 2
TIUWRIIS ;SLC/AJB,AGP - War Related Illness and Injury Study Center ; 08/18/03
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**159,286**;Jun 20, 1997;Build 10
+2 ;;Per VA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
ADDRESS(DFN) ;
+1 NEW TIUCNT,TIUI,TIUY,VAPA
SET TIUI=0
+2 NEW TIUCITY,TIUST,TIUZIP
+3 DO ADD^VADPT
+4 SET TIUY=$NAME(^TMP("TIUWRIISC",$JOB))
+5 FOR TIUCNT=1:1:3
Begin DoDot:1
+6 if VAPA(TIUCNT)=""
QUIT
+7 SET TIUI=TIUI+1
+8 SET @TIUY@(TIUI,0)=VAPA(TIUCNT)
IF TIUCNT>1
SET @TIUY@(TIUI,0)=" "_@TIUY@(TIUI,0)
End DoDot:1
+9 SET TIUCITY=" "_VAPA(4)
+10 SET TIUST=$$GET1^DIQ(5,+VAPA(5),1)
+11 SET TIUZIP=VAPA(6)
+12 ;286 - Format address for Philippines
+13 IF +VAPA(25)=167
Begin DoDot:1
+14 SET TIUST=VAPA(23)
+15 SET TIUZIP=VAPA(24)
End DoDot:1
+16 SET @TIUY@(4,0)=TIUCITY_", "_TIUST_" "_TIUZIP
+17 QUIT "~@"_$NAME(@TIUY)
LAB2(DFN,TIUTEST,COUNT,TPERIOD,TIUEDT,TIULDT) ; Get Lab Results
+1 NEW CNT,DRANGE,INDATE,LABIEN,NUM,OUTPUT,REGDATE,SEQ,SEQ1,SUB,STRING
+2 NEW TIULOUT,TIUY,TIUTST,TIUX,TMP1,TMP2
+3 KILL ^TMP($JOB,"TIUWRIIS","LABOUT"),^TMP("LRRR",$JOB)
+4 IF $GET(TPERIOD)=""
IF $GET(TIUEDT)=""
IF $GET(TIULDT)=""
QUIT "<Invalid Date or Time Period Entered>"
+5 IF ($GET(TPERIOD)?1"T-"1N.N)
Begin DoDot:1
+6 SET TIULDT=$$NOW^XLFDT
DO DT^DILF("P",TPERIOD,.DRANGE)
SET TIUEDT=$GET(DRANGE)
End DoDot:1
+7 IF $GET(COUNT)=""
SET COUNT=1
+8 IF $GET(TIUTEST)=""
QUIT "LAB NAME NOT FOUND"
+9 SET LABIEN=+$ORDER(^LAB(60,"B",TIUTEST,0))
+10 IF '+$GET(LABIEN)
QUIT "INVALID LAB TEST NAME"
+11 DO RR^LR7OR1(DFN,"",$GET(TIUEDT),$GET(TIULDT),"",LABIEN,"",$GET(COUNT),"",0)
+12 IF '$DATA(^TMP("LRRR",$JOB))
QUIT "No Lab Information Found for "_TIUTEST
+13 SET TIULOUT="^TMP($J,""TIUWRIIS"",""LABOUT"")"
SET CNT=1
SET @TIULOUT@(CNT,0)="Lab Information for "_TIUTEST
+14 SET STRING=$$LJ^XLFSTR("Collection Date/Time",25)
SET STRING=STRING_$$LJ^XLFSTR("Specimen",10)
+15 SET STRING=STRING_$$LJ^XLFSTR("Test",8)
SET STRING=STRING_$$LJ^XLFSTR("Result",12)
+16 SET STRING=STRING_$$LJ^XLFSTR("Range",10)
SET CNT=CNT+1
SET @TIULOUT@(CNT,0)=STRING
+17 SET SUB=""
FOR
SET SUB=$ORDER(^TMP("LRRR",$JOB,DFN,SUB))
if SUB=""
QUIT
Begin DoDot:1
+18 SET INDATE=""
FOR
SET INDATE=$ORDER(^TMP("LRRR",$JOB,DFN,SUB,INDATE))
if +INDATE'>0
QUIT
Begin DoDot:2
+19 SET SEQ=""
FOR
SET SEQ=$ORDER(^TMP("LRRR",$JOB,DFN,SUB,INDATE,SEQ))
if SEQ=""
QUIT
Begin DoDot:3
+20 IF SEQ'="N"
Begin DoDot:4
+21 SET CNT=CNT+1
+22 SET REGDATE=$$FMTE^XLFDT(9999999-INDATE)
+23 SET NODE=$GET(^TMP("LRRR",$JOB,DFN,SUB,INDATE,SEQ))
+24 SET STRING=$$LJ^XLFSTR(REGDATE,25)
+25 SET STRING=STRING_$$LJ^XLFSTR($$GET1^DIQ(61,$PIECE($GET(NODE),U,19)_",",.01),10)
+26 SET STRING=STRING_$$LJ^XLFSTR($PIECE($GET(NODE),U,15),8)
+27 SET STRING=STRING_$$LJ^XLFSTR($PIECE($GET(NODE),U,2)_" "_$PIECE($GET(NODE),U,3)_$PIECE($GET(NODE),U,4),12)
+28 SET STRING=STRING_$$LJ^XLFSTR($PIECE($GET(NODE),U,5),10)
+29 SET @TIULOUT@(CNT,0)=STRING
End DoDot:4
+30 IF SEQ="N"
SET SEQ1=""
FOR
SET SEQ1=$ORDER(^TMP("LRRR",$JOB,DFN,SUB,INDATE,SEQ,SEQ1))
if +SEQ1'>0
QUIT
Begin DoDot:4
+31 SET NODE=$GET(^TMP("LRRR",$JOB,DFN,SUB,INDATE,SEQ,SEQ1))
+32 IF $GET(NODE)["["
Begin DoDot:5
+33 SET NAME=$PIECE($GET(NODE),"[",2)
SET NAME=$PIECE($GET(NAME),"]",1)
+34 SET NAME=$$GET1^DIQ(200,$GET(NAME)_",",.01)
+35 SET TMP1=$PIECE($GET(NODE),"[")
SET TMP2=$PIECE($GET(NODE),"]",2)
+36 SET NODE=TMP1_" "_NAME_" "_TMP2
End DoDot:5
+37 SET CNT=CNT+1
SET @TIULOUT@(CNT,0)="Comment: "_NODE
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+38 KILL ^TMP("LRRR",$JOB)
LABQ QUIT "~@"_$NAME(@TIULOUT)
PNOK(DFN) ;
+1 NEW CNT,PNOK,VAOA
+2 KILL ^TMP($JOB,"TIUWRIIS","PNOK")
+3 DO OAD^VADPT
+4 SET CNT=1
+5 SET PNOK="^TMP($J,""TIUWRIIS"",""PNOK"")"
+6 IF $DATA(VAOA)
Begin DoDot:1
+7 SET @PNOK@(CNT,0)="Primary Next of Kin Information"
+8 SET CNT=CNT+1
+9 SET @PNOK@(CNT,0)=$SELECT($GET(VAOA(9))'="":$GET(VAOA(9)),1:"No Next of Kin Enter")
+10 SET CNT=CNT+1
+11 SET @PNOK@(CNT,0)=$SELECT($GET(VAOA(10))'="":"Relationship to Patient: "_VAOA(10),1:"Relationship Unknown")
+12 SET CNT=CNT+1
+13 IF $GET(VAOA(1))=""&($GET(VAOA(2))="")&($GET(VAOA(3))="")
SET @PNOK@(CNT,0)="No Address Information Enter"
+14 IF '$TEST
Begin DoDot:2
+15 SET @PNOK@(CNT,0)=$GET(VAOA(1))
+16 IF $GET(VAOA(2))'=""
SET @PNOK@(CNT,0)=@PNOK@(CNT,0)_" "_VAOA(2)
+17 IF $GET(VAOA(3))'=""
SET CNT=CNT+1
SET @PNOK@(CNT,0)=VAOA(3)
End DoDot:2
+18 SET CNT=CNT+1
+19 IF $GET(VAOA(4))'=""
SET @PNOK@(CNT,0)=$GET(VAOA(4))_", "_$PIECE($GET(VAOA(5)),U,2)_" "_$GET(VAOA(6))
+20 IF $GET(VAOA(8))'=""
SET CNT=CNT+1
SET @PNOK@(CNT,0)="Home Phone Number: "_VAOA(8)
End DoDot:1
+21 IF '$TEST
QUIT "No Next Kin Information Found"
+22 QUIT "~@"_$NAME(@PNOK)
+23 ;
SNOK(DFN) ;
+1 NEW CNT,VAOA
+2 KILL ^TMP($JOB,"TIUWRIIS","SNOK")
+3 SET VAOA("A")=3
+4 DO OAD^VADPT
+5 SET CNT=1
+6 SET PNOK="^TMP($J,""TIUWRIIS"",""SNOK"")"
+7 IF $DATA(VAOA)
Begin DoDot:1
+8 SET @PNOK@(CNT,0)="Secondary Next of Kin Information"
+9 SET CNT=CNT+1
+10 SET @PNOK@(CNT,0)=$SELECT($GET(VAOA(9))'="":$GET(VAOA(9)),1:"No Next of Kin Enter")
+11 SET CNT=CNT+1
+12 SET @PNOK@(CNT,0)=$SELECT($GET(VAOA(10))'="":"Relationship to Patient: "_VAOA(10),1:"Relationship Unknown")
+13 SET CNT=CNT+1
+14 IF $GET(VAOA(1))=""&($GET(VAOA(2))="")&($GET(VAOA(3))="")
SET @PNOK@(CNT,0)="No Address Information Enter"
+15 IF '$TEST
Begin DoDot:2
+16 SET @PNOK@(CNT,0)=$GET(VAOA(1))
+17 IF $GET(VAOA(2))'=""
SET @PNOK@(CNT,0)=@PNOK@(CNT,0)_" "_VAOA(2)
+18 IF $GET(VAOA(3))'=""
SET CNT=CNT+1
SET @PNOK@(CNT,0)=VAOA(3)
End DoDot:2
+19 SET CNT=CNT+1
+20 IF $GET(VAOA(4))'=""
SET @PNOK@(CNT,0)=$GET(VAOA(4))_", "_$PIECE($GET(VAOA(5)),U,2)_" "_$GET(VAOA(6))
+21 IF $GET(VAOA(8))'=""
SET CNT=CNT+1
SET @PNOK@(CNT,0)="Home Phone Number: "_VAOA(8)
End DoDot:1
+22 IF '$TEST
QUIT "No Next Kin Information Found"
+23 QUIT "~@"_$NAME(@PNOK)
+24 ;
VITALS(DFN,TEST,COUNT,TPERIOD) ; Return vitals for last 24 hours.
+1 NEW %,CNT,DATE,END,GMRVSTR,IEN,INVDATE,NODE,START,TIUVITAL,VITAL,VITALS
+2 KILL ^TMP($JOB,"TIUWRIIS","VITALS")
+3 KILL ^UTILITY($JOB,"GMRVD")
+4 IF ($GET(TPERIOD)?1"T-"1N.N)
Begin DoDot:1
+5 DO NOW^%DTC
SET END=%
+6 DO DT^DILF("P",TPERIOD,.DRANGE)
+7 SET START=$GET(DRANGE)_"."_$PIECE(END,".",2)
End DoDot:1
+8 IF '$TEST
IF $GET(TPERIOD)'=""
QUIT "INVALID DATE TIME PERIOD ENTER"
+9 SET CNT=1
+10 SET DATE=0
+11 SET TIUVITAL="^TMP($J,""TIUWRIIS"",""VITALS"")"
+12 SET GMRVSTR=$GET(TEST)
+13 SET GMRVSTR(0)=START_U_END_U_COUNT_U_"1"
+14 DO EN1^GMRVUT0
+15 IF '$DATA(^UTILITY($JOB,"GMRVD"))
SET @TIUVITAL@(CNT,0)="No Vitals Were Found"
QUIT "~@"_$NAME(@TIUVITAL)
+16 SET INVDATE=""
FOR
SET INVDATE=$ORDER(^UTILITY($JOB,"GMRVD",INVDATE))
if +INVDATE=0
QUIT
Begin DoDot:1
+17 SET VITAL=""
FOR
SET VITAL=$ORDER(^UTILITY($JOB,"GMRVD",INVDATE,VITAL))
if VITAL=""
QUIT
Begin DoDot:2
+18 SET IEN=""
FOR
SET IEN=$ORDER(^UTILITY($JOB,"GMRVD",INVDATE,VITAL,IEN))
if +IEN=0
QUIT
Begin DoDot:3
+19 SET NODE=^UTILITY($JOB,"GMRVD",INVDATE,VITAL,IEN)
+20 IF DATE'=INVDATE
Begin DoDot:4
+21 SET @TIUVITAL@(CNT,0)="Vitals Enter at: "_$$FMTE^XLFDT(9999999-INVDATE)
+22 SET CNT=CNT+1
+23 SET DATE=INVDATE
+24 SET @TIUVITAL@(CNT,0)=VITAL_": "_$PIECE($GET(NODE),U,8)
+25 SET CNT=CNT+1
End DoDot:4
QUIT
+26 IF DATE=INVDATE
Begin DoDot:4
+27 SET @TIUVITAL@(CNT,0)=VITAL_": "_$PIECE($GET(NODE),U,8)
+28 SET CNT=CNT+1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+29 KILL ^UTILITY($JOB,"GMRVD")
+30 QUIT "~@"_$NAME(@TIUVITAL)
PROB(DFN) ; Get total active problem list for a patient
+1 NEW CNT,CNT1,ROOT,NODE,STRING,TIUPOUT
+2 KILL ^TMP($JOB,"TIUWRIIS","PROB")
+3 SET TIUPOUT="^TMP($J,""TIUWRIIS"",""PROB"")"
+4 SET CNT1=1
+5 DO LIST^GMPLUTL2(.ROOT,+DFN,"A")
+6 IF '$DATA(ROOT)
QUIT "No Active Problem Found"
+7 SET @TIUPOUT@(CNT1,0)=$$LJ^XLFSTR("Code",10)_$$LJ^XLFSTR("Description",63)
SET CNT1=CNT1+1
+8 SET CNT=0
FOR
SET CNT=$ORDER(ROOT(CNT))
if 'CNT
QUIT
Begin DoDot:1
+9 SET NODE=$GET(ROOT(CNT))
if $PIECE($GET(NODE),U,10)["$"!($PIECE($GET(NODE),U,3)="")
QUIT
+10 SET STRING=$$LJ^XLFSTR($PIECE($GET(NODE),U,4),10)_$PIECE($GET(NODE),U,3)
+11 SET @TIUPOUT@(CNT1,0)=STRING
+12 SET CNT1=CNT1+1
End DoDot:1
+13 QUIT "~@"_$NAME(@TIUPOUT)
