65 lines
2.5 KiB
Mathematica
65 lines
2.5 KiB
Mathematica
IVMLDEMC ;ALB/BRM/PJR - IVM UPLOAD DEMO CLEAN-UP ; 10/21/04 11:36am
|
|
;;2.0;INCOME VERIFICATION MATCH;**79,102**; 21-OCT-94
|
|
;
|
|
Q
|
|
EN(ADDRDT) ; entry point
|
|
N IVMDA,IVMDA1,IVMDA2,SEG
|
|
N X1,X2,Y,SSN,DFN
|
|
D FNDSEG(.SEG)
|
|
S IVMDA2=0
|
|
F S IVMDA2=$O(^IVM(301.5,IVMDA2)) Q:IVMDA2="" D
|
|
.S DFN=$P($G(^IVM(301.5,IVMDA2,0)),"^"),IVMDA1=0
|
|
.Q:('DFN)!('$D(^DPT(+DFN)))!('$D(^IVM(301.5,IVMDA2,"IN")))
|
|
.F S IVMDA1=$O(^IVM(301.5,IVMDA2,"IN",IVMDA1)) Q:'IVMDA1 D
|
|
..D LOOP(DFN,IVMDA2,IVMDA1,.SEG,.ADDRDT)
|
|
..; if no display or uploadable fields, delete PID segment
|
|
..I ('$$DEMO^IVMLDEM5(IVMDA2,IVMDA1,0))&('$$DEMO^IVMLDEM5(IVMDA2,IVMDA1,1)) D DELETE^IVMLDEM5(IVMDA2,IVMDA1," ")
|
|
Q
|
|
LOOP(DFN,IVMDA2,IVMDA1,SEG,ADDRDT) ;
|
|
N SEGNUM,X,X1,X2,%Y
|
|
Q:'$D(SEG)
|
|
S (SEGNUM,SEGNAM)=""
|
|
F S SEGNAM=$O(SEG(SEGNAM)) Q:SEGNAM']"" D
|
|
.S SEGNUM=$P($G(SEG(SEGNAM)),"^"),IVMTYPE=+$P($G(SEG(SEGNAM)),"^",2)
|
|
.S IVMDA=""
|
|
.F S IVMDA=$O(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM","B",SEGNUM,IVMDA)) Q:'IVMDA D
|
|
..S IVMDAT=$P($G(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM",IVMDA,0)),"^",3)
|
|
..; ignore recent uploads if this is the one-time clean-up
|
|
..I (IVMDAT&'$G(ADDRDT(IVMTYPE)))!($G(ADDRDT(IVMTYPE))&'IVMDAT) Q
|
|
..; quit if # of days has not passed yet (doesn't apply to EN tag)
|
|
..I $G(ADDRDT(IVMTYPE)),IVMDAT S X1=$$DT^XLFDT,X2=IVMDAT D ^%DTC Q:X<ADDRDT(IVMTYPE)
|
|
..;process fields that are selectively deleted
|
|
..Q:'$$RULES(DFN,SEGNAM)
|
|
..I IVMTYPE,$G(ADDRDT(IVMTYPE)) D AUTOLOAD^IVMLDEM9(DFN,IVMDA2,IVMDA1)
|
|
..; remove entry from (#301.511) sub-file
|
|
..D DELETE^IVMLDEM5(IVMDA2,IVMDA1," "),DELENT^IVMLDEMU(IVMDA2,IVMDA1,IVMDA)
|
|
Q
|
|
RULES(DFN,SEGNAM) ;can this data element be deleted?
|
|
Q:SEGNAM'="ZPD09" 1
|
|
Q:'$G(DFN) 0
|
|
N VADM
|
|
D DEM^VADPT
|
|
Q:$G(VADM(6))]"" 1 ;delete dod if present in Patient file (#2)
|
|
Q 0
|
|
;
|
|
FNDSEG(SEG) ;
|
|
N SEGLOC,LINE,QUIT,TAG,SEGDAT,PIECE
|
|
S LINE=1,SEGDAT="",QUIT=0
|
|
F S LINE=LINE+1 Q:$G(QUIT) D
|
|
.S TAG="DATA+"_LINE,SEGDAT=$P($T(@(TAG)),";;",2)
|
|
.I SEGDAT']"" S QUIT=1 Q
|
|
.F PIECE=1:1:10 Q:$P(SEGDAT,"~",PIECE)="" D
|
|
..S SEGLOC=$P(SEGDAT,"~",PIECE) Q:'$D(^IVM(301.92,"C",SEGLOC))
|
|
..S SEG(SEGLOC)=$O(^IVM(301.92,"C",SEGLOC,""))
|
|
..Q:'$G(SEG(SEGLOC))
|
|
..S $P(SEG(SEGLOC),"^",2)=$P($G(^IVM(301.92,SEG(SEGLOC),0)),"^",8)
|
|
Q
|
|
;
|
|
DATA ;; do not modify below values! They are used to set-up the array
|
|
;; that determines the fields to delete and/or process
|
|
;;PID111~PID112~PID113~PID114~PID115~PID12~PID13~RF171~ZPD09~ZPD13
|
|
;;ZGD03~ZGD04~ZGD05~ZGD061~ZGD062~ZGD063~ZGD064~ZGD065~ZGD07~ZGD08
|
|
;;ZPD08~ZPD12~ZPD13~ZEL02~ZEL06~ZPD31~ZPD32
|
|
;;
|
|
;; end of data (do not remove or modify above "blank" line)
|