source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUSUPN.m@ 862

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

initial load of WorldVistAEHR

File size: 5.3 KB
RevLine 
[613]1TIUSUPN ;;SLC/TT - TIU SIGNED/UNSIGNED List Manager ; 04-FEB-2005
2 ;;1.0;TEXT INTEGRATION UTILITIES;**180**;Jun 20, 1997
3 ;
4 Q
5EN ; -- main entry point for TIU SIGNED/UNSIGNED PN
6 N TIUSDT,TIUEDT
7 W @IOF
8 K ^TMP("TIUPS180",$J),^TMP("TIUSEL",$J),^TMP("VALMAR",$J),^TMP("TIU180",$J)
9 I '$$ASKRNG(.TIUSDT,.TIUEDT) Q
10 D EN^VALM("TIU SIGNED/UNSIGNED")
11 Q
12 ;
13HDR ; -- header code
14 N HDR1,HDR2
15 S HDR1="From "_$$FMTE^XLFDT(TIUSDT)_" to "_$$FMTE^XLFDT(TIUEDT,"D")
16 S HDR2=$P(^TMP("TIU180",$J,"TOTAL"),U)_" "_$S($P(^TMP("TIU180",$J,"TOTAL"),U)=0:"Document",$P(^TMP("TIU180",$J,"TOTAL"),U)=1:"Document",1:"Documents")
17 S VALMHDR(1)=$$SETSTR^VALM1(HDR1,"",(IOM-$L(HDR1))/2,$L(HDR1))
18 S VALMHDR(2)=$$SETSTR^VALM1(HDR2,"",(IOM-$L(HDR2))/2,$L(HDR2))
19 D XQORM
20 Q
21 ;
22INIT ; Create list
23 N TIUDATE,TIUDA,TIUIEN,TIUTM,TIUCNT,TIUDP,TIUNO,TIUTOTAL
24 I '$G(TIUSDT)!'($G(TIUEDT)) Q
25 S TIUDATE=TIUSDT,(TIUCNT,VALMCNT,TIUTOTAL)=0
26 W !!,"Searching for the documents."
27 S TIUTM("STR")=$$NOW^XLFDT
28 F S TIUDATE=$O(^TIU(8925,"F",TIUDATE)) Q:'TIUDATE!(TIUDATE>TIUEDT) D
29 .S TIUIEN=$O(^TIU(8925,"F",TIUDATE,0)),TIUCNT=TIUCNT+1 D GETINFO(TIUIEN)
30 .W:TIUCNT#1000'>0 "."
31 ;
32 S TIUDA="" F S TIUDA=$O(^TMP("TIUPS180",$J,TIUDA)) Q:TIUDA="" D
33 .S TIUTOTAL=+$G(TIUTOTAL)+1
34 .S TIUDP=$$SETSTR^VALM1(TIUTOTAL,"",1,5)
35 .S TIUDP=$$SETSTR^VALM1($P($$GET1^DIQ(8925,TIUDA,.02),",")_","_$E($P($$GET1^DIQ(8925,TIUDA,.02),",",2),1),TIUDP,6,18)
36 .S TIUDP=$$SETSTR^VALM1("("_$$PATFMAT($P(^TIU(8925,TIUDA,0),U,2))_")",TIUDP,19,26)
37 .S TIUDP=$$SETSTR^VALM1(TIUDA,TIUDP,28,36)
38 .S TIUDP=$$SETSTR^VALM1($E($$GET1^DIQ(8925,TIUDA,1502),1,19),TIUDP,38,56)
39 .S TIUDP=$$SETSTR^VALM1($P($$FMTE^XLFDT($P(^TIU(8925,TIUDA,12),U),2),"@"),TIUDP,58,68)
40 .S TIUDP=$$SETSTR^VALM1($$GET1^DIQ(8925,TIUDA,.05),TIUDP,70,100)
41 .D SET^VALM10(TIUTOTAL,TIUDP,TIUDA)
42 S (VALMCNT,^TMP("TIU180",$J,"TOTAL"))=+$G(TIUTOTAL)
43 I +$G(TIUTOTAL)'>0 D
44 .S VALMCNT=1
45 .D SET^VALM10(1," ",0)
46 .S TIUNO="No records found to satisfy search criteria."
47 .S TIUNO=$$SETSTR^VALM1(TIUNO,"",(IOM-$L(TIUNO))/2,$L(TIUNO))
48 .D SET^VALM10(2,TIUNO,0)
49 S TIUTM("END")=$$NOW^XLFDT
50 W !!,"Report started: ",$P($$FMTE^XLFDT(TIUTM("STR")),"@",2)
51 W !,"Report finished: ",$P($$FMTE^XLFDT(TIUTM("END")),"@",2)
52 W !,"Total searched: ",TIUCNT
53 Q
54 ;
55GETINFO(TIUDA1) ;GET SIGNED DOCUMENT BUT UNSIGNED STATUS
56 ; Input -- TIUDA1 TIU Document file (#8925) IEN
57 ;
58 N TIUD0,TIUD15
59 I TIUDA1'>0 Q
60 I '$D(^TIU(8925,TIUDA1,0))!('$D(^TIU(8925,TIUDA1,15))) Q
61 S TIUD0=$G(^TIU(8925,TIUDA1,0)),TIUD15=$G(^TIU(8925,TIUDA1,15))
62 I $P(TIUD0,U,5)=5,$P(TIUD15,U,1)>0 D
63 .S ^TMP("TIUPS180",$J,TIUDA1)=""
64 Q
65 ;
66HELP ; -- help code
67 N DIR
68 I X="?" S DIR("A")="Enter RETURN to continue or '^' to exit",DIR(0)="E"
69 D FULL^VALM1
70 W !!,"The following actions are available:"
71 W !,"Browse Document - View selected documents (if authorized)"
72 W !,"Detailed Display - View detailed display of selected documents (if authorized)"
73 W !,"Update Document - Update the status of selected documents"
74 I $D(DIR("A")) D ^DIR
75 S VALMBCK="R"
76 Q
77 ;
78ASKRNG(TIUBEGDT,TIUENDT) ;Prompt for date range
79 ; Input -- None
80 ; Output -- 1=Successful and 0=Failure
81 ; BEGDT Begin Date
82 ; ENDT End Date
83 N DIRUT,DTOUT,DUOUT,Y
84 W !,"Please specify a date range:",!
85 S TIUBEGDT=+$$READ^TIUU("DA^:DT:E"," Start Reference Date: ")
86 I +$D(DIRUT)!(TIUBEGDT'>0) G ASKRNGQ
87 S TIUENDT=+$$READ^TIUU("DA^"_TIUBEGDT_":DT:E"," Ending Reference Date: ")_"."_235959
88 I +$D(DIRUT)!(TIUENDT'>0) G ASKRNGQ
89 S Y=1
90ASKRNGQ Q +$G(Y)
91 ;
92PATFMAT(TIUPAT) ; format patient as first letter of last name and last 4 SSN
93 N TIUPATN,TIULAST4,TIUINIT
94 I 'TIUPAT Q ""
95 S TIUPATN=$$EXTERNAL^DILFD(8925,.02,"",TIUPAT)
96 S TIULAST4=$E($$GET1^DIQ(2,$G(TIUPAT),.09),6,9)
97 S TIUINIT=$E($P(TIUPATN,","))
98 Q TIUINIT_TIULAST4
99 ;
100EXIT ; -- exit code
101 D XQORM
102 Q
103 ;
104XQORM ; default action for list manager
105 S XQORM("#")=$O(^ORD(101,"B","TIU SIGNED/UNSIGNED SELECT",0))_U_"1:"_VALMCNT
106 Q
107 ;
108ACTIONS ; user selectable actions
109 N ACTION
110 D
111 . N DIR,DIRUT,POP,X,Y
112 . S DIR(0)="SA^1:Browse Document;2:Detailed Display;3:Status Update"
113 . S DIR("A")="Select Action: "
114 . S DIR("B")="Status Update"
115 . S DIR("L",1)="1. Browse Document"
116 . S DIR("L",2)="2. Detailed Display"
117 . S DIR("L",3)="3. Status Update"
118 . S DIR("L",4)=""
119 . S DIR("L")="Enter selection by typing the name, number, or abbreviation"
120 . S DIR("?",1)="The following actions are available:"
121 . S DIR("?",2)=""
122 . S DIR("?",3)="Browse Document - View selected documents (if authorized)"
123 . S DIR("?",4)="Detailed Display - Detailed View of selected documents (if authorized)"
124 . S DIR("?",5)="Status Update - Update the status of selected documents"
125 . D ^DIR Q:$D(DIRUT)
126 . S ACTION=$S(+Y=1:"BROWSE^TIUSUPN1",+Y=2:"DISP^TIUSUPN1",+Y=3:"UPDTDOC^TIUSUPN1",Y=U:-1,1:-1)
127 . Q:ACTION=-1
128 . D @ACTION
129 . S VALMBCK="R"
130 Q
131 ;
132SELECT(ACTION) ; selects document(s) and calls ACTION
133 N TIUDOCS,TIUSEL,TIUQUIT,TIUCNT,TIUDA
134 D FULL^VALM1
135 I $P(^TMP("TIU180",$J,"TOTAL"),U)=0 W !,"No documents to select." H 3 Q
136 S TIUSEL=$P(XQORNOD(0),"=",2),TIUCNT=0
137 I TIUSEL="" D Q:$D(TIUQUIT)
138 . N DIR,X,Y
139 . S DIR("A")="Select Document(s)"
140 . S DIR(0)="L^"_VALMBG_":"_VALMLST
141 . D ^DIR I $D(DIRUT)!(Y=U) S TIUQUIT=1 Q
142 . S TIUSEL=Y(0)
143 F X=1:1 Q:$P(TIUSEL,",",X)="" D
144 . S TIUCNT=TIUCNT+1
145 . S TIUDOCS($P(TIUSEL,",",X))=$O(@VALMAR@("IDX",$P(TIUSEL,",",X),""))
146 . S ^TMP("TIUSEL",$J,TIUCNT)=$P(TIUSEL,",",X)
147 I $D(TIUDOCS)'>1 S VALMBCK="R" Q
148 D @ACTION
149 Q
Note: See TracBrowser for help on using the repository browser.