source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFCEHU2.m@ 1801

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

initial load of WorldVistAEHR

File size: 7.7 KB
RevLine 
[613]1VAFCEHU2 ;ALB/JLU,LTL-UTILITIES FOR 391.98 AND 391.99 AND LIST MAN ;10/10/02 15:55
2 ;;5.3;Registration;**149,255,333,474,477,620**;Aug 13, 1993
3SORTS(SRT,ARY) ;
4 ;this tag will sort the exceptions in different formats depending on
5 ;what the user has selected.
6 ;
7 ;INPUTS - SRT this variable contains what sort is requested from the
8 ;list man patient review screen.
9 ; Ex. SP sort by patient
10 ; SS sort by site
11 ; SO sort by oldest event
12 ; SN sort by newest event
13 ;ARY - the array the calling program wants the info returned in.
14 ;
15 ;OUTPUT
16 ;a populated array that was passed in by the user. The array is in
17 ;the structure xxx(#,0)=value
18 ;
19 S VAR=SRT_"(ARY)"
20 D @VAR
21 Q
22 ;
23SP(ARY) ;sort by patient
24 N LP,LP1,CTR
25 S LP=""
26 S CTR=1
27 F S LP=$O(^DGCN(391.98,"C",LP)) Q:LP="" F LP1=0:0 S LP1=$O(^DGCN(391.98,"C",LP,LP1)) Q:LP1="" D BLD(LP1,ARY,.CTR)
28 Q
29 ;
30SS(ARY) ;sort by site
31 N LP,LP1,CTR
32 S LP=""
33 S CTR=1
34 F S LP=$O(^DGCN(391.98,"FRM",LP)) Q:LP="" F LP1=0:0 S LP1=$O(^DGCN(391.98,"FRM",LP,LP1)) Q:LP1="" D BLD(LP1,ARY,.CTR)
35 Q
36 ;
37SO(ARY) ;sort by oldest event
38 N LP,LP1,CTR
39 S LP=""
40 S CTR=1
41 F S LP=$O(^DGCN(391.98,"EVT",LP)) Q:LP="" F LP1=0:0 S LP1=$O(^DGCN(391.98,"EVT",LP,LP1)) Q:LP1="" D BLD(LP1,ARY,.CTR)
42 Q
43 ;
44SN(ARY) ;sort by newest event
45 N LP,LP1,CTR
46 S LP=999999999999
47 S CTR=1
48 F S LP=$O(^DGCN(391.98,"EVT",LP),-1) Q:LP="" F LP1=999999999999:0 S LP1=$O(^DGCN(391.98,"EVT",LP,LP1),-1) Q:LP1="" D BLD(LP1,ARY,.CTR)
49 Q
50 ;
51BLD(LP1,ARY,CTR) ;this is the actual building subroutine. the array that is
52 ;return is var(#,0)=value starting at 1.
53 ;
54 N DATA,STAT,PAT,XX
55 ;getting the exception
56 S DATA=$G(^DGCN(391.98,LP1,0))
57 Q:DATA']""
58 ;checking for the status
59 ;Q:$P(DATA,U,4)']"" ;**333
60 I $P(DATA,U,4)']"" S XX=$$EDIT^VAFCEHU1(LP1,"RETIRED DATA") Q ;**333 retire
61 ;getting the status node from 391.984
62 S STAT=$G(^DGCN(391.984,$P(DATA,U,4),0))
63 ;if retired skip
64 I "RETIRED DATA"=$P(STAT,U,1) Q
65 ;if rejected skip
66 I "DATA REJECTED"=$P(STAT,U,1) Q
67 ;if merge complete
68 I "MERGE COMPLETE"=$P(STAT,U,1) Q
69 ;get patient file zero node
70 S PAT=$G(^DPT($P(DATA,U,1),0))
71 ;Q:PAT']"" ;**333
72 I $S(PAT']"":1,$$IFLOCAL^MPIF001(+$P(DATA,U,1)):1,$$IFVCCI^MPIF001(+$P(DATA,U,1))=-1:1,1:0) S XX=$$EDIT^VAFCEHU1(LP1,"RETIRED DATA") Q ;**333 retire if a local, you're not the cmor or no cmor
73 S @ARY@(CTR,0)=$P(PAT,U,1)_U_$P(PAT,U,9)_U_$P(PAT,U,3)_U_$P(STAT,U,2)_U_$P(DATA,U,3)_U_$G(^DGCN(391.98,LP1,"FRM"))
74 S @ARY@(CTR,"VAFC")=LP1
75 S CTR=CTR+1
76 Q
77 ;
78FORMAT(ARY,VALMCNT,VALMQUIT) ;this subroutines formats the array in ARY
79 ;from file 391.98 for display by the list manager. It accepts the
80 ;array name as its input in ARY.
81 ;VALMCNT and VALMQUIT are passed by reference
82 ;VALMCNT will be the total number of entries
83 ;VALMQUIT tells list man to quit if something when wrong.
84 ;
85 N CTR,STR,LP
86 S CTR=1
87 F LP=0:0 S LP=$O(@ARY@(LP)) Q:'LP S STR=$G(@ARY@(LP,0)) I STR]"" DO
88 .N X,DATE
89 .S X=$$SETSTR^VALM1(CTR,"",1,4)
90 .S X=$$SETSTR^VALM1($E($P(STR,U,1),1,23),X,5,23)
91 .S X=$$SETSTR^VALM1($P(STR,U,2),X,29,9)
92 .S DATE=$$IN2EXDT^VAFCMGU0($P(STR,U,3))
93 .S X=$$SETSTR^VALM1(DATE,X,40,10)
94 .S X=$$SETSTR^VALM1($P(STR,U,4),X,51,2)
95 .S DATE=$$IN2EXDT^VAFCMGU0($P(STR,U,5))
96 .S X=$$SETSTR^VALM1(DATE,X,55,10)
97 .S X=$$SETSTR^VALM1($P(STR,U,6),X,67,$L($P(STR,U,6)))
98 .S @ARY@(LP,0)=X
99 .S @ARY@("IDX",CTR,CTR)=""
100 .S CTR=CTR+1
101 .Q
102 S VALMCNT=CTR-1
103 I CTR=1 DO
104 .S @ARY@(1,0)=""
105 .S @ARY@(2,0)="There are no exceptions on file to review."
106 .S VALMCNT=2
107 .Q
108 Q
109 ;
110FRMDATA(IEN,ARY) ;
111 ;This entry point will return all the data related to a given exception
112 ;INPUTS
113 ; IEN - The IEN of the exception to be extracted.
114 ; ARY - The array that the user wishes the information returned in.
115 ; This array can be either local or global.
116 ; Ex. ^TMP("TEST",$J)
117 ; If and array is not passed then a default global array will
118 ; be used. ^TMP($J,"VAFC-MRG","DATA")
119 ;OUTPUTS
120 ; 1 if the look up and retreival were successful
121 ; 0^description if they were not.
122 ;
123 N ERR,LP,DATA
124 I '$D(IEN) S ERR="0^Parameter not defined." G FRMQ
125 I IEN']"" S ERR="0^Exception not defined." G FRMQ
126 I '$D(^DGCN(391.98,IEN,0)) S ERR="0^Exception not in file." G FRMQ
127 I '$D(^DGCN(391.99,"B",IEN)) S ERR="0^Data for exception not defined." G FRMQ
128 I '$D(ARY) S ARY="^TMP($J,""VAFC-MRG"",""DATA"")"
129 I ARY']"" S ARY="^TMP($J,""VAFC-MRG"",""DATA"")"
130 S LP=""
131 F S LP=$O(^DGCN(391.99,"B",IEN,LP)) Q:'LP DO
132 . S DATA=$G(^DGCN(391.99,LP,0))
133 . Q:'DATA
134 . I $P(DATA,U,2)=""!($P(DATA,U,3)="") Q ;**477
135 . I $S($P(DATA,U,3)=.211:1,$P(DATA,U,3)=.2403:1,1:0) D ;**477 standardize mmn and nok for old pdr entries
136 . . N DGNAME S DGNAME=$G(^DGCN(391.99,LP,"VAL")) I $S(DGNAME="":0,DGNAME["@":0,1:1) D
137 . . . I $P(DATA,U,3)=.211 D STDNAME^XLFNAME(.DGNAME,"P") S DGNAME=$$FORMAT^XLFNAME7(.DGNAME,3,35) I DGNAME="" Q
138 . . . I $P(DATA,U,3)=.2403 D STDNAME^XLFNAME(.DGNAME,"P") S DGNAME=$$FORMAT^XLFNAME7(.DGNAME,3,35,,2,,1) I DGNAME="" Q
139 . . . D UPD(LP,50,DGNAME)
140 . I $P(DATA,U,3)=.05,($G(^DGCN(391.99,LP,"VAL"))="N") D UPD(LP,50,"NEVER MARRIED"),UPD(LP,.06,"@") S $P(DATA,"^",6)="" ;**477 translate marital status from 'n' to 'never married' and remove unresolved flag
141 . ;
142 . S @ARY@($P(DATA,U,2),$P(DATA,U,3))=$G(^DGCN(391.99,LP,"VAL"))_U_$P(DATA,U,5)_U_$P(DATA,U,6)
143 . Q
144 I $D(@ARY)>9 S ERR=1
145 E S ERR="0^No elments found."
146 ;
147FRMQ Q ERR
148 ;
149REVFUL ;this entry point is to process the user selection from the summary
150 ;screen of the exception handler.
151 ;the variable VALMAR is expected. This contains the array that is
152 ;being used as part of list manager
153 ;
154 ;variable collision during VAFCMG01 processing, changed ien to ienpdr ;**477
155 ;
156 S VALM("ENTITY")="Patient"
157 D EN^VALM2(XQORNOD(0))
158 I '$D(VALMY) G FULQ
159 N LP,RES
160 F LP=0:0 S LP=$O(VALMY(LP)) Q:'LP DO Q:RES<-9
161 .N IENPDR,LCK,MSG,EXCPT,FRM,STR,STAT,EDT,ARY
162 .S RES=0
163 .S IENPDR=$O(@VALMAR@("IDX",LP,0))
164 .Q:'IENPDR
165 .S IENPDR=$G(@VALMAR@(IENPDR,"VAFC"))
166 .Q:'IENPDR
167 .S LCK=$$LOCK^VAFCEHU1(IENPDR)
168 .I 'LCK DO Q
169 ..N PAT
170 ..S PAT=$E(@VALMAR@(LP,0),4,27)
171 ..D FULL^VALM1
172 ..W $C(7)
173 ..W !!,"The status for ",PAT," is ",$P(LCK,U,2)
174 ..W !,"Review or merging of this data is not allowed at this time."
175 ..D PAUSE^VALM1
176 ..Q
177 .S EXCPT=$G(^DGCN(391.98,IENPDR,0))
178 .S FRM=$G(^DGCN(391.98,IENPDR,"FRM"))
179 .I 'EXCPT!(FRM']"") Q
180 .S ARY="^TMP($J,""VAFC-MRG"",""DATA"")"
181 .S STR=$$FRMDATA(IENPDR,ARY)
182 .Q:'STR
183 .S RES=$$EN^VAFCMG01($P(EXCPT,U,1),ARY,FRM,$P(EXCPT,U,3))
184 .S STAT=$S(RES>11:"DR",RES>9:"MC",RES<2:"DE",1:"AR")
185 .S EDT=$$EDIT^VAFCEHU1(IENPDR,STAT)
186 .I RES=10!(RES=11) D WHO(IENPDR,DUZ,"NOW")
187 .L -^DGCN(391.98,IENPDR) ;**255
188 .Q
189 D INIT2^VAFCEHLM
190 ;
191FULQ Q
192 ;
193WHO(IEN,WHO,WHEN) ;this entry point updates the exceptions as to who
194 ;made this update and when.
195 ;
196 S DIE="^DGCN(391.98,"
197 S DA=IEN
198 S DR="12////"_DUZ_";11///"_WHEN
199 D ^DIE
200 Q
201 ;
202RETPDR(DFN,STAIEN) ;retire site's PDRs 'awaiting review' for patient ;**474
203 ;INPUT DFN - ien of the patient
204 ; STAIEN - ien of the institution
205 ;
206 N DAT,IEN,NAM,PDRIEN,STANAM,VAFCINST
207 I 'DFN!'STAIEN Q
208 D GETS^DIQ(4,STAIEN_",",".01;999.1*",,"VAFCINST") ;retrieve current name and name history
209 S NAM=$G(VAFCINST(4,STAIEN_",",.01)) I NAM'="" S STANAM(NAM)="" ;get current name
210 S IEN="" F S IEN=$O(VAFCINST(4.999,IEN)) Q:IEN="" S NAM=$G(VAFCINST(4.999,IEN,.02)) I NAM'="" S STANAM(NAM)="" ;get name history in case site name change
211 S NAM="" F S NAM=$O(STANAM(NAM)) Q:NAM="" D ;loop through array of names
212 . S DAT=0 F S DAT=$O(^DGCN(391.98,"AKY",DFN,NAM,DAT)) Q:DAT="" D ;loop through site's pdrs for patient
213 . . S PDRIEN="" F S PDRIEN=$O(^DGCN(391.98,"AKY",DFN,NAM,DAT,PDRIEN)) Q:'PDRIEN I $P($G(^DGCN(391.98,PDRIEN,0)),"^",4)=1 S XX=$$EDIT^VAFCEHU1(PDRIEN,"RETIRED DATA") ;retire pdr's awaiting review
214 Q
215 ;
216UPD(DA,FLD,VAL) ;update value ;**477
217 L +^DGCN(391.99,DA,0):10
218 S DIE="^DGCN(391.99,"
219 S DR=FLD_"///^S X=VAL"
220 D ^DIE K DIE,DR
221 L -^DGCN(391.99,DA,0)
222 Q
Note: See TracBrowser for help on using the repository browser.