source: FOIAVistA/tag/r/INCOME_VERIFICATION_MATCH-IVM/IVM273A.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 3.0 KB
Line 
1IVM273A ;ALB/PDJ IVM*2.0*73 - CLEANUP IVM PATIENT FILE;02/07/2003
2 ;;2.0;INCOME VERIFICATION MATCH;**73**; 21-OCT-94
3 ;
4EN N DFN,I,R3015,SEG,TEXT,TYPE,X,X1,X2,%,XTPAT,IVMPH,IVMAD
5 ;
6 D BMES^XPDUTL(" ")
7 D BMES^XPDUTL(" The Post Install will now process through the IVM PATIENT")
8 D BMES^XPDUTL(" FILE to remove entries which do not contain any uploadable")
9 D BMES^XPDUTL(" or non-uploadable fields.")
10 D BMES^XPDUTL(" ")
11 ;
12 I $D(XPDNM) D
13 . I $$VERCP^XPDUTL("R3015")'>0 D
14 . . S %=$$NEWCP^XPDUTL("R3015","","0")
15 ;
16 F I="PATREC" D
17 . I $D(^XTMP("IVM*2.0*73-"_I)) Q
18 . S X1=DT
19 . S X2=30
20 . D C^%DTC
21 . S TEXT=X_"^"_$$DT^XLFDT_"^IVM*2.0*73 POST-INSTALL "
22 . S TEXT=TEXT_$S(I="PATREC":"IVM Patient Records",1:"filing errors")
23 . S ^XTMP("IVM*2.0*73-"_I,0)=TEXT
24 ;
25 S XTPAT="IVM*2.0*73-PATREC"
26 ;
27 I '$D(XPDNM) D
28 . S ^XTMP(XTPAT,1)=0
29 I $D(XPDNM)&'$D(^XTMP(XTPAT,1)) S ^XTMP(XTPAT,1)=0
30 I $D(XPDNM) S %=$$VERCP^XPDUTL("R3015")
31 I $G(%)="" S %=0
32 I %=0 D EN1
33 Q
34 ;
35EN1 I '$D(XPDNM) S R3015=0
36 I $D(XPDNM) S R3015=$$PARCP^XPDUTL("R3015")
37 F S R3015=$O(^IVM(301.5,R3015)) Q:'R3015 D
38 . S SEG="B"
39 . F S SEG=$O(^IVM(301.5,R3015,"IN",SEG),-1) Q:'SEG D
40 . . S (IVMAD,IVMPH)=0
41 . . S DFN=+$P($G(^IVM(301.5,R3015,0)),U,1) Q:'DFN
42 . . S TYPE=$P($G(^IVM(301.5,R3015,"IN",SEG,0)),U,2) Q:TYPE'="PID"
43 . . D CHKREC
44 . . S TYPE=$P($G(^IVM(301.5,R3015,"IN",SEG,0)),U,2)
45 . . I TYPE="" D PROCREC
46 . I $D(XPDNM) S %=$$UPCP^XPDUTL("R3015",R3015)
47 ;
48 D MAIL^IVM273M
49 I $D(XPDNM) S %=$$COMCP^XPDUTL("R3015")
50 D BMES^XPDUTL(" Cleanup of IVM PATIENT file is complete.")
51 Q
52 ;
53CHKREC ; Check Demographic fields
54 N DEMO,DATA0,FLDLOC,IVMDATA,PATPH,PH
55 S DEMO=0
56 F S DEMO=$O(^IVM(301.5,R3015,"IN",SEG,"DEM",DEMO)) Q:'DEMO D
57 . S DATA0=$G(^IVM(301.5,R3015,"IN",SEG,"DEM",DEMO,0)) Q:DATA0=""
58 . S FLDLOC=$P(DATA0,"^",1),IVMDATA=$P(DATA0,"^",2)
59 . I IVMDATA="" D Q
60 . . ; only process address fields
61 . . I '$D(^IVM(301.92,"AD",FLDLOC)) Q
62 . . S IVMAD=1 D DELFLD
63 . I FLDLOC=11 D
64 . . S PATPH=$$CONVPH^IVMPREC8($P($G(^DPT(DFN,.13)),"^",1))
65 . . S PH=$$CONVPH^IVMPREC8(IVMDATA)
66 . . ; quit if the phone numbers are the same, otherwise delete
67 . . ; the field from the IVM PATIENT file
68 . . I PATPH'=PH Q
69 . . S IVMPH=1 D DELFLD
70 ; If no uploadable and no non-uploadable fields delete then entry
71 I '$$DEMO^IVMLDEM5(R3015,SEG,0),'$$DEMO^IVMLDEM5(R3015,SEG,1) D
72 . D DELETE^IVMLDEM5(R3015,SEG,"NAME,DUMMY")
73 Q
74 ;
75DELFLD ; Delete null field
76 N DA,DIE,DR
77 S DA=DEMO,DA(1)=SEG,DA(2)=R3015
78 S DIE="^IVM(301.5,"_DA(2)_",""IN"","_DA(1)_",""DEM"","
79 S DR=".01////@" D ^DIE
80 Q
81 ;
82PROCREC ; Save processed records to the XTMP file
83 N DATA,NAME,SSN
84 S DATA=$G(^DPT(DFN,0)) Q:DATA=""
85 S NAME=$P(DATA,"^",1)
86 S SSN=$P(DATA,"^",9)
87 ;
88 ; Only count the record once even if more than one entry was
89 ; updated.
90 ;
91 I '$D(^XTMP(XTPAT,"RECS",DFN)) S ^XTMP(XTPAT,1)=$G(^XTMP(XTPAT,1))+1
92 S ^XTMP(XTPAT,"RECS",DFN)=R3015_U_NAME_U_SSN
93 I IVMAD S $P(^XTMP(XTPAT,"RECS",DFN),U,4)=1
94 I IVMPH S $P(^XTMP(XTPAT,"RECS",DFN),U,5)=1
95 Q
96 ;
97CLEANUP ; Used to cleanup XTMP global for testing only
98 S XTPAT="IVM*2.0*73-PATREC"
99 ;
100 K ^XTMP(XTPAT)
101 Q
Note: See TracBrowser for help on using the repository browser.