source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUMLIST.m@ 1800

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

initial load of WorldVistAEHR
File size: 6.1 KB
Line 
1TIUMLIST ; ISL/JER - Review Unmapped Titles ; 03/21/07
2 ;;1.0;TEXT INTEGRATION UTILITIES;**211,225**;Jun 20, 1997;Build 13
3EN ; Invoke List Manager
4 D EN^VALM("TIU REVIEW UNMAPPED TITLES")
5 S VALMBCK="Q"
6 Q
7 ;
8MAKELIST ; Prompt for search criteria
9 N MAPSTAT,TIUEDT,TIULDT,USER
10 S MAPSTAT="U^unmapped",TIUEDT=0,TIULDT=0,USER=DUZ_U_$$PERSNAME^TIULC1(DUZ)
11 S MAPSTAT=$$SELSTAT("unmapped (ACTIVE)")
12 I +$G(DIRUT) S VALMQUIT=1 Q
13 I $S(MAPSTAT="*":0,MAPSTAT="U":0,MAPSTAT="A":0,MAPSTAT="I":0,1:1) D Q:+$G(VALMQUIT)
14 . S USER=$$SELUSER(DUZ)
15 . I '$S(+USER:1,USER="A":1,1:0)!+$G(DIRUT) S VALMQUIT=1 Q
16 . S TIUEDT=+$$EDATE^TIULA("Mapping","T-30")
17 . I TIUEDT'>0!+$G(DIRUT) S VALMQUIT=1 Q
18 . S TIULDT=+$$LDATE^TIULA("Mapping")
19 . I TIULDT'>0!+$G(DIRUT) S VALMQUIT=1 Q
20 . ; If TIUEDT is NOT earlier than TIULDT, then swap
21 . I TIUEDT>TIULDT S TIUTMP=TIUEDT,TIUEDT=TIULDT,TIULDT=TIUTMP
22 W !,"Searching for the events."
23 D BUILD(MAPSTAT,TIUEDT,TIULDT,USER)
24 K TIUDI,SELDIV
25 Q
26 ;
27SELSTAT(DFLT) ; Select Mapping Status
28 N PRMT,READTYPE,X,Y
29 S PRMT="Select Mapping Status: "
30 S READTYPE="SMA^M:mapped;U:unmapped (ACTIVE);F:failed mappings;A:active;I:inactive;*:standard title inactivated"
31 S Y=$P($$READ^TIUU(READTYPE,PRMT,DFLT),U)
32 Q Y
33 ;
34SELUSER(DFLT) ; Select Resolution status
35 N PRMT,READTYPE,X,Y
36 I +DFLT>0 S DFLT=$$PERSNAME^TIULC1(DFLT)
37 S PRMT="Select USER: "
38 S READTYPE="SMA^A:any;S:selected user"
39 S Y=$P($$READ^TIUU(READTYPE,PRMT,"ANY"),U)
40 I Y="S" D
41 . S READTYPE="PA^200:AEMQ"
42 . S Y=+$$READ^TIUU(READTYPE,PRMT,DFLT)
43 Q Y
44 ;
45BUILD(MAPSTAT,TIUEDT,TIULDT,USER) ; Build review screen list
46 N TIUCNT,TIUTTL
47 S (TIUCNT,VALMCNT)=0
48 K ^TMP("TIUMLIST",$J),^TMP("TIUMLISTIDX",$J)
49 ; If MAPSTAT="M^mapped"
50 ; Loop through ^TIU(8925.1,"ALOINC")
51 I $P(MAPSTAT,U)="M"!($P(MAPSTAT,U)="*") D
52 . N TIUSDA S TIUSDA=0
53 . F S TIUSDA=$O(^TIU(8925.1,"ALOINC",TIUSDA)) Q:+TIUSDA'>0 D
54 . . N TIUTDA S TIUTDA=0
55 . . F S TIUTDA=$O(^TIU(8925.1,"ALOINC",TIUSDA,TIUTDA)) Q:+TIUTDA'>0 D:$$PASS(MAPSTAT,TIUTDA,USER,TIUEDT,TIULDT) SORT(TIUTDA)
56 . N TIUNM S TIUNM=""
57 . F S TIUNM=$O(^TMP("TIUMLIST",$J,"ALPHA",TIUNM)) Q:TIUNM']"" D
58 . . N TIUTDA S TIUTDA=0
59 . . F S TIUTDA=$O(^TMP("TIUMLIST",$J,"ALPHA",TIUNM,TIUTDA)) Q:+TIUTDA'>0 D
60 . . . S TIUCNT=+$G(TIUCNT)+1
61 . . . D SETLSTEL(TIUTDA,TIUCNT)
62 ; If MAPSTAT="U^unmapped" or MAPSTAT="A^all active titles"
63 ; Loop through ^TIU(8925.1,"AT","DOC")
64 I $S($P(MAPSTAT,U)="U":1,$P(MAPSTAT,U)="A":1,$P(MAPSTAT,U)="I":1,1:0) D
65 . N TIUTDA S TIUTDA=0
66 . F S TIUTDA=$O(^TIU(8925.1,"AT","DOC",TIUTDA)) Q:+TIUTDA'>0 D
67 . . I ($P(MAPSTAT,U)'="I"),(+$P($G(^TIU(8925.1,TIUTDA,0)),U,7)'=11) Q
68 . . I ($P(MAPSTAT,U)="I"),(+$P($G(^TIU(8925.1,TIUTDA,0)),U,7)'=13) Q
69 . . I $P(MAPSTAT,U)="U",(+$P($G(^TIU(8925.1,TIUTDA,15)),U)>0) Q
70 . . D:$S($P(MAPSTAT,U)="U":1,$P(MAPSTAT,U)="A":1,$P(MAPSTAT,U)="I":1,$$PASS(TIUTDA,USER,TIUEDT,TIULDT):1,1:0) SORT(TIUTDA)
71 . N TIUNM S TIUNM=""
72 . F S TIUNM=$O(^TMP("TIUMLIST",$J,"ALPHA",TIUNM)) Q:TIUNM']"" D
73 . . N TIUTDA S TIUTDA=0
74 . . F S TIUTDA=$O(^TMP("TIUMLIST",$J,"ALPHA",TIUNM,TIUTDA)) Q:+TIUTDA'>0 D
75 . . . S TIUCNT=+$G(TIUCNT)+1
76 . . . D SETLSTEL(TIUTDA,TIUCNT)
77 ; If MAPSTAT="F^failed mappings"
78 ; Loop through ^XTMP("TIUMAP","FAIL")
79 I $P(MAPSTAT,U)="F" D
80 . S TIUTTL="" F S TIUTTL=$O(^XTMP("TIUMAP","FAIL",TIUTTL)) Q:TIUTTL']"" D
81 . . N TIUTDA S TIUTDA=0
82 . . F S TIUTDA=$O(^XTMP("TIUMAP","FAIL",TIUTTL,TIUTDA)) Q:+TIUTDA'>0 D
83 . . . I '$$PASS(TIUTDA,USER,TIUEDT,TIULDT) Q
84 . . . S TIUCNT=+$G(TIUCNT)+1
85 . . . D SETLSTEL(TIUTDA,TIUCNT)
86 ;
87 S ^TMP("TIUMLIST",$J,0)=+$G(TIUCNT)_U_MAPSTAT,VALMCNT=2*TIUCNT
88 S TIUPICK=+$O(^ORD(101,"B","TIU ACTION SELECT LIST ELEMENT",0))
89 S ^TMP("TIUMLIST",$J,"#")=TIUPICK_"^1:"_+$G(TIUCNT)
90 I $D(VALMHDR)>9 D HDR
91 I +$G(TIUCNT)'>0 D
92 . S ^TMP("TIUMLIST",$J,1,0)="",VALMCNT=2
93 . S ^TMP("TIUMLIST",$J,2,0)="No "_$$STATXFRM(MAPSTAT)_$S(MAPSTAT'="F":" Local Titles",1:"")_" found meeting the search criteria"
94 . D RESTORE^VALM10(2)
95 Q
96 ;
97PASS(MAPSTAT,TIUTDA,USER,TIUEDT,TIULDT) ; Does record passes criteria?
98 N Y,TIUTD15,TIUDT,TIUDUZ S Y=0
99 S TIUTD15=$G(^TIU(8925.1,TIUTDA,15))
100 I $P(MAPSTAT,U)="*",$$SCREEN^XTID(8926.1,"",+TIUTD15_",") S Y=1 G PASSX
101 S TIUDT=$P(TIUTD15,U,2),TIUDUZ=$P(TIUTD15,U,3)
102 I (TIUDT'<TIUEDT),(TIUDT'>TIULDT_".235959"),$S(USER="A":1,USER=TIUDUZ:1,1:0) S Y=1
103PASSX Q Y
104 ;
105SORT(TIUTDA) ; Alpha sort titles
106 N TIUNM S TIUNM=$P($G(^TIU(8925.1,TIUTDA,0)),U)
107 S ^TMP("TIUMLIST",$J,"ALPHA",TIUNM,TIUTDA)=""
108 Q
109 ;
110SETLSTEL(TIUTDA,TIUCNT) ; Set List element for each title
111 N ATTEMPT,USER,LOCAL,VHATITLE,VHATDA,USERDUZ,TIUD15,TIUTTL,TIUS
112 S TIUTTL=$P($G(^TIU(8925.1,TIUTDA,0)),U)
113 S TIUD15=$G(^TIU(8925.1,TIUTDA,15))
114 S USERDUZ=$P(TIUD15,U,3),USER=$S(+USERDUZ>0:$$GET1^DIQ(200,USERDUZ,.01),1:"UNKNOWN")
115 S ATTEMPT=$P(TIUD15,U,2)
116 S:USER'="UNKNOWN" USER=$$NAME^TIULS(USER,"LAST, FIRST")
117 S ATTEMPT=$S(+ATTEMPT>0:$$DATE^TIULS(ATTEMPT,"MM/DD/YY HR:MIN"),1:"N/A")
118 S VHATDA=0,VHATDA=$P(TIUD15,U)
119 S VHATITLE=$S(+VHATDA:$P($G(^TIU(8926.1,+VHATDA,0)),U),1:"")
120 S TIUREC=$$SETFLD^VALM1(TIUCNT,"","NUMBER")
121 S TIUREC=$$SETFLD^VALM1(TIUTTL,TIUREC,"LOCAL")
122 S TIUREC=$$SETFLD^VALM1(ATTEMPT,TIUREC,"ATTEMPTED")
123 S TIUREC=$$SETFLD^VALM1(USER,TIUREC,"USER")
124 S TIUS=(2*TIUCNT)-1
125 S ^TMP("TIUMLIST",$J,TIUS,0)=TIUREC
126 D RESTORE^TIULM(TIUS)
127 S ^TMP("TIUMLIST",$J,"IDX",TIUS,TIUCNT)=""
128 S ^TMP("TIUMLIST",$J,"PICK",TIUCNT,TIUS)=""
129 S ^TMP("TIUMLISTIDX",$J,TIUCNT)=TIUS_U_TIUTDA_U_TIUTTL
130 S TIUS=+$G(TIUS)+1 W:TIUS#5'>0 "."
131 S ^TMP("TIUMLIST",$J,TIUS,0)=$$SETFLD^VALM1(VHATITLE,"","VHATITLE")
132 D RESTORE^TIULM(TIUS)
133 S ^TMP("TIUMLIST",$J,"IDX",TIUS,TIUCNT)=""
134 S ^TMP("TIUMLIST",$J,"PICK",TIUCNT,TIUS)=""
135 Q
136 ;
137STATXFRM(STATUS) ; Transform status
138 Q $S(STATUS="M":"MAPPED",STATUS="U":"UNMAPPED (ACTIVE)",STATUS="F":"FAILED Mapping Attempts",STATUS="A":"ACTIVE",STATUS="*":"MAPPED to INACTIVE STANDARD",1:"INACTIVE")
139 ;
140HDR ; Initialize header for review screen
141 N TITLE,STATUS,MAPSTAT S STATUS=$P(@VALMAR@(0),U,2)
142 S MAPSTAT=$$STATXFRM(STATUS)
143 S TITLE=MAPSTAT_$S(STATUS'="F":" Titles",1:"")
144 S VALMHDR(1)=$$CENTER^TIULS(TITLE)
145 S VALMHDR(2)=" LOCAL Title"
146 Q
147 ;
148VIDATTS(LINE) ; Set default video attributes for LINE
149 D RESTORE^TIULM(LINE),FLDCTRL^VALM10(LINE,"NUMBER",IOINHI,IOINORM)
150 Q
151 ;
152CLEAN ; Clean up your mess!
153 K ^TMP("TIUMLIST",$J),^TMP("TIUMLISTIDX",$J) D CLEAN^VALM10
154 K VALMY
155 Q
Note: See TracBrowser for help on using the repository browser.