Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIUWRIIS

TIUWRIIS.m

Go to the documentation of this file. 
  1. 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
  1.  ;;Per VA Directive 6402, this routine should not be modified
  1.  ;
  1.  Q
  1. ADDRESS(DFN) ;
  1.  N TIUCNT,TIUI,TIUY,VAPA S TIUI=0
  1.  N TIUCITY,TIUST,TIUZIP
  1.  D ADD^VADPT
  1.  S TIUY=$NA(^TMP("TIUWRIISC",$J))
  1.  F TIUCNT=1:1:3 D
  1.  . Q:VAPA(TIUCNT)=""
  1.  . S TIUI=TIUI+1
  1.  . S @TIUY@(TIUI,0)=VAPA(TIUCNT) I TIUCNT>1 S @TIUY@(TIUI,0)="             "_@TIUY@(TIUI,0)
  1.  S TIUCITY="             "_VAPA(4)
  1.  S TIUST=$$GET1^DIQ(5,+VAPA(5),1)
  1.  S TIUZIP=VAPA(6)
  1.  ;286 - Format address for Philippines
  1.  I +VAPA(25)=167 D
  1.  . S TIUST=VAPA(23)
  1.  . S TIUZIP=VAPA(24)
  1.  S @TIUY@(4,0)=TIUCITY_", "_TIUST_"  "_TIUZIP
  1.  Q "~@"_$NA(@TIUY)
  1. LAB2(DFN,TIUTEST,COUNT,TPERIOD,TIUEDT,TIULDT) ; Get Lab Results
  1.  N CNT,DRANGE,INDATE,LABIEN,NUM,OUTPUT,REGDATE,SEQ,SEQ1,SUB,STRING
  1.  N TIULOUT,TIUY,TIUTST,TIUX,TMP1,TMP2
  1.  K ^TMP($J,"TIUWRIIS","LABOUT"),^TMP("LRRR",$J)
  1.  I $G(TPERIOD)="",$G(TIUEDT)="",$G(TIULDT)="" Q "<Invalid Date or Time Period Entered>"
  1.  I ($G(TPERIOD)?1"T-"1N.N) D
  1.  . S TIULDT=$$NOW^XLFDT D DT^DILF("P",TPERIOD,.DRANGE) S TIUEDT=$G(DRANGE)
  1.  I $G(COUNT)="" S COUNT=1
  1.  I $G(TIUTEST)="" Q "LAB NAME NOT FOUND"
  1.  S LABIEN=+$O(^LAB(60,"B",TIUTEST,0))
  1.  I '+$G(LABIEN) Q "INVALID LAB TEST NAME"
  1.  D RR^LR7OR1(DFN,"",$G(TIUEDT),$G(TIULDT),"",LABIEN,"",$G(COUNT),"",0)
  1.  I '$D(^TMP("LRRR",$J)) Q "No Lab Information Found for "_TIUTEST
  1.  S TIULOUT="^TMP($J,""TIUWRIIS"",""LABOUT"")",CNT=1,@TIULOUT@(CNT,0)="Lab Information for "_TIUTEST
  1.  S STRING=$$LJ^XLFSTR("Collection Date/Time",25),STRING=STRING_$$LJ^XLFSTR("Specimen",10)
  1.  S STRING=STRING_$$LJ^XLFSTR("Test",8),STRING=STRING_$$LJ^XLFSTR("Result",12)
  1.  S STRING=STRING_$$LJ^XLFSTR("Range",10),CNT=CNT+1,@TIULOUT@(CNT,0)=STRING
  1.  S SUB="" F  S SUB=$O(^TMP("LRRR",$J,DFN,SUB)) Q:SUB=""  D
  1.  . S INDATE=""  F  S INDATE=$O(^TMP("LRRR",$J,DFN,SUB,INDATE)) Q:+INDATE'>0  D
  1.  . . S SEQ="" F  S SEQ=$O(^TMP("LRRR",$J,DFN,SUB,INDATE,SEQ)) Q:SEQ=""  D
  1.  . . . I SEQ'="N" D
  1.  . . . . S CNT=CNT+1
  1.  . . . . S REGDATE=$$FMTE^XLFDT(9999999-INDATE)
  1.  . . . . S NODE=$G(^TMP("LRRR",$J,DFN,SUB,INDATE,SEQ))
  1.  . . . . S STRING=$$LJ^XLFSTR(REGDATE,25)
  1.  . . . . S STRING=STRING_$$LJ^XLFSTR($$GET1^DIQ(61,$P($G(NODE),U,19)_",",.01),10)
  1.  . . . . S STRING=STRING_$$LJ^XLFSTR($P($G(NODE),U,15),8)
  1.  . . . . S STRING=STRING_$$LJ^XLFSTR($P($G(NODE),U,2)_" "_$P($G(NODE),U,3)_$P($G(NODE),U,4),12)
  1.  . . . . S STRING=STRING_$$LJ^XLFSTR($P($G(NODE),U,5),10)
  1.  . . . . S @TIULOUT@(CNT,0)=STRING
  1.  . . . I SEQ="N" S SEQ1="" F  S SEQ1=$O(^TMP("LRRR",$J,DFN,SUB,INDATE,SEQ,SEQ1)) Q:+SEQ1'>0  D
  1.  . . . . S NODE=$G(^TMP("LRRR",$J,DFN,SUB,INDATE,SEQ,SEQ1))
  1.  . . . . I $G(NODE)["[" D
  1.  . . . . . S NAME=$P($G(NODE),"[",2),NAME=$P($G(NAME),"]",1)
  1.  . . . . . S NAME=$$GET1^DIQ(200,$G(NAME)_",",.01)
  1.  . . . . . S TMP1=$P($G(NODE),"["),TMP2=$P($G(NODE),"]",2)
  1.  . . . . . S NODE=TMP1_" "_NAME_" "_TMP2
  1.  . . . . S CNT=CNT+1,@TIULOUT@(CNT,0)="Comment: "_NODE
  1.  K ^TMP("LRRR",$J)
  1. LABQ Q "~@"_$NA(@TIULOUT)
  1. PNOK(DFN) ;
  1.  N CNT,PNOK,VAOA
  1.  K ^TMP($J,"TIUWRIIS","PNOK")
  1.  D OAD^VADPT
  1.  S CNT=1
  1.  S PNOK="^TMP($J,""TIUWRIIS"",""PNOK"")"
  1.  I $D(VAOA) D
  1.  . S @PNOK@(CNT,0)="Primary Next of Kin Information"
  1.  . S CNT=CNT+1
  1.  . S @PNOK@(CNT,0)=$S($G(VAOA(9))'="":$G(VAOA(9)),1:"No Next of Kin Enter")
  1.  . S CNT=CNT+1
  1.  . S @PNOK@(CNT,0)=$S($G(VAOA(10))'="":"Relationship to Patient: "_VAOA(10),1:"Relationship Unknown")
  1.  . S CNT=CNT+1
  1.  . I $G(VAOA(1))=""&($G(VAOA(2))="")&($G(VAOA(3))="") S @PNOK@(CNT,0)="No Address Information Enter"
  1.  . E  D
  1.  . . S @PNOK@(CNT,0)=$G(VAOA(1))
  1.  . . I $G(VAOA(2))'="" S @PNOK@(CNT,0)=@PNOK@(CNT,0)_" "_VAOA(2)
  1.  . . I $G(VAOA(3))'="" S CNT=CNT+1 S @PNOK@(CNT,0)=VAOA(3)
  1.  . S CNT=CNT+1
  1.  . I $G(VAOA(4))'="" S @PNOK@(CNT,0)=$G(VAOA(4))_", "_$P($G(VAOA(5)),U,2)_" "_$G(VAOA(6))
  1.  . I $G(VAOA(8))'="" S CNT=CNT+1 S @PNOK@(CNT,0)="Home Phone Number: "_VAOA(8)
  1.  E  Q "No Next Kin Information Found"
  1.  Q "~@"_$NA(@PNOK)
  1.  ;
  1. SNOK(DFN) ;
  1.  N CNT,VAOA
  1.  K ^TMP($J,"TIUWRIIS","SNOK")
  1.  S VAOA("A")=3
  1.  D OAD^VADPT
  1.  S CNT=1
  1.  S PNOK="^TMP($J,""TIUWRIIS"",""SNOK"")"
  1.  I $D(VAOA) D
  1.  . S @PNOK@(CNT,0)="Secondary Next of Kin Information"
  1.  . S CNT=CNT+1
  1.  . S @PNOK@(CNT,0)=$S($G(VAOA(9))'="":$G(VAOA(9)),1:"No Next of Kin Enter")
  1.  . S CNT=CNT+1
  1.  . S @PNOK@(CNT,0)=$S($G(VAOA(10))'="":"Relationship to Patient: "_VAOA(10),1:"Relationship Unknown")
  1.  . S CNT=CNT+1
  1.  . I $G(VAOA(1))=""&($G(VAOA(2))="")&($G(VAOA(3))="") S @PNOK@(CNT,0)="No Address Information Enter"
  1.  . E  D
  1.  . . S @PNOK@(CNT,0)=$G(VAOA(1))
  1.  . . I $G(VAOA(2))'="" S @PNOK@(CNT,0)=@PNOK@(CNT,0)_" "_VAOA(2)
  1.  . . I $G(VAOA(3))'="" S CNT=CNT+1 S @PNOK@(CNT,0)=VAOA(3)
  1.  . S CNT=CNT+1
  1.  . I $G(VAOA(4))'="" S @PNOK@(CNT,0)=$G(VAOA(4))_", "_$P($G(VAOA(5)),U,2)_" "_$G(VAOA(6))
  1.  . I $G(VAOA(8))'="" S CNT=CNT+1 S @PNOK@(CNT,0)="Home Phone Number: "_VAOA(8)
  1.  E  Q "No Next Kin Information Found"
  1.  Q "~@"_$NA(@PNOK)
  1.  ;
  1. VITALS(DFN,TEST,COUNT,TPERIOD) ; Return vitals for last 24 hours.
  1.  N %,CNT,DATE,END,GMRVSTR,IEN,INVDATE,NODE,START,TIUVITAL,VITAL,VITALS
  1.  K ^TMP($J,"TIUWRIIS","VITALS")
  1.  K ^UTILITY($J,"GMRVD")
  1.  I ($G(TPERIOD)?1"T-"1N.N) D
  1.  . D NOW^%DTC S END=%
  1.  . D DT^DILF("P",TPERIOD,.DRANGE)
  1.  . S START=$G(DRANGE)_"."_$P(END,".",2)
  1.  E  I $G(TPERIOD)'="" Q "INVALID DATE TIME PERIOD ENTER"
  1.  S CNT=1
  1.  S DATE=0
  1.  S TIUVITAL="^TMP($J,""TIUWRIIS"",""VITALS"")"
  1.  S GMRVSTR=$G(TEST)
  1.  S GMRVSTR(0)=START_U_END_U_COUNT_U_"1"
  1.  D EN1^GMRVUT0
  1.  I '$D(^UTILITY($J,"GMRVD")) S @TIUVITAL@(CNT,0)="No Vitals Were Found" Q "~@"_$NA(@TIUVITAL)
  1.  S INVDATE="" F  S INVDATE=$O(^UTILITY($J,"GMRVD",INVDATE)) Q:+INVDATE=0  D
  1.  . S VITAL="" F  S VITAL=$O(^UTILITY($J,"GMRVD",INVDATE,VITAL)) Q:VITAL=""  D
  1.  . .S IEN="" F  S IEN=$O(^UTILITY($J,"GMRVD",INVDATE,VITAL,IEN)) Q:+IEN=0  D
  1.  . . . S NODE=^UTILITY($J,"GMRVD",INVDATE,VITAL,IEN)
  1.  . . . I DATE'=INVDATE D  Q
  1.  . . . . S @TIUVITAL@(CNT,0)="Vitals Enter at: "_$$FMTE^XLFDT(9999999-INVDATE)
  1.  . . . . S CNT=CNT+1
  1.  . . . . S DATE=INVDATE
  1.  . . . . S @TIUVITAL@(CNT,0)=VITAL_": "_$P($G(NODE),U,8)
  1.  . . . . S CNT=CNT+1
  1.  . . . I DATE=INVDATE D
  1.  . . . . S @TIUVITAL@(CNT,0)=VITAL_": "_$P($G(NODE),U,8)
  1.  . . . . S CNT=CNT+1
  1.  K ^UTILITY($J,"GMRVD")
  1.  Q "~@"_$NA(@TIUVITAL)
  1. PROB(DFN) ; Get total active problem list for a patient
  1.  N CNT,CNT1,ROOT,NODE,STRING,TIUPOUT
  1.  K ^TMP($J,"TIUWRIIS","PROB")
  1.  S TIUPOUT="^TMP($J,""TIUWRIIS"",""PROB"")"
  1.  S CNT1=1
  1.  D LIST^GMPLUTL2(.ROOT,+DFN,"A")
  1.  I '$D(ROOT) Q "No Active Problem Found"
  1.  S @TIUPOUT@(CNT1,0)=$$LJ^XLFSTR("Code",10)_$$LJ^XLFSTR("Description",63) S CNT1=CNT1+1
  1.  S CNT=0 F  S CNT=$O(ROOT(CNT)) Q:'CNT  D
  1.  . S NODE=$G(ROOT(CNT)) Q:$P($G(NODE),U,10)["$"!($P($G(NODE),U,3)="")
  1.  . S STRING=$$LJ^XLFSTR($P($G(NODE),U,4),10)_$P($G(NODE),U,3)
  1.  . S @TIUPOUT@(CNT1,0)=STRING
  1.  . S CNT1=CNT1+1
  1.  Q "~@"_$NA(@TIUPOUT)