source: WorldVistAEHR/trunk/r/CLINICAL_INFO_RESOURCE_NETWORK-MRF-RGE--RG--RGED--RGUT--RGWB/RGEXHND1.m@ 619

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

initial load of WorldVistAEHR
File size: 5.8 KB
Line 
1RGEXHND1 ;BAY/ALS-MPI/PD EXCEPTION HANDLING UTILITY ;10/08/99
2 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**3,12,19,23,43,45,52**;30 Apr 99;Build 2
3DTLIST ;List exceptions by date
4 K ^TMP("RGEXC",$J)
5 I '$D(RGBG) S VALMBG=1
6 ;**45 list exception 234 first regardless of date - Primary View Reject
7 S EXCDT="",EXCTYP=234,(CNT,IEN)=0
8 F S IEN=$O(^RGHL7(991.1,"ASTAT","0",EXCTYP,IEN)) Q:'IEN D
9 .S IEN2=0
10 .F S IEN2=$O(^RGHL7(991.1,"ASTAT","0",EXCTYP,IEN,IEN2)) Q:'IEN2 D
11 ..S EXCDT=$P(^RGHL7(991.1,IEN,0),"^",3)
12 ..D ADDREC
13 S EXCDT="",EXCTYP=""
14 F S EXCDT=$O(^RGHL7(991.1,"AD",EXCDT)) Q:'EXCDT D
15 . S IEN=0
16 . F S IEN=$O(^RGHL7(991.1,"AD",EXCDT,IEN)) Q:'IEN D
17 .. S NUM="" S NUM=$P($G(^RGHL7(991.1,IEN,1,0)),"^",4) Q:NUM<1 D
18 ... S IEN2=0
19 ... F S IEN2=$O(^RGHL7(991.1,IEN,1,IEN2)) Q:'IEN2 D
20 .... S EXCTYP=$P(^RGHL7(991.1,IEN,1,IEN2,0),"^",3)
21 ....;don't include 234 below; those were done first (above).
22 .... I EXCTYP=218 D ADDREC ;**45;MPIC_772; **52 remove 215, 216, and 217
23 K I,NUM,EXCDT,EXCTYP,RGBG
24 IF CNT<1 D NDATA
25 Q
26 ;
27NDATA ; There is no data matching the criteria
28 S CNT=CNT+1,STRING=""
29 S STRING=$$SETSTR^VALM1("There were no exceptions found.",STRING,5,35)
30 S ^TMP("RGEXC",$J,CNT,0)=STRING
31 S ^TMP("RGEXC",$J,"IDX",CNT,CNT)=""
32 S VALMCNT=CNT
33 Q
34EXCLST ;List exceptions by type
35 K ^TMP("RGEXC",$J)
36 S CNT=0,EXCDT="",EXCTYP=""
37 I '$D(RGBG) S VALMBG=1
38 F S EXCTYP=$O(^RGHL7(991.1,"AC",EXCTYP)) Q:'EXCTYP D
39 . I (EXCTYP=234)!(EXCTYP=218) D ;**45;MPIC_772; **52 remove 215, 216, and 217
40 .. S IEN=0
41 .. F S IEN=$O(^RGHL7(991.1,"AC",EXCTYP,IEN)) Q:'IEN D
42 ... S NUM="" S NUM=$P($G(^RGHL7(991.1,IEN,1,0)),"^",4) Q:NUM<1 D
43 .... S IEN2=0
44 .... F S IEN2=$O(^RGHL7(991.1,"AC",EXCTYP,IEN,IEN2)) Q:'IEN2 D
45 ..... S EXCDT=$P($G(^RGHL7(991.1,IEN,0)),"^",3) Q:'EXCDT
46 ..... D ADDREC
47 IF CNT<1 D NDATA
48 K RGBG
49 Q
50PATLST ;List exceptions by patient
51 K ^TMP("RGEXC",$J),^TMP("RGEX01",$J)
52 S CNT=0,EXCDT="",EXCTYP="",NDX=0,NAME=""
53 I '$D(RGBG) S VALMBG=1
54 F S EXCTYP=$O(^RGHL7(991.1,"ADFN",EXCTYP)) Q:'EXCTYP D
55 . I (EXCTYP=234)!(EXCTYP=218) D ;**45;MPIC_772; **52 remove 215, 216, and 217
56 .. S DFN=""
57 .. F S DFN=$O(^RGHL7(991.1,"ADFN",EXCTYP,DFN)) Q:'DFN D
58 ... S IEN=0
59 ... F S IEN=$O(^RGHL7(991.1,"ADFN",EXCTYP,DFN,IEN)) Q:'IEN D
60 .... S IEN2=0
61 .... F S IEN2=$O(^RGHL7(991.1,"ADFN",EXCTYP,DFN,IEN,IEN2)) Q:'IEN2 D
62 ..... S EXCDT=$P($G(^RGHL7(991.1,IEN,0)),"^",3) Q:'EXCDT
63 ..... D DEM^VADPT S NAME=VADM(1) Q:NAME=""
64 ..... S NDX=NDX+1
65 ..... S ^TMP("RGEX01",$J,NAME,NDX)=$G(VADM(1))_"^"_IEN_"^"_IEN2_"^"_EXCTYP_"^"_EXCDT
66 D PATTMP
67 IF CNT<1 D NDATA
68 K DFN,RGBG
69 Q
70PATTMP ;
71 S NM=""
72 F S NM=$O(^TMP("RGEX01",$J,NM)) Q:NM="" D
73 . S NDX=0
74 . F S NDX=$O(^TMP("RGEX01",$J,NM,NDX)) Q:'NDX D
75 .. S IEN=$P(^TMP("RGEX01",$J,NM,NDX),"^",2)
76 .. S IEN2=$P(^TMP("RGEX01",$J,NM,NDX),"^",3)
77 .. S EXCTYP=$P(^TMP("RGEX01",$J,NM,NDX),"^",4)
78 .. S EXCDT=$P(^TMP("RGEX01",$J,NM,NDX),"^",5)
79 .. D ADDREC
80 K NDX,NM,NAME
81 Q
82SELTYP ; List all exceptions of type selected by user
83 S EXCTYPE="",FLAG=0,ETYPE=""
84 I '$D(RGBG) S VALMBG=1
85 K DIR,Y,DIC
86 S DIR("A")="Enter an exception type to view: "
87 S DIR(0)="SAM^218:Potential Matches Returned;234:Primary View Reject" ;**43;**45;MPIC_772; **52 remove 215, 216, and 217
88 S DIR("?")="^D HLPSEL^RGEXHND1"
89 D ^DIR
90 I Y<1 S RGSORT="SD" D SORT^RGEX01 Q
91 Q:$D(DUOUT)!$D(DTOUT)
92 S EXCTYPE=+Y,ETYPE=$P(^RGHL7(991.11,EXCTYPE,10),"^",1)
93 I (EXCTYPE=234)!(EXCTYPE=218) S FLAG=1 ;**43;**45;MPIC_772; **52 remove 215, 216, and 217
94 I FLAG=1 D ADDSEL
95 E I FLAG=0 D
96 . W !,"Not a valid selection."
97 . D SELTYP
98 K FLAG,Y,DIR,DIC,DTOUT,DUOUT,RGBG
99 Q
100ADDSEL ;called by SELTYP
101 K ^TMP("RGEXC",$J)
102 S CNT=0,EXCDT="",EXCTYP=""
103 F S EXCTYP=$O(^RGHL7(991.1,"AC",EXCTYP)) Q:'EXCTYP D
104 . I EXCTYP=EXCTYPE D
105 .. S IEN=0
106 .. F S IEN=$O(^RGHL7(991.1,"AC",EXCTYP,IEN)) Q:'IEN D
107 ... S IEN2=0
108 ... F S IEN2=$O(^RGHL7(991.1,"AC",EXCTYP,IEN,IEN2)) Q:'IEN2 D
109 .... S EXCDT=$P($G(^RGHL7(991.1,IEN,0)),"^",3) Q:'EXCDT ;**43
110 .... D ADDREC
111 I CNT<1 D
112 . W !,"There are no "_ETYPE
113 . W !,"exceptions that need processing."
114 . D SELTYP
115 Q
116HLPSEL ;
117 D FULL^VALM1
118 ;W !,"The following exception types are handled by this option:"
119 ;W !,"Potential Matches Returned",?50,"(218)"
120 ;W !,"Primary View Reject",?50,"(234)"
121 S VALMBCK="R"
122 Q
123ADDREC ;
124 S ETEXT="",RGDFN="",ICN="",RGNM="",STAT="",DOD=""
125 S ETEXT=$P($G(^RGHL7(991.11,EXCTYP,10)),"^",1)
126 S RGDFN=$P(^RGHL7(991.1,IEN,1,IEN2,0),"^",4) Q:'RGDFN
127 S STAT=$P($G(^RGHL7(991.1,IEN,1,IEN2,0)),"^",5)
128 S ICN=+$$GETICN^MPIF001(RGDFN)
129 S HOME=$$SITE^VASITE()
130 I (STAT<1)!(STAT="") D
131 .;Only list exceptions that are Not Processed
132 .; only list patients with local ICN, or for exceptions 234 or 218;MPIC_772; **52 remove 215, 216, and 217
133 . I $E(ICN,1,3)=$E($P(HOME,"^",3),1,3)!(ICN<0)!(EXCTYP=234)!(EXCTYP=218) D ;**43,**45,**52
134 .. S DFN=RGDFN D DEM^VADPT
135 .. S RGNM=VADM(1)
136 .. S RGSSN=$P($G(VADM(2)),"^",1)
137 .. S DOB=$G(VADM(3)) I DOB="" S DOB="^"
138 .. S DOD=$P($P($G(VADM(6)),"^",2),"@",1)
139 .. S EXDATE=$P($$FMTE^XLFDT(EXCDT,2),"@",1)
140 .. S CNT=CNT+1
141 .. S STRING=""
142 .. I ICN<0 S ICN=""
143 .. S STRING=$$SETSTR^VALM1(CNT,STRING,1,4)
144 .. S STRING=$$SETSTR^VALM1($E(RGNM,1,22),STRING,6,21)
145 .. S STRING=$$SETSTR^VALM1(RGSSN,STRING,28,10)
146 .. S STRING=$$SETSTR^VALM1(EXDATE,STRING,39,8)
147 .. S STRING=$$SETSTR^VALM1(ETEXT,STRING,49,32)
148 .. S ^TMP("RGEXC",$J,CNT,0)=STRING
149 .. S ^TMP("RGEXC",$J,"IDX",CNT,CNT)=""
150 .. S ^TMP("RGEXC",$J,CNT,"DATA")=RGNM_"^"_RGSSN_"^"_$P($$FMTE^XLFDT(EXCDT),"@",1)_"^"_ETEXT_"^"_DFN_"^"_ICN_"^"_DOB_"^"_STAT_"^"_IEN_"^"_IEN2_"^"_CNT_"^"_DOD
151 S VALMCNT=CNT
152 K RGDFN,RGNM,RGSSN,EXDATE,ETEXT,ICN,DOB,STAT,VADM,HOME,STRING,DOD
153 Q
154SELECT ;
155 I $G(STRING)["no exceptions found" D SORT^RGEX01 Q
156 N VALMY
157 D EN^VALM2(XQORNOD(0),"OS")
158 I '$D(VALMY) Q
159 S VALMCNT=CNT
160 S DATA="",CNT=""
161 S CNT=$O(VALMY(0))
162 S DATA=$G(^TMP("RGEXC",$J,CNT,"DATA"))
163 I '$D(DATA) S CNT=0 Q
164 D CLEAN^VALM10
165 D EN^RGEX03(DATA)
166 I RGSORT="VT" D
167 . K @VALMAR
168 . D ADDSEL
169 E I RGSORT'="VT" D SORT^RGEX01
170 ;
171 Q
172QUIT ;
Note: See TracBrowser for help on using the repository browser.