source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUROR.m@ 761

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

initial load of FOIAVistA 6/30/08 version
File size: 8.5 KB
Line 
1TIUROR ;SLC/JER - New PATIENT Review screen ; 9/5/01
2 ;;1.0;TEXT INTEGRATION UTILITIES;**10,86,88,100,123,143**;Jun 20, 1997
3 ; Split rtn into TIUROR & TIUROR1 11/27/00
4EN ; -- main entry point for TIU OE/RR REVIEW PN
5 D EN^VALM("TIU OE/RR REVIEW PN")
6 Q
7 ;
8HDR ; -- header code
9 N TIUCTXT,TIUPNM,TIUSSN,TIULOC,TIUDOB,TIUHDR,TIUCWAD,TIUDCNT,VADM,VA
10 N TIUDFN I +$D(@VALMAR@(0))'>0 S VALMQUIT=1 Q
11 S TIUDFN=+$G(@VALMAR@("DFN"))
12 S TIUCWAD=$$CWAD^GMRPNOR1(TIUDFN) S:TIUCWAD]"" TIUCWAD="<"_TIUCWAD_">"
13 S TIUDCNT=$J($S($G(@VALMAR@("CTXT"))="INIT":"Last ",1:"")_+@VALMAR@(0)_" note(s)",16)
14 S TIUCTXT=$$UP^XLFSTR($$PNAME^TIULC1(@VALMAR@("CLASS")))
15 S TIUCTXT=$$TITLE^TIUU(TIUCTXT)
16 S TIUHDR=$$SETSTR^VALM1(TIUCWAD,$G(TIUHDR),1,20)
17 S TIUHDR=$$SETSTR^VALM1(TIUCTXT,$G(TIUHDR),27,28)
18 S TIUHDR=$$SETSTR^VALM1(TIUDCNT,$G(TIUHDR),64,16)
19 S VALMHDR(1)=TIUHDR,TIUHDR=""
20 S TIUPNM=$$NAME^TIULO(TIUDFN),TIUSSN=$$SSN^TIULO(TIUDFN)
21 S TIUDOB=$$DOB^TIULO(TIUDFN)_" ("_$$AGE^TIULO(TIUDFN)_")"
22 S TIULOC=$G(^DPT(+TIUDFN,.1))
23 S:TIULOC]"" TIULOC=TIULOC_"/"_$G(^DPT(+TIUDFN,.101))
24 S TIUHDR=$$SETSTR^VALM1(TIUPNM,$G(TIUHDR),1,20)
25 S TIUHDR=$$SETSTR^VALM1(TIUSSN,$G(TIUHDR),22,11)
26 S TIUHDR=$$SETSTR^VALM1(TIULOC,$G(TIUHDR),35,20)
27 S TIUHDR=$$SETSTR^VALM1(TIUDOB,$G(TIUHDR),64,16)
28 S VALMHDR(2)=TIUHDR
29 Q
30 ;
31INIT(CLASS,CONTEXT,DFN,TIUOCC) ; -- init variables and list array
32 N TIUR,TIUI,TIUY,TIUPICK,TIUQUIT,TIUCCTXT,TIUDUZ,TIUERLY,TIULATE
33 N TIUPREF,TIUOCTXT,TIURCTXT,TIUSEQ,TIUDPRM
34 N DUOUT,DTOUT,DIROUT ;1/8/01
35 I $G(@VALMAR@("SEQ"))]"" S TIUSEQ=$G(@VALMAR@("SEQ"))
36 I +$G(@VALMAR@("CTXT")) S TIURCTXT=$G(@VALMAR@("CTXT"))
37 K @VALMAR,VALMCNT,^TMP("TIURIDX",$J)
38 K ^TMP("TIUYARRAY",$J) ; TIU*1.0*143
39 S TIUPREF=$$PERSPRF^TIULE(DUZ)
40 S TIUSEQ=$G(TIUSEQ,$S($P(TIUPREF,U,4)="A":"A",1:"D"))
41 S TIUPICK=+$O(^ORD(101,"B","TIU ACTION SELECT LIST ELEMENT",0))
42 S DFN=$S(+$G(DFN):+$G(DFN),+$G(ORVP):+$G(ORVP),1:+$$PATIENT^TIULA)
43 I $S($D(DUOUT):1,$D(DTOUT):1,$D(DIROUT):1,+$G(DFN)'>0:1,1:0) S VALMQUIT=1 Q
44 I +$G(CONTEXT)'=9999,'+$G(TIUOCC) S TIUOCC=$S(+$P(TIUPREF,U,10):+$P(TIUPREF,U,10),1:100)
45 S ^TMP("TIUR",$J,"RTN")="TIUROR"
46 I '$O(^TIU(8925,"ACLPT",CLASS,DFN,0)),'$O(^TIU(8925,"ACLAU",CLASS,DUZ,DFN,0)),'$O(^TIU(8925,"ACLEC",CLASS,DUZ,DFN,0)) D Q:$G(CONTEXT)'=9999
47 . N TIUST
48 . S TIUST=$S(CONTEXT=2:"UNSIGNED ",CONTEXT=3:"UNCOSIGNED ",1:"SIGNED ")
49 . S VALMCNT=2,^TMP("TIUR",$J,0)=0
50 . S ^TMP("TIUR",$J,1,0)=""
51 . S ^TMP("TIUR",$J,2,0)="No "_TIUST_$$UP^XLFSTR($$PNAME^TIULC1(CLASS))_" Available for "_$$PTNAME^TIULC1(DFN)
52 . S TIUOCTXT=CONTEXT
53 . I CONTEXT=4 S TIUOCTXT=TIUOCTXT_U_TIUDUZ
54 . I CONTEXT=5 S TIUOCTXT=TIUOCTXT_U_+TIUERLY_U_+TIULATE
55 . S ^TMP("TIUR",$J,"SEQ")=$G(TIUSEQ)
56 . S ^TMP("TIUR",$J,"CLASS")=CLASS,^("DFN")=DFN,^("CTXT")=TIUOCTXT D HDR
57 I $G(CONTEXT)=9999 S TIUCCTXT=1,TIUOCC=9999999
58 ; -- Set vars needed for RBLD if user ^s:
59 S ^TMP("TIUR",$J,"CLASS")=CLASS,^("DFN")=DFN,^("OCC")=TIUOCC,^("CTXT")=+$G(TIURCTXT)
60 S CONTEXT=$S($G(CONTEXT)=9999:$$ASKCTXT^TIUROR1,+$G(CONTEXT):+$G(CONTEXT),1:1)
61 ; -- 1=Signed 2=Unsigned 3=Uncosigned 4=Signed/Author 5=Signed/Date --
62 I $S($D(DIROUT):1,$D(DUOUT):1,$D(DTOUT):1,1:0) D RBLD Q
63 I $S(CONTEXT=1:1,CONTEXT=2:1,CONTEXT=3:1,1:0) S TIUERLY="",TIULATE="",TIUDUZ=DUZ
64 I CONTEXT=4 D Q:+$G(TIUQUIT)>0
65 . S TIUERLY="",TIULATE=""
66 . S TIUDUZ=$S(+$G(TIURCTXT)'=4:+$$AUTHOR^TIULA2(1),+$P(TIURCTXT,U,2)'>0:+$$AUTHOR^TIULA2(1),+$G(TIUCCTXT):+$$AUTHOR^TIULA2(1),1:+$P(TIURCTXT,U,2))
67 . I $S($D(DUOUT):1,$D(DTOUT):1,$D(DIROUT):1,+$G(TIUDUZ)'>0:1,1:0) S TIUQUIT=1 D RBLD Q ; changed DIRUT to DTOUT. 10/20/00
68 . S TIUSEQ=$S(+$G(TIUCCTXT):$P($$ASKSEQ^TIULA3(TIUSEQ),U),$G(TIUSEQ)']"":$P($$ASKSEQ^TIULA3(TIUSEQ),U),1:$G(TIUSEQ))
69 . I $S($D(DIROUT):1,$D(DUOUT):1,$D(DTOUT):1,1:0) S TIUQUIT=1 D RBLD
70 I CONTEXT=5 D Q:+$G(TIUQUIT)>0
71 . S TIUDUZ=+$G(DUZ)
72 . S TIUERLY=$S(+$G(TIURCTXT)'=5:$$EDATE^TIULA("",7,""),+$P(TIURCTXT,U,2)'>0:$$EDATE^TIULA("",7,""),+$G(TIUCCTXT):$$EDATE^TIULA("",7,""),1:+$P(TIURCTXT,U,2))
73 . I $S($D(DIROUT):1,$D(DUOUT):1,$D(DTOUT):1,1:0) S TIUQUIT=1 D RBLD Q
74 . S TIUERLY=$P(TIUERLY,U)
75 . S TIULATE=$S(+$G(TIURCTXT)'=5:$$LDATE^TIULA("",7,""),+$P(TIURCTXT,U,3)'>0:$$LDATE^TIULA("",7,""),+$G(TIUCCTXT):$$LDATE^TIULA("",7,""),1:+$P(TIURCTXT,U,3))
76 . I $S($D(DIROUT):1,$D(DUOUT):1,$D(DTOUT):1,1:0) S TIUQUIT=1 D RBLD Q
77 . S TIULATE=$P(TIULATE,U)
78 . I TIUERLY>TIULATE D SWAP^TIUR(.TIUERLY,.TIULATE)
79 . I $L(TIULATE,".")=1 D EXPRANGE^TIUR(.TIUERLY,.TIULATE)
80 . S TIUSEQ=$S(+$G(TIUCCTXT):$P($$ASKSEQ^TIULA3(TIUSEQ),U),$G(TIUSEQ)']"":$P($$ASKSEQ^TIULA3(TIUSEQ),U),1:$G(TIUSEQ))
81 . I $S($D(DIROUT):1,$D(DUOUT):1,$D(DTOUT):1,1:0) S TIUQUIT=1 D RBLD
82 I '$G(TIURBLD) W !,"Searching for the progress notes"
83 N TIUEXPKD
84 D CONTEXT^TIUSRVLL(.TIUY,CLASS,CONTEXT,DFN,TIUERLY,TIULATE,TIUDUZ,TIUOCC,TIUSEQ,.TIUEXPKD) W "."
85 ; I $D(TIUY)'>9 D Q ; original code
86 I $D(^TMP("TIUYARRAY",$J))'>9 D Q ; TIU*1.0*143
87 . N TIUST
88 . S TIUST=$S(CONTEXT=2:"UNSIGNED ",CONTEXT=3:"UNCOSIGNED ",1:"SIGNED ")
89 . S VALMCNT=2,^TMP("TIUR",$J,0)=0
90 . S ^TMP("TIUR",$J,1,0)=""
91 . S ^TMP("TIUR",$J,2,0)="No "_TIUST_$$UP^XLFSTR($$PNAME^TIULC1(CLASS))_" Available for "_$$PTNAME^TIULC1(DFN)
92 . S ^TMP("TIUR",$J,"CLASS")=CLASS,^("DFN")=DFN
93 . S TIUOCTXT=CONTEXT
94 . I CONTEXT=4 S TIUOCTXT=TIUOCTXT_U_TIUDUZ
95 . I CONTEXT=5 S TIUOCTXT=TIUOCTXT_U_+TIUERLY_U_+TIULATE
96 . S ^TMP("TIUR",$J,"SEQ")=$G(TIUSEQ)
97 . S ^TMP("TIUR",$J,"CTXT")=$S('+$G(TIUCCTXT):"INIT",1:TIUOCTXT) D HDR
98 S TIUI=""
99 ; F S TIUI=$O(TIUY(TIUI)) Q:TIUI="" D ; original code
100 F S TIUI=$O(^TMP("TIUYARRAY",$J,TIUI)) Q:TIUI="" D ; TIU*1.0*143
101 . N AUT,RDT,STAT,TITL,TIUD0,TIUD12,TIUD13,PREFIX
102 . N TIUGDATA
103 . S TIUD0=$G(^TIU(8925,+^TMP("TIUYARRAY",$J,TIUI),0)),TIUD12=$G(^(12)),TIUD13=$G(^(13)) ; **
104 . ; S TIUD0=$G(^TIU(8925,+TIUY(TIUI),0)),TIUD12=$G(^(12)),TIUD13=$G(^(13)) ; original
105 . S VALMCNT=+$G(VALMCNT)+1 W:(VALMCNT#100'>0) "."
106 . S TITL=$$PNAME^TIULC1(+TIUD0)
107 . I TITL="Addendum" S TITL=TITL_" to "_$$PNAME^TIULC1(+$G(^TIU(8925,+$P(TIUD0,U,6),0)))
108 . ; -- Mark ID note '<' and/or has addendum '+',
109 . S PREFIX=$$PREFIX^TIULA2(+^TMP("TIUYARRAY",$J,TIUI),0) ; TIU*1.0*143
110 . ; S PREFIX=$$PREFIX^TIULA2(+TIUY(TIUI),0) ; original
111 . S TITL=PREFIX_TITL
112 . S AUT=$$NAME^TIULS($$PERSNAME^TIULC1(+$P(TIUD12,U,2)),"LAST,FI")
113 . S RDT=$$DATE^TIULS(+TIUD13,"MM/DD/YY HR:MIN")
114 . S STAT=$$LOW^XLFSTR($P($G(^TIU(8925.6,+$P(TIUD0,U,5),0)),U))
115 . S TIUR=$$SETFLD^VALM1(VALMCNT,$G(TIUR),"NUMBER")
116 . S TIUR=$$SETFLD^VALM1(TITL,$G(TIUR),"TITLE")
117 . S TIUR=$$SETFLD^VALM1(AUT,$G(TIUR),"AUTHOR")
118 . S TIUR=$$SETFLD^VALM1(RDT,$G(TIUR),"REF DATE")
119 . S TIUR=$$SETFLD^VALM1(STAT,$G(TIUR),"STATUS")
120 . S ^TMP("TIUR",$J,VALMCNT,0)=TIUR
121 . S ^TMP("TIUR",$J,0)=VALMCNT
122 . S ^TMP("TIURIDX",$J,VALMCNT)=VALMCNT_U_+^TMP("TIUYARRAY",$J,TIUI)_U_PREFIX ; TIU*1.0*143
123 . ; S ^TMP("TIURIDX",$J,VALMCNT)=VALMCNT_U_+TIUY(TIUI)_U_PREFIX ; original
124 . S ^TMP("TIUR",$J,"IEN",+^TMP("TIUYARRAY",$J,TIUI),VALMCNT)="" ; TIU*1.0*143
125 . ; S ^TMP("TIUR",$J,"IEN",+TIUY(TIUI),VALMCNT)="" ;original
126 . S ^TMP("TIUR",$J,"IDX",VALMCNT,VALMCNT)=""
127 . ; TIUGDATA = 0 or DA^haskid^IDparent^prmsort:
128 . S TIUGDATA=$$IDDATA^TIURECL1(+^TMP("TIUYARRAY",$J,TIUI),TIUD0) ; TIU*1.0*143
129 . ; S TIUGDATA=$$IDDATA^TIURECL1(+TIUY(TIUI),TIUD0) ; original
130 . I $G(TIUGDATA) S ^TMP("TIUR",$J,"IDDATA",+^TMP("TIUYARRAY",$J,TIUI))=TIUGDATA ; TIU*1.0*143
131 . ; I $G(TIUGDATA) S ^TMP("TIUR",$J,"IDDATA",+TIUY(TIUI))=TIUGDATA ; original
132 S ^TMP("TIUR",$J,"#")=TIUPICK_"^1:"_+VALMCNT
133 S ^TMP("TIUR",$J,"CLASS")=CLASS
134 S ^TMP("TIUR",$J,"DFN")=DFN
135 S ^TMP("TIUR",$J,"OCC")=+$G(TIUOCC)
136 S TIUOCTXT=CONTEXT
137 I CONTEXT=4 S TIUOCTXT=TIUOCTXT_U_TIUDUZ
138 I CONTEXT=5 S TIUOCTXT=TIUOCTXT_U_+TIUERLY_U_+TIULATE
139 S ^TMP("TIUR",$J,"SEQ")=$G(TIUSEQ)
140 S ^TMP("TIUR",$J,"CTXT")=$S('+$G(TIUCCTXT)&(VALMCNT'<TIUOCC):"INIT",1:TIUOCTXT)
141 I CONTEXT=1,(+$G(TIUOCC)=9999999) D SAVE^TIUROR1
142 I +$G(TIUCCTXT),$D(^TMP("TIUR",$J,0)) D HDR
143 ; If first build (not rebuild), expand parents to show kids that
144 ;meet criteria:
145 I '$G(TIURBLD),$D(TIUEXPKD) D
146 . D EXPANDKD^TIUR2(.TIUEXPKD,"",CONTEXT)
147 ; K ^TMP("TIUYARRAY",$J) ; TIU*1.0*143
148 Q
149 ;
150EXIT ; -- exit code
151 D CLEAN^VALM10
152 K DFN,VALMY,VALMCNT,VALMKEY,^TMP("TIURSAVE",$J)
153 K ^TMP("TIURIDX",$J)
154 K TIUGLINK ;**100**
155 Q
156 ;
157RBLD ; -- rebuild list after actions
158 N TIUEXP,TIURBLD
159 S TIURBLD=1
160 I +$O(^TMP("TIUR",$J,"EXPAND",0)) D G RBLDX
161 . M TIUEXP=^TMP("TIUR",$J,"EXPAND")
162 . D INIT(+$G(^TMP("TIUR",$J,"CLASS")),+$G(^("CTXT")),+$G(^("DFN")),+$G(^("OCC")))
163 . D RELOAD^TIUROR1(.TIUEXP)
164 . D BREATHE^TIUROR1(1)
165 D INIT(+$G(^TMP("TIUR",$J,"CLASS")),+$G(^("CTXT")),+$G(^("DFN")),+$G(^("OCC")))
166 ;D HDR S VALMBCK="R",VALMBG=1,VALMCNT=+$G(^TMP("TIUR",$J,0))
167 D HDR S VALMBCK="R",VALMCNT=+$G(^TMP("TIUR",$J,0))
168RBLDX I $G(VALMBG)>$G(VALMCNT) S VALMBG=$G(VALMCNT)
169 Q
Note: See TracBrowser for help on using the repository browser.