TIURP ; SLC/JER - List problems for linking ;9/12/00 11:52
;;1.0;TEXT INTEGRATION UTILITIES;**78**;Jun 20, 1997
MAIN ; Control branching
N TIUPL,TIUI
D ACTIVE^GMPLUTL(DFN,.TIUPL)
I +$G(TIUPL(0))'>0 D NOPROBLM Q
D CLEAN^VALM10,BUILD(.TIUPL)
Q
NOPROBLM ; Handle empty list
S ^TMP("TIURP",$J,0)=0
S ^TMP("TIURP",$J,1,0)=""
S ^TMP("TIURP",$J,2,0)="No active problems."
Q
BUILD(TIUPL) ; Build list
N TIUI,TIUPICK S (TIUI,VALMCNT)=0
S TIUPICK=+$O(^ORD(101,"B","TIU ACTION SELECT LIST ELEMENT",0))
F S TIUI=$O(TIUPL(TIUI)) Q:+TIUI'>0 D
. N PRBLM,DATE,STATUS,ICD9,LINE S LINE=""
. S PRBLM=$$MIXED^TIULS($P($G(TIUPL(TIUI,1)),U,2))
. S ICD9="("_$P($G(TIUPL(TIUI,2)),U,2)_")"
. S DATE=$$DATE^TIULS($P($G(TIUPL(TIUI,3)),U),"MM/DD/YY")
. ;S STATUS=$S($P($G(TIUPL(TIUI,6)),U)="A":" ",1:"i")
. S STATUS=$S($$DUPROB^TIURB1(TIUDA,$G(TIUPL(TIUI,0)))=1:"L",1:"")
. S LINE=$$SETFLD^VALM1(TIUI,LINE,"NUMBER")
. S LINE=$$SETFLD^VALM1(STATUS,LINE,"STATUS")
. S LINE=$$SETFLD^VALM1(PRBLM,LINE,"PROBLEM")
. S LINE=$$SETFLD^VALM1(ICD9,LINE,"ICD9")
. S LINE=$$SETFLD^VALM1(DATE,LINE,"DATE")
. S VALMCNT=VALMCNT+1
. S ^TMP("TIURP",$J,TIUI,0)=LINE
. S ^TMP("TIURP",$J,"IDX",VALMCNT,TIUI)="" W:'TIUI#5 "."
. S ^TMP("TIURPIDX",$J,TIUI)=TIUI_U_+$G(TIUPL(TIUI,0))_U_U_+$G(TIUPL(TIUI,1))_U_$P($G(TIUPL(TIUI,1)),U,2)_U_+$G(TIUPL(TIUI,2))
. S ^TMP("TIURP",$J,"#")=TIUPICK_"^1:"_VALMCNT
. D FLDCTRL^VALM10(TIUI,"NUMBER",IOINHI,IOINORM)
S ^TMP("TIURP",$J,0)=VALMCNT
Q
HDR ; header code
N TIUPCNT,TIUID,TIUAGE,TIUDOB,TIUWT,HDR
S TIUID=$G(VADM(1))_" "_VA("PID")
S TIUDOB=$P($G(VADM(3)),U,2),TIUAGE="("_+$G(VADM(4))_")"
S TIUWT="Wt (lb): "_" "
S TIUPCNT=$J(+$G(^TMP("TIURP",$J,0)),4)_" active problems"
S HDR=$$SETSTR^VALM1(TIUID,$G(HDR),1,38)
S HDR=$$SETSTR^VALM1(TIUDOB,$G(HDR),50,11)
S HDR=$$SETSTR^VALM1(TIUAGE,$G(HDR),63,$L(TIUAGE))
S HDR=$$SETSTR^VALM1(TIUWT,$G(HDR),68,12)
S VALMHDR(1)=HDR
;S VALMHDR(1)=$$SETSTR^VALM1(TIUPCNT,VALMHDR(1),(IOM-$L(TIUPCNT)),$L(TIUPCNT))
Q
;
HELP ; -- help code
N X
W !!?4,"To update the problem list first select from Add, Remove, Edit,"
W !?4 W:GMPARAM("VER") "Verify, "
W "Inactivate, or Comment, then enter the problem number(s)."
W !?4,"If you need more information on a problem, select Detailed"
W !?4,"Display; to change whether all or only selected problems for this"
W !?4,"patient are listed, choose Select View. Enter ?? to see more"
W !?4,"actions for facilitating navigation of the list."
W !?4,"Problem statuses: * - Acute I - Inactive"
W:GMPARAM("VER") " $ - Unverified"
W !!,"Press <return> to continue ... " R X:DTIME
S VALMSG=$$MSG^GMPLX,VALMBCK=$S(VALMCC:"",1:"R")
Q
EXIT ; Joel, clean up your mess!
K ^TMP("TIURP",$J),^TMP("TIURPIDX",$J)
K XQORM("KEY","="),XQORM("XLATE")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIURP 2833 printed Nov 22, 2024@17:55:24 Page 2
TIURP ; SLC/JER - List problems for linking ;9/12/00 11:52
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**78**;Jun 20, 1997
MAIN ; Control branching
+1 NEW TIUPL,TIUI
+2 DO ACTIVE^GMPLUTL(DFN,.TIUPL)
+3 IF +$GET(TIUPL(0))'>0
DO NOPROBLM
QUIT
+4 DO CLEAN^VALM10
DO BUILD(.TIUPL)
+5 QUIT
NOPROBLM ; Handle empty list
+1 SET ^TMP("TIURP",$JOB,0)=0
+2 SET ^TMP("TIURP",$JOB,1,0)=""
+3 SET ^TMP("TIURP",$JOB,2,0)="No active problems."
+4 QUIT
BUILD(TIUPL) ; Build list
+1 NEW TIUI,TIUPICK
SET (TIUI,VALMCNT)=0
+2 SET TIUPICK=+$ORDER(^ORD(101,"B","TIU ACTION SELECT LIST ELEMENT",0))
+3 FOR
SET TIUI=$ORDER(TIUPL(TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+4 NEW PRBLM,DATE,STATUS,ICD9,LINE
SET LINE=""
+5 SET PRBLM=$$MIXED^TIULS($PIECE($GET(TIUPL(TIUI,1)),U,2))
+6 SET ICD9="("_$PIECE($GET(TIUPL(TIUI,2)),U,2)_")"
+7 SET DATE=$$DATE^TIULS($PIECE($GET(TIUPL(TIUI,3)),U),"MM/DD/YY")
+8 ;S STATUS=$S($P($G(TIUPL(TIUI,6)),U)="A":" ",1:"i")
+9 SET STATUS=$SELECT($$DUPROB^TIURB1(TIUDA,$GET(TIUPL(TIUI,0)))=1:"L",1:"")
+10 SET LINE=$$SETFLD^VALM1(TIUI,LINE,"NUMBER")
+11 SET LINE=$$SETFLD^VALM1(STATUS,LINE,"STATUS")
+12 SET LINE=$$SETFLD^VALM1(PRBLM,LINE,"PROBLEM")
+13 SET LINE=$$SETFLD^VALM1(ICD9,LINE,"ICD9")
+14 SET LINE=$$SETFLD^VALM1(DATE,LINE,"DATE")
+15 SET VALMCNT=VALMCNT+1
+16 SET ^TMP("TIURP",$JOB,TIUI,0)=LINE
+17 SET ^TMP("TIURP",$JOB,"IDX",VALMCNT,TIUI)=""
if 'TIUI#5
WRITE "."
+18 SET ^TMP("TIURPIDX",$JOB,TIUI)=TIUI_U_+$GET(TIUPL(TIUI,0))_U_U_+$GET(TIUPL(TIUI,1))_U_$PIECE($GET(TIUPL(TIUI,1)),U,2)_U_+$GET(TIUPL(TIUI,2))
+19 SET ^TMP("TIURP",$JOB,"#")=TIUPICK_"^1:"_VALMCNT
+20 DO FLDCTRL^VALM10(TIUI,"NUMBER",IOINHI,IOINORM)
End DoDot:1
+21 SET ^TMP("TIURP",$JOB,0)=VALMCNT
+22 QUIT
HDR ; header code
+1 NEW TIUPCNT,TIUID,TIUAGE,TIUDOB,TIUWT,HDR
+2 SET TIUID=$GET(VADM(1))_" "_VA("PID")
+3 SET TIUDOB=$PIECE($GET(VADM(3)),U,2)
SET TIUAGE="("_+$GET(VADM(4))_")"
+4 SET TIUWT="Wt (lb): "_" "
+5 SET TIUPCNT=$JUSTIFY(+$GET(^TMP("TIURP",$JOB,0)),4)_" active problems"
+6 SET HDR=$$SETSTR^VALM1(TIUID,$GET(HDR),1,38)
+7 SET HDR=$$SETSTR^VALM1(TIUDOB,$GET(HDR),50,11)
+8 SET HDR=$$SETSTR^VALM1(TIUAGE,$GET(HDR),63,$LENGTH(TIUAGE))
+9 SET HDR=$$SETSTR^VALM1(TIUWT,$GET(HDR),68,12)
+10 SET VALMHDR(1)=HDR
+11 ;S VALMHDR(1)=$$SETSTR^VALM1(TIUPCNT,VALMHDR(1),(IOM-$L(TIUPCNT)),$L(TIUPCNT))
+12 QUIT
+13 ;
HELP ; -- help code
+1 NEW X
+2 WRITE !!?4,"To update the problem list first select from Add, Remove, Edit,"
+3 WRITE !?4
if GMPARAM("VER")
WRITE "Verify, "
+4 WRITE "Inactivate, or Comment, then enter the problem number(s)."
+5 WRITE !?4,"If you need more information on a problem, select Detailed"
+6 WRITE !?4,"Display; to change whether all or only selected problems for this"
+7 WRITE !?4,"patient are listed, choose Select View. Enter ?? to see more"
+8 WRITE !?4,"actions for facilitating navigation of the list."
+9 WRITE !?4,"Problem statuses: * - Acute I - Inactive"
+10 if GMPARAM("VER")
WRITE " $ - Unverified"
+11 WRITE !!,"Press <return> to continue ... "
READ X:DTIME
+12 SET VALMSG=$$MSG^GMPLX
SET VALMBCK=$SELECT(VALMCC:"",1:"R")
+13 QUIT
EXIT ; Joel, clean up your mess!
+1 KILL ^TMP("TIURP",$JOB),^TMP("TIURPIDX",$JOB)
+2 KILL XQORM("KEY","="),XQORM("XLATE")
+3 QUIT
