source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIURP.m@ 949

Last change on this file since 949 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1TIURP ; SLC/JER - List problems for linking ;9/12/00 11:52
2 ;;1.0;TEXT INTEGRATION UTILITIES;**78**;Jun 20, 1997
3MAIN ; Control branching
4 N TIUPL,TIUI
5 D ACTIVE^GMPLUTL(DFN,.TIUPL)
6 I +$G(TIUPL(0))'>0 D NOPROBLM Q
7 D CLEAN^VALM10,BUILD(.TIUPL)
8 Q
9NOPROBLM ; Handle empty list
10 S ^TMP("TIURP",$J,0)=0
11 S ^TMP("TIURP",$J,1,0)=""
12 S ^TMP("TIURP",$J,2,0)="No active problems."
13 Q
14BUILD(TIUPL) ; Build list
15 N TIUI,TIUPICK S (TIUI,VALMCNT)=0
16 S TIUPICK=+$O(^ORD(101,"B","TIU ACTION SELECT LIST ELEMENT",0))
17 F S TIUI=$O(TIUPL(TIUI)) Q:+TIUI'>0 D
18 . N PRBLM,DATE,STATUS,ICD9,LINE S LINE=""
19 . S PRBLM=$$MIXED^TIULS($P($G(TIUPL(TIUI,1)),U,2))
20 . S ICD9="("_$P($G(TIUPL(TIUI,2)),U,2)_")"
21 . S DATE=$$DATE^TIULS($P($G(TIUPL(TIUI,3)),U),"MM/DD/YY")
22 . ;S STATUS=$S($P($G(TIUPL(TIUI,6)),U)="A":" ",1:"i")
23 . S STATUS=$S($$DUPROB^TIURB1(TIUDA,$G(TIUPL(TIUI,0)))=1:"L",1:"")
24 . S LINE=$$SETFLD^VALM1(TIUI,LINE,"NUMBER")
25 . S LINE=$$SETFLD^VALM1(STATUS,LINE,"STATUS")
26 . S LINE=$$SETFLD^VALM1(PRBLM,LINE,"PROBLEM")
27 . S LINE=$$SETFLD^VALM1(ICD9,LINE,"ICD9")
28 . S LINE=$$SETFLD^VALM1(DATE,LINE,"DATE")
29 . S VALMCNT=VALMCNT+1
30 . S ^TMP("TIURP",$J,TIUI,0)=LINE
31 . S ^TMP("TIURP",$J,"IDX",VALMCNT,TIUI)="" W:'TIUI#5 "."
32 . 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))
33 . S ^TMP("TIURP",$J,"#")=TIUPICK_"^1:"_VALMCNT
34 . D FLDCTRL^VALM10(TIUI,"NUMBER",IOINHI,IOINORM)
35 S ^TMP("TIURP",$J,0)=VALMCNT
36 Q
37HDR ; header code
38 N TIUPCNT,TIUID,TIUAGE,TIUDOB,TIUWT,HDR
39 S TIUID=$G(VADM(1))_" "_VA("PID")
40 S TIUDOB=$P($G(VADM(3)),U,2),TIUAGE="("_+$G(VADM(4))_")"
41 S TIUWT="Wt (lb): "_" "
42 S TIUPCNT=$J(+$G(^TMP("TIURP",$J,0)),4)_" active problems"
43 S HDR=$$SETSTR^VALM1(TIUID,$G(HDR),1,38)
44 S HDR=$$SETSTR^VALM1(TIUDOB,$G(HDR),50,11)
45 S HDR=$$SETSTR^VALM1(TIUAGE,$G(HDR),63,$L(TIUAGE))
46 S HDR=$$SETSTR^VALM1(TIUWT,$G(HDR),68,12)
47 S VALMHDR(1)=HDR
48 ;S VALMHDR(1)=$$SETSTR^VALM1(TIUPCNT,VALMHDR(1),(IOM-$L(TIUPCNT)),$L(TIUPCNT))
49 Q
50 ;
51HELP ; -- help code
52 N X
53 W !!?4,"To update the problem list first select from Add, Remove, Edit,"
54 W !?4 W:GMPARAM("VER") "Verify, "
55 W "Inactivate, or Comment, then enter the problem number(s)."
56 W !?4,"If you need more information on a problem, select Detailed"
57 W !?4,"Display; to change whether all or only selected problems for this"
58 W !?4,"patient are listed, choose Select View. Enter ?? to see more"
59 W !?4,"actions for facilitating navigation of the list."
60 W !?4,"Problem statuses: * - Acute I - Inactive"
61 W:GMPARAM("VER") " $ - Unverified"
62 W !!,"Press <return> to continue ... " R X:DTIME
63 S VALMSG=$$MSG^GMPLX,VALMBCK=$S(VALMCC:"",1:"R")
64 Q
65EXIT ; Joel, clean up your mess!
66 K ^TMP("TIURP",$J),^TMP("TIURPIDX",$J)
67 K XQORM("KEY","="),XQORM("XLATE")
68 Q
Note: See TracBrowser for help on using the repository browser.