102 lines
3.0 KiB
Mathematica
102 lines
3.0 KiB
Mathematica
IVM273A ;ALB/PDJ IVM*2.0*73 - CLEANUP IVM PATIENT FILE;02/07/2003
|
|
;;2.0;INCOME VERIFICATION MATCH;**73**; 21-OCT-94
|
|
;
|
|
EN N DFN,I,R3015,SEG,TEXT,TYPE,X,X1,X2,%,XTPAT,IVMPH,IVMAD
|
|
;
|
|
D BMES^XPDUTL(" ")
|
|
D BMES^XPDUTL(" The Post Install will now process through the IVM PATIENT")
|
|
D BMES^XPDUTL(" FILE to remove entries which do not contain any uploadable")
|
|
D BMES^XPDUTL(" or non-uploadable fields.")
|
|
D BMES^XPDUTL(" ")
|
|
;
|
|
I $D(XPDNM) D
|
|
. I $$VERCP^XPDUTL("R3015")'>0 D
|
|
. . S %=$$NEWCP^XPDUTL("R3015","","0")
|
|
;
|
|
F I="PATREC" D
|
|
. I $D(^XTMP("IVM*2.0*73-"_I)) Q
|
|
. S X1=DT
|
|
. S X2=30
|
|
. D C^%DTC
|
|
. S TEXT=X_"^"_$$DT^XLFDT_"^IVM*2.0*73 POST-INSTALL "
|
|
. S TEXT=TEXT_$S(I="PATREC":"IVM Patient Records",1:"filing errors")
|
|
. S ^XTMP("IVM*2.0*73-"_I,0)=TEXT
|
|
;
|
|
S XTPAT="IVM*2.0*73-PATREC"
|
|
;
|
|
I '$D(XPDNM) D
|
|
. S ^XTMP(XTPAT,1)=0
|
|
I $D(XPDNM)&'$D(^XTMP(XTPAT,1)) S ^XTMP(XTPAT,1)=0
|
|
I $D(XPDNM) S %=$$VERCP^XPDUTL("R3015")
|
|
I $G(%)="" S %=0
|
|
I %=0 D EN1
|
|
Q
|
|
;
|
|
EN1 I '$D(XPDNM) S R3015=0
|
|
I $D(XPDNM) S R3015=$$PARCP^XPDUTL("R3015")
|
|
F S R3015=$O(^IVM(301.5,R3015)) Q:'R3015 D
|
|
. S SEG="B"
|
|
. F S SEG=$O(^IVM(301.5,R3015,"IN",SEG),-1) Q:'SEG D
|
|
. . S (IVMAD,IVMPH)=0
|
|
. . S DFN=+$P($G(^IVM(301.5,R3015,0)),U,1) Q:'DFN
|
|
. . S TYPE=$P($G(^IVM(301.5,R3015,"IN",SEG,0)),U,2) Q:TYPE'="PID"
|
|
. . D CHKREC
|
|
. . S TYPE=$P($G(^IVM(301.5,R3015,"IN",SEG,0)),U,2)
|
|
. . I TYPE="" D PROCREC
|
|
. I $D(XPDNM) S %=$$UPCP^XPDUTL("R3015",R3015)
|
|
;
|
|
D MAIL^IVM273M
|
|
I $D(XPDNM) S %=$$COMCP^XPDUTL("R3015")
|
|
D BMES^XPDUTL(" Cleanup of IVM PATIENT file is complete.")
|
|
Q
|
|
;
|
|
CHKREC ; Check Demographic fields
|
|
N DEMO,DATA0,FLDLOC,IVMDATA,PATPH,PH
|
|
S DEMO=0
|
|
F S DEMO=$O(^IVM(301.5,R3015,"IN",SEG,"DEM",DEMO)) Q:'DEMO D
|
|
. S DATA0=$G(^IVM(301.5,R3015,"IN",SEG,"DEM",DEMO,0)) Q:DATA0=""
|
|
. S FLDLOC=$P(DATA0,"^",1),IVMDATA=$P(DATA0,"^",2)
|
|
. I IVMDATA="" D Q
|
|
. . ; only process address fields
|
|
. . I '$D(^IVM(301.92,"AD",FLDLOC)) Q
|
|
. . S IVMAD=1 D DELFLD
|
|
. I FLDLOC=11 D
|
|
. . S PATPH=$$CONVPH^IVMPREC8($P($G(^DPT(DFN,.13)),"^",1))
|
|
. . S PH=$$CONVPH^IVMPREC8(IVMDATA)
|
|
. . ; quit if the phone numbers are the same, otherwise delete
|
|
. . ; the field from the IVM PATIENT file
|
|
. . I PATPH'=PH Q
|
|
. . S IVMPH=1 D DELFLD
|
|
; If no uploadable and no non-uploadable fields delete then entry
|
|
I '$$DEMO^IVMLDEM5(R3015,SEG,0),'$$DEMO^IVMLDEM5(R3015,SEG,1) D
|
|
. D DELETE^IVMLDEM5(R3015,SEG,"NAME,DUMMY")
|
|
Q
|
|
;
|
|
DELFLD ; Delete null field
|
|
N DA,DIE,DR
|
|
S DA=DEMO,DA(1)=SEG,DA(2)=R3015
|
|
S DIE="^IVM(301.5,"_DA(2)_",""IN"","_DA(1)_",""DEM"","
|
|
S DR=".01////@" D ^DIE
|
|
Q
|
|
;
|
|
PROCREC ; Save processed records to the XTMP file
|
|
N DATA,NAME,SSN
|
|
S DATA=$G(^DPT(DFN,0)) Q:DATA=""
|
|
S NAME=$P(DATA,"^",1)
|
|
S SSN=$P(DATA,"^",9)
|
|
;
|
|
; Only count the record once even if more than one entry was
|
|
; updated.
|
|
;
|
|
I '$D(^XTMP(XTPAT,"RECS",DFN)) S ^XTMP(XTPAT,1)=$G(^XTMP(XTPAT,1))+1
|
|
S ^XTMP(XTPAT,"RECS",DFN)=R3015_U_NAME_U_SSN
|
|
I IVMAD S $P(^XTMP(XTPAT,"RECS",DFN),U,4)=1
|
|
I IVMPH S $P(^XTMP(XTPAT,"RECS",DFN),U,5)=1
|
|
Q
|
|
;
|
|
CLEANUP ; Used to cleanup XTMP global for testing only
|
|
S XTPAT="IVM*2.0*73-PATREC"
|
|
;
|
|
K ^XTMP(XTPAT)
|
|
Q
|