| [613] | 1 | IVMLDEMC ;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
|
|---|
| 5 | EN(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
|
|---|
| 18 | LOOP(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
|
|---|
| 37 | RULES(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 | ;
|
|---|
| 45 | FNDSEG(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 | ;
|
|---|
| 58 | DATA ;; 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)
|
|---|
