| 1 | TIURL ; SLC/JER - List Management Library ;2/21/01
|
|---|
| 2 | ;;1.0;TEXT INTEGRATION UTILITIES;**88,100**;Jun 20, 1997
|
|---|
| 3 | ; 11/14/00 Moved UPDATEID, etc to TIURL1
|
|---|
| 4 | ;
|
|---|
| 5 | UPRBLD(TIUCHNG,ITEMS) ; Refreshes, updates, or rebuilds the list
|
|---|
| 6 | ;after various actions. Also restores video.
|
|---|
| 7 | ; Receives optional arrays TIUCHNG, ITEMS by ref.
|
|---|
| 8 | ; Checks TIUCHNG("RBLD"),TIUCHNG("UPDATE"), & TIUCHNG("REFRESH");
|
|---|
| 9 | ;does nothing if none of these is defined.
|
|---|
| 10 | ; Items in ITEMS list are updated (depending on TIUCHNG), and
|
|---|
| 11 | ;their video attributes are restored.
|
|---|
| 12 | N TIUI,TIUREC,TIUJ,RTN
|
|---|
| 13 | S RTN=$G(^TMP("TIUR",$J,"RTN"))
|
|---|
| 14 | ; -- Restore video attributes for selected items:
|
|---|
| 15 | ; (Rebuild code, except for TIUROR, does its own video restore)
|
|---|
| 16 | I '$G(TIUCHNG("RBLD"))!(RTN="TIUROR") D
|
|---|
| 17 | . S TIUJ=0
|
|---|
| 18 | . F S TIUJ=$O(ITEMS(TIUJ)) Q:'TIUJ D
|
|---|
| 19 | . . Q:TIUJ=$P($G(TIUGLINK),U,2) ; Don't restore midattach ID child
|
|---|
| 20 | . . D RESTORE^VALM10(TIUJ)
|
|---|
| 21 | ; -- If TIUROR screen needs changes, it is always
|
|---|
| 22 | ; rebuilt, not updated:
|
|---|
| 23 | I RTN="TIUROR",$G(TIUCHNG("UPDATE")) S TIUCHNG("RBLD")=1
|
|---|
| 24 | ; -- Rebuild, Update, or Refresh list:
|
|---|
| 25 | ; (In cases (e.g.browse) where more than one action
|
|---|
| 26 | ; was performed, TIUCHNG("RBLD") may coexist w TIUCHNG("UPDATE"),
|
|---|
| 27 | ; etc., so order is important.)
|
|---|
| 28 | I $G(TIUCHNG("RBLD")) D Q
|
|---|
| 29 | . W !,"Rebuilding the list..."
|
|---|
| 30 | . I RTN="TIUROR" D RBLD^TIUROR Q
|
|---|
| 31 | . ; -- If not in 2b, pause for feedback ("Rebuilding",
|
|---|
| 32 | . ; "Entry deleted", etc):
|
|---|
| 33 | . H 2
|
|---|
| 34 | . I RTN="TIURM" D RBLD^TIURM Q
|
|---|
| 35 | . I RTN="TIURPTTL" D RBLD^TIURPTTL Q
|
|---|
| 36 | . I RTN="TIURTITL" D RBLD^TIURTITL Q
|
|---|
| 37 | . I RTN="TIUR" D RBLD^TIUR
|
|---|
| 38 | I $G(TIUCHNG("UPDATE")),$D(ITEMS) D Q
|
|---|
| 39 | . S TIUI=""
|
|---|
| 40 | . W !,"Updating the list..."
|
|---|
| 41 | . F S TIUI=$O(ITEMS(TIUI)) Q:'TIUI D
|
|---|
| 42 | . . D SETREC(TIUI,.TIUREC)
|
|---|
| 43 | . . S ^TMP("TIUR",$J,TIUI,0)=TIUREC
|
|---|
| 44 | I $G(TIUCHNG("REFRESH")) D Q
|
|---|
| 45 | . W !,"Refreshing the list..."
|
|---|
| 46 | Q
|
|---|
| 47 | ;
|
|---|
| 48 | SETREC(LINENO,TIUREC,PFIXFLAG) ; Update line LINENO with [new prefix], new flds
|
|---|
| 49 | ; Combined fields so that SETREC works for MIS as well as
|
|---|
| 50 | ;CLINICIAN LM templates
|
|---|
| 51 | ; PFIXFLAG=1: update prefix (as well as other flds).
|
|---|
| 52 | ; New prefix is for unexpanded state of line.
|
|---|
| 53 | N DIC,DIQ,DA,DR,TIUR,ADT,DDT,LCT,AUT,AMD,EDT,SDT,TIULST4
|
|---|
| 54 | N MOM,DOC,MISEDT,ITEMNODE
|
|---|
| 55 | S ITEMNODE=^TMP("TIURIDX",$J,LINENO)
|
|---|
| 56 | S DA=+$P(ITEMNODE,U,2)
|
|---|
| 57 | S DIQ="TIUR",DIC=8925,DIQ(0)="IE"
|
|---|
| 58 | S DR=".01;.02;.05;.07;.08;.1;1202;1204;1208;1209;1301;1307;1501;1507"
|
|---|
| 59 | D EN^DIQ1 Q:$D(TIUR)'>9
|
|---|
| 60 | S DOC=$$PNAME^TIULC1(+TIUR(8925,DA,.01,"I"))
|
|---|
| 61 | I DOC="Addendum" D
|
|---|
| 62 | . S MOM=+$P(^TIU(8925,DA,0),U,6)
|
|---|
| 63 | . S DOC=DOC_" to "_$$PNAME^TIULC1(+$G(^TIU(8925,MOM,0)))
|
|---|
| 64 | S TIULST4=$E($P($G(^DPT(TIUR(8925,DA,.02,"I"),0)),U,9),6,9)
|
|---|
| 65 | S TIULST4="("_$E(TIUR(8925,DA,.02,"E"))_TIULST4_")"
|
|---|
| 66 | S ADT=$$DATE^TIULS(TIUR(8925,DA,.07,"I"),"MM/DD/YY")
|
|---|
| 67 | S DDT=$$DATE^TIULS(TIUR(8925,DA,.08,"I"),"MM/DD/YY")
|
|---|
| 68 | S AMD=$$NAME^TIULS(TIUR(8925,DA,1208,"E"),"LAST, FI MI")
|
|---|
| 69 | S AUT=$$NAME^TIULS(TIUR(8925,DA,1202,"E"),"LAST, FI MI")
|
|---|
| 70 | S EDT=$$DATE^TIULS(TIUR(8925,DA,1301,"I"),"MM/DD/YY")
|
|---|
| 71 | S MISEDT=$$DATE^TIULS(TIUR(8925,DA,1307,"I"),"MM/DD/YY")
|
|---|
| 72 | S SDT=$S(+TIUR(8925,DA,1507,"I"):TIUR(8925,DA,1507,"I"),TIUR(8925,DA,.05,"I")'<7:+TIUR(8925,DA,1501,"I"),1:"")
|
|---|
| 73 | S SDT=$$DATE^TIULS(SDT,"MM/DD/YY")
|
|---|
| 74 | S LCT=$G(TIUR(8925,DA,.1,"E"))
|
|---|
| 75 | ; -- Set prefix_patient/title into ^TMP("TIUR",$J,LINENO,0),
|
|---|
| 76 | ; then into TIUREC: --
|
|---|
| 77 | I $G(PFIXFLAG) D SETPT^TIURL1(LINENO)
|
|---|
| 78 | S TIUREC=^TMP("TIUR",$J,LINENO,0)
|
|---|
| 79 | ; -- Set other fields into TIUREC: --
|
|---|
| 80 | S TIUREC=$$SETFLD^VALM1(LINENO,TIUREC,"NUMBER")
|
|---|
| 81 | S TIUREC=$$SETFLD^VALM1($$LOWER^TIULS(TIUR(8925,DA,.05,"E")),TIUREC,"STATUS")
|
|---|
| 82 | S TIUREC=$$SETFLD^VALM1(TIULST4,TIUREC,"LAST I/LAST 4")
|
|---|
| 83 | S TIUREC=$$SETFLD^VALM1(DOC,TIUREC,"DOCUMENT TYPE")
|
|---|
| 84 | S:$D(VALMDDF("ADMISSION DATE")) TIUREC=$$SETFLD^VALM1(ADT,TIUREC,"ADMISSION DATE")
|
|---|
| 85 | S:$D(VALMDDF("DISCH DATE")) TIUREC=$$SETFLD^VALM1(AMD,TIUREC,"DISCH DATE")
|
|---|
| 86 | S:$D(VALMDDF("DICT DATE")) TIUREC=$$SETFLD^VALM1(MISEDT,TIUREC,"DICT DATE")
|
|---|
| 87 | S:$D(VALMDDF("LINE COUNT")) TIUREC=$$SETFLD^VALM1(LCT,TIUREC,"LINE COUNT")
|
|---|
| 88 | S:$D(VALMDDF("REF DATE")) TIUREC=$$SETFLD^VALM1(EDT,TIUREC,"REF DATE")
|
|---|
| 89 | S:$D(VALMDDF("SIG DATE")) TIUREC=$$SETFLD^VALM1(SDT,TIUREC,"SIG DATE")
|
|---|
| 90 | S TIUREC=$$SETFLD^VALM1(AUT,TIUREC,"AUTHOR")
|
|---|
| 91 | S:$D(VALMDDF("COSIGNER")) TIUREC=$$SETFLD^VALM1(AMD,TIUREC,"COSIGNER")
|
|---|
| 92 | S:$D(VALMDDF("ATTENDING")) TIUREC=$$SETFLD^VALM1(AMD,TIUREC,"ATTENDING")
|
|---|
| 93 | S ^TMP("TIUR",$J,LINENO,0)=TIUREC
|
|---|
| 94 | Q
|
|---|
