TIURP.m

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

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