Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IVMLDEMC

IVMLDEMC.m

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