source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIURL.m@ 794

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

initial load of FOIAVistA 6/30/08 version
File size: 4.4 KB
Line 
1TIURL ; SLC/JER - List Management Library ;2/21/01
2 ;;1.0;TEXT INTEGRATION UTILITIES;**88,100,224**;Jun 20, 1997;Build 7
3 ; 11/14/00 Moved UPDATEID, etc to TIURL1
4 ;
5UPRBLD(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 ;VMP/ELR ADDED THE FOLLOWING 2 LINES IN PATCH 224
25 I RTN="TIUR",$G(TIUCHNG("UPDATE")) S TIUCHNG("RBLD")=1
26 I RTN="TIURM",$G(TIUCHNG("UPDATE")) S TIUCHNG("RBLD")=1
27 ; -- Rebuild, Update, or Refresh list:
28 ; (In cases (e.g.browse) where more than one action
29 ; was performed, TIUCHNG("RBLD") may coexist w TIUCHNG("UPDATE"),
30 ; etc., so order is important.)
31 I $G(TIUCHNG("RBLD")) D Q
32 . W !,"Rebuilding the list..."
33 . I RTN="TIUROR" D RBLD^TIUROR Q
34 . ; -- If not in 2b, pause for feedback ("Rebuilding",
35 . ; "Entry deleted", etc):
36 . H 2
37 . I RTN="TIURM" D RBLD^TIURM Q
38 . I RTN="TIURPTTL" D RBLD^TIURPTTL Q
39 . I RTN="TIURTITL" D RBLD^TIURTITL Q
40 . I RTN="TIUR" D RBLD^TIUR
41 I $G(TIUCHNG("UPDATE")),$D(ITEMS) D Q
42 . S TIUI=""
43 . W !,"Updating the list..."
44 . F S TIUI=$O(ITEMS(TIUI)) Q:'TIUI D
45 . . D SETREC(TIUI,.TIUREC)
46 . . ;VMP/ELR ADDED THE FOLLOWING LINE IN PATCH 224
47 . . I $G(TIUREC)="" Q
48 . . S ^TMP("TIUR",$J,TIUI,0)=TIUREC
49 I $G(TIUCHNG("REFRESH")) D Q
50 . W !,"Refreshing the list..."
51 Q
52 ;
53SETREC(LINENO,TIUREC,PFIXFLAG) ; Update line LINENO with [new prefix], new flds
54 ; Combined fields so that SETREC works for MIS as well as
55 ;CLINICIAN LM templates
56 ; PFIXFLAG=1: update prefix (as well as other flds).
57 ; New prefix is for unexpanded state of line.
58 N DIC,DIQ,DA,DR,TIUR,ADT,DDT,LCT,AUT,AMD,EDT,SDT,TIULST4
59 N MOM,DOC,MISEDT,ITEMNODE
60 S ITEMNODE=^TMP("TIURIDX",$J,LINENO)
61 S DA=+$P(ITEMNODE,U,2)
62 S DIQ="TIUR",DIC=8925,DIQ(0)="IE"
63 S DR=".01;.02;.05;.07;.08;.1;1202;1204;1208;1209;1301;1307;1501;1507"
64 D EN^DIQ1 Q:$D(TIUR)'>9
65 S DOC=$$PNAME^TIULC1(+TIUR(8925,DA,.01,"I"))
66 I DOC="Addendum" D
67 . S MOM=+$P(^TIU(8925,DA,0),U,6)
68 . S DOC=DOC_" to "_$$PNAME^TIULC1(+$G(^TIU(8925,MOM,0)))
69 S TIULST4=$E($P($G(^DPT(TIUR(8925,DA,.02,"I"),0)),U,9),6,9)
70 S TIULST4="("_$E(TIUR(8925,DA,.02,"E"))_TIULST4_")"
71 S ADT=$$DATE^TIULS(TIUR(8925,DA,.07,"I"),"MM/DD/YY")
72 S DDT=$$DATE^TIULS(TIUR(8925,DA,.08,"I"),"MM/DD/YY")
73 S AMD=$$NAME^TIULS(TIUR(8925,DA,1208,"E"),"LAST, FI MI")
74 S AUT=$$NAME^TIULS(TIUR(8925,DA,1202,"E"),"LAST, FI MI")
75 S EDT=$$DATE^TIULS(TIUR(8925,DA,1301,"I"),"MM/DD/YY")
76 S MISEDT=$$DATE^TIULS(TIUR(8925,DA,1307,"I"),"MM/DD/YY")
77 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:"")
78 S SDT=$$DATE^TIULS(SDT,"MM/DD/YY")
79 S LCT=$G(TIUR(8925,DA,.1,"E"))
80 ; -- Set prefix_patient/title into ^TMP("TIUR",$J,LINENO,0),
81 ; then into TIUREC: --
82 I $G(PFIXFLAG) D SETPT^TIURL1(LINENO)
83 S TIUREC=^TMP("TIUR",$J,LINENO,0)
84 ; -- Set other fields into TIUREC: --
85 S TIUREC=$$SETFLD^VALM1(LINENO,TIUREC,"NUMBER")
86 S TIUREC=$$SETFLD^VALM1($$LOWER^TIULS(TIUR(8925,DA,.05,"E")),TIUREC,"STATUS")
87 S TIUREC=$$SETFLD^VALM1(TIULST4,TIUREC,"LAST I/LAST 4")
88 S TIUREC=$$SETFLD^VALM1(DOC,TIUREC,"DOCUMENT TYPE")
89 S:$D(VALMDDF("ADMISSION DATE")) TIUREC=$$SETFLD^VALM1(ADT,TIUREC,"ADMISSION DATE")
90 S:$D(VALMDDF("DISCH DATE")) TIUREC=$$SETFLD^VALM1(AMD,TIUREC,"DISCH DATE")
91 S:$D(VALMDDF("DICT DATE")) TIUREC=$$SETFLD^VALM1(MISEDT,TIUREC,"DICT DATE")
92 S:$D(VALMDDF("LINE COUNT")) TIUREC=$$SETFLD^VALM1(LCT,TIUREC,"LINE COUNT")
93 S:$D(VALMDDF("REF DATE")) TIUREC=$$SETFLD^VALM1(EDT,TIUREC,"REF DATE")
94 S:$D(VALMDDF("SIG DATE")) TIUREC=$$SETFLD^VALM1(SDT,TIUREC,"SIG DATE")
95 S TIUREC=$$SETFLD^VALM1(AUT,TIUREC,"AUTHOR")
96 S:$D(VALMDDF("COSIGNER")) TIUREC=$$SETFLD^VALM1(AMD,TIUREC,"COSIGNER")
97 S:$D(VALMDDF("ATTENDING")) TIUREC=$$SETFLD^VALM1(AMD,TIUREC,"ATTENDING")
98 S ^TMP("TIUR",$J,LINENO,0)=TIUREC
99 Q
Note: See TracBrowser for help on using the repository browser.