source: FOIAVistA/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMLDEMC.m@ 1446

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

initial load of FOIAVistA 6/30/08 version

File size: 2.5 KB
Line 
1IVMLDEMC ;ALB/BRM/PJR - IVM UPLOAD DEMO CLEAN-UP ; 10/21/04 11:36am
2 ;;2.0;INCOME VERIFICATION MATCH;**79,102**; 21-OCT-94
3 ;
4 Q
5EN(ADDRDT) ; entry point
6 N IVMDA,IVMDA1,IVMDA2,SEG
7 N X1,X2,Y,SSN,DFN
8 D FNDSEG(.SEG)
9 S IVMDA2=0
10 F S IVMDA2=$O(^IVM(301.5,IVMDA2)) Q:IVMDA2="" D
11 .S DFN=$P($G(^IVM(301.5,IVMDA2,0)),"^"),IVMDA1=0
12 .Q:('DFN)!('$D(^DPT(+DFN)))!('$D(^IVM(301.5,IVMDA2,"IN")))
13 .F S IVMDA1=$O(^IVM(301.5,IVMDA2,"IN",IVMDA1)) Q:'IVMDA1 D
14 ..D LOOP(DFN,IVMDA2,IVMDA1,.SEG,.ADDRDT)
15 ..; if no display or uploadable fields, delete PID segment
16 ..I ('$$DEMO^IVMLDEM5(IVMDA2,IVMDA1,0))&('$$DEMO^IVMLDEM5(IVMDA2,IVMDA1,1)) D DELETE^IVMLDEM5(IVMDA2,IVMDA1," ")
17 Q
18LOOP(DFN,IVMDA2,IVMDA1,SEG,ADDRDT) ;
19 N SEGNUM,X,X1,X2,%Y
20 Q:'$D(SEG)
21 S (SEGNUM,SEGNAM)=""
22 F S SEGNAM=$O(SEG(SEGNAM)) Q:SEGNAM']"" D
23 .S SEGNUM=$P($G(SEG(SEGNAM)),"^"),IVMTYPE=+$P($G(SEG(SEGNAM)),"^",2)
24 .S IVMDA=""
25 .F S IVMDA=$O(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM","B",SEGNUM,IVMDA)) Q:'IVMDA D
26 ..S IVMDAT=$P($G(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM",IVMDA,0)),"^",3)
27 ..; ignore recent uploads if this is the one-time clean-up
28 ..I (IVMDAT&'$G(ADDRDT(IVMTYPE)))!($G(ADDRDT(IVMTYPE))&'IVMDAT) Q
29 ..; quit if # of days has not passed yet (doesn't apply to EN tag)
30 ..I $G(ADDRDT(IVMTYPE)),IVMDAT S X1=$$DT^XLFDT,X2=IVMDAT D ^%DTC Q:X<ADDRDT(IVMTYPE)
31 ..;process fields that are selectively deleted
32 ..Q:'$$RULES(DFN,SEGNAM)
33 ..I IVMTYPE,$G(ADDRDT(IVMTYPE)) D AUTOLOAD^IVMLDEM9(DFN,IVMDA2,IVMDA1)
34 ..; remove entry from (#301.511) sub-file
35 ..D DELETE^IVMLDEM5(IVMDA2,IVMDA1," "),DELENT^IVMLDEMU(IVMDA2,IVMDA1,IVMDA)
36 Q
37RULES(DFN,SEGNAM) ;can this data element be deleted?
38 Q:SEGNAM'="ZPD09" 1
39 Q:'$G(DFN) 0
40 N VADM
41 D DEM^VADPT
42 Q:$G(VADM(6))]"" 1 ;delete dod if present in Patient file (#2)
43 Q 0
44 ;
45FNDSEG(SEG) ;
46 N SEGLOC,LINE,QUIT,TAG,SEGDAT,PIECE
47 S LINE=1,SEGDAT="",QUIT=0
48 F S LINE=LINE+1 Q:$G(QUIT) D
49 .S TAG="DATA+"_LINE,SEGDAT=$P($T(@(TAG)),";;",2)
50 .I SEGDAT']"" S QUIT=1 Q
51 .F PIECE=1:1:10 Q:$P(SEGDAT,"~",PIECE)="" D
52 ..S SEGLOC=$P(SEGDAT,"~",PIECE) Q:'$D(^IVM(301.92,"C",SEGLOC))
53 ..S SEG(SEGLOC)=$O(^IVM(301.92,"C",SEGLOC,""))
54 ..Q:'$G(SEG(SEGLOC))
55 ..S $P(SEG(SEGLOC),"^",2)=$P($G(^IVM(301.92,SEG(SEGLOC),0)),"^",8)
56 Q
57 ;
58DATA ;; do not modify below values! They are used to set-up the array
59 ;; that determines the fields to delete and/or process
60 ;;PID111~PID112~PID113~PID114~PID115~PID12~PID13~RF171~ZPD09~ZPD13
61 ;;ZGD03~ZGD04~ZGD05~ZGD061~ZGD062~ZGD063~ZGD064~ZGD065~ZGD07~ZGD08
62 ;;ZPD08~ZPD12~ZPD13~ZEL02~ZEL06~ZPD31~ZPD32
63 ;;
64 ;; end of data (do not remove or modify above "blank" line)
Note: See TracBrowser for help on using the repository browser.