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

IVM2101C.m

Go to the documentation of this file. 
  1. IVM2101C ;ALB/CKN,GTS - FILED BY IVM FLAG CLEANUP ; 2/17/05 4:52pm
  1.  ;;2.0;INCOME VERIFICATION MATCH;**101**; 21-OCT-94;Build 5
  1.  Q
  1. TEST ; Test Mode
  1.  S MODE=0
  1.  ;
  1. EP ;
  1.  N TXT
  1.  ;Create bulletin message in install file.
  1.  ;Quit if initial check fails.
  1.  Q:$$CHECK()
  1.  ;Queue task
  1.  D QUETASK
  1.  Q
  1. NMSPC() ;
  1.  Q "IVM*2*101"
  1.  ;
  1. CHECK() ;Initial Checking
  1.  ; Output : 0 - Conversion not running or completed
  1.  ;          1 - Task is running or completed
  1.  ;
  1.  N DONE,STAT,TASKNUM,NAMESPC
  1.  S DONE=0
  1.  S NAMESPC=$$NMSPC()
  1.  I '$D(^XTMP(NAMESPC)) Q DONE
  1.  I $G(^XTMP(NAMESPC,"CONFIG","COMPLETED"))=1 D  Q DONE
  1.  . D DONEMSG
  1.  . S DONE=1
  1.  S TASKNUM=$G(^XTMP(NAMESPC,"CONFIG","TASK"))
  1.  I TASKNUM'="" D
  1.  . S STAT=$$ACTIVE(TASKNUM)
  1.  . I STAT>0 D RUNMSG S DONE=1
  1.  Q DONE
  1. ACTIVE(TASK) ;Checks if task is running or not
  1.  ;  input   --   The taskman ID
  1.  ;  output  --   1=The task is running
  1.  ;               0=The task is not running
  1.  ;
  1.  N ZTSK,STAT,Y
  1.  S STAT=0,ZTSK=+TASK
  1.  D STAT^%ZTLOAD
  1.  S Y=ZTSK(1)
  1.  I Y=0 S STAT=-1
  1.  I ",1,2,"[(","_Y_",") S STAT=1
  1.  I ",3,5,"[(","_Y_",") S STAT=0
  1.  Q STAT
  1.  ;
  1. QUETASK ;Queue the Task
  1.  N TXT,ZTRTN,ZTDESC,ZTSK,ZTIO,ZTDTH,NAMESPC
  1.  S NAMESPC=$$NMSPC()
  1.  S ZTRTN="EP1^IVM2101C",ZTIO="",ZTDTH=$$NOW^XLFDT()
  1.  S ZTDESC=NAMESPC_" - FILED BY IVM FLAG CLEANUP"
  1.  ; Create XTMP array
  1.  S X1=DT,X2=120 D C^%DTC
  1.  S ^XTMP(NAMESPC,0)=X_"^"_$$DT^XLFDT_"^"_NAMESPC_" FIX FILED BY IVM ERROR"
  1.  D ^%ZTLOAD S ^XTMP(NAMESPC,"CONFIG","TASK")=ZTSK
  1.  S TXT(1)="Task: "_ZTSK_" Queued."
  1.  D BMES^XPDUTL(.TXT)
  1.  Q
  1. EP1 ;Entry Point
  1.  N XIEN,XIYR,EIEN,XRELIEN,XDGMT,AMTIEN,SOURCE,FIVM,NAMESPC
  1.  N X,X1,X2,TOT,CNT,ZTSTOP
  1.  S ZTSTOP=0
  1.  S NAMESPC=$$NMSPC()
  1.  S XIEN=+$G(^XTMP(NAMESPC,"CONFIG","CURRENT IEN"))
  1.  ; Update XTMP array 0 node purge date.
  1.  S X1=DT,X2=120 D C^%DTC
  1.  S ^XTMP(NAMESPC,0)=X_"^"_$$DT^XLFDT_"^"_NAMESPC_" FIX FILED BY IVM ERROR"
  1.  ;Store start date
  1.  I '$D(^XTMP(NAMESPC,"CONFIG","START DATE")) S ^XTMP(NAMESPC,"CONFIG","START DATE")=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
  1.  S TOT=+$G(^XTMP(NAMESPC,"CONFIG","TOTAL PROCESSED"))
  1.  S CNT=+$G(^XTMP(NAMESPC,"CONFIG","TOTAL FOUND"))
  1.  ;Loop through 408.12 file - get Veteran IEN
  1.  F  S XIEN=$O(^DGPR(408.12,"B",XIEN)) Q:+XIEN=0!(ZTSTOP)  D
  1.  . S TOT=TOT+1  ;Processed records counter
  1.  . S ^XTMP(NAMESPC,"CONFIG","TOTAL PROCESSED")=TOT
  1.  . S ^XTMP(NAMESPC,"CONFIG","CURRENT IEN")=XIEN
  1.  . I (TOT#1000=0),$$S^%ZTLOAD S ZTSTOP=1  ;Check for stop request
  1.  . S XRELIEN=0
  1.  . ;Get 408.12 iens for each Veteran
  1.  . F  S XRELIEN=$O(^DGPR(408.12,"B",XIEN,XRELIEN)) Q:XRELIEN=""  D
  1.  . . S EIEN=0
  1.  . . F  S EIEN=$O(^DGPR(408.12,XRELIEN,"E",EIEN)) Q:EIEN=""  D
  1.  . . . ;Get Filed By IVM flag
  1.  . . . S FIVM=$P($G(^DGPR(408.12,XRELIEN,"E",EIEN,0)),"^",3)
  1.  . . . I FIVM="" Q  ;Quit if flag is not set
  1.  . . . ; Get Annual Means test ien for FILED BY IVM flag
  1.  . . . S AMTIEN=$P($G(^DGPR(408.12,XRELIEN,"E",EIEN,0)),"^",4)
  1.  . . . Q:AMTIEN=""  ;Quit if Annual MT IEN is not set.
  1.  . . . S XIYR=$P($G(^DGMT(408.31,AMTIEN,0)),"^")  ;Income Year
  1.  . . . I XIYR<3040000 Q  ;Quit if income year is less than 2004
  1.  . . . ;Get source of MT
  1.  . . . S SOURCE=$P($G(^DGMT(408.31,AMTIEN,0)),"^",23)
  1.  . . . ;If SOURCE OF INCOME TEST is VAMC or OTHER FACILITY
  1.  . . . I (FIVM=1),((SOURCE=1)!(SOURCE=4)) D
  1.  . . . . S SOURCE=SOURCE_"^"_$P($G(^DG(408.34,SOURCE,0)),"^",1)
  1.  . . . . S CNT=CNT+1,^XTMP(NAMESPC,"CONFIG","TOTAL FOUND")=CNT
  1.  . . . . S ^XTMP(NAMESPC,CNT,"PATIENT IEN")=XIEN
  1.  . . . . S ^XTMP(NAMESPC,CNT,"ANNUAL MT IEN")=AMTIEN
  1.  . . . . S ^XTMP(NAMESPC,CNT,"PATIENT RELATION IEN")=XRELIEN
  1.  . . . . S ^XTMP(NAMESPC,CNT,"SOURCE OF INCOME TEST")=SOURCE
  1.  . . . . S ^XTMP(NAMESPC,CNT,"PREVIOUS FILED BY IVM")=FIVM_"^YES"
  1.  . . . . ;Reset FILED BY IVM field to NULL
  1.  . . . . S $P(^DGPR(408.12,XRELIEN,"E",EIEN,0),"^",3)=""
  1.  S ^XTMP(NAMESPC,"CONFIG","STOP DATE")=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
  1.  I ZTSTOP D  Q
  1.  . D ABORTMSG
  1.  S ^XTMP(NAMESPC,"CONFIG","COMPLETED")=1
  1.  D COMPMSG
  1.  Q
  1.  ;
  1. DONEMSG ;Send message that process is already Completed.
  1.  N MSG,XMDUZ,XMSUB,XMTEXT,XMY
  1.  S XMSUB=NAMESPC_" - FILED BY IVM FLAG CLEANUP already completed"
  1.  S XMDUZ=NAMESPC_" INSTALLATION PROCESS"
  1.  S (XMY(.5),XMY(DUZ))="",XMTEXT="MSG("
  1.  S MSG(1)="FILED BY IVM FLAG CLEANUP process was completed in previous run."
  1.  D ^XMD
  1.  D BMES^XPDUTL(.MSG)
  1.  Q
  1. RUNMSG ;Send message that process is currently running.
  1.  N NAMESPC,MSG,XMDUZ,XMSUB,XMTEXT,XMY
  1.  S NAMESPC=$$NMSPC()
  1.  S XMSUB=NAMESPC_" - FILED BY IVM FLAG CLEANUP running"
  1.  S XMDUZ=NAMESPC_" INSTALLATION PROCESS"
  1.  S (XMY(.5),XMY(DUZ))="",XMTEXT="MSG("
  1.  S MSG(1)="TASK: "_TASKNUM_" is currently running FILED BY IVM FLAG CLEANUP"
  1.  S MSG(2)="process. Duplicate process cannot be started."
  1.  D ^XMD
  1.  D BMES^XPDUTL(.MSG)
  1.  Q
  1. ABORTMSG ;Send message for stop request.
  1.  N MSG,XMDUX,XMSUB,XMTEXT,XMY
  1.  S XMSUB=NAMESPC_" - FILED BY IVM FLAG CLEANUP stopped"
  1.  S XMDUZ=NAMESPC_" INSTALLATION PROCESS"
  1.  S (XMY(.5),XMY(DUZ))="",XMTEXT="MSG("
  1.  S MSG(1)="TASK: "_$G(^XTMP(NAMESPC,"CONFIG","TASK"))_" FILED BY IVM FLAG CLEANUP"
  1.  S MSG(2)=""
  1.  S MSG(3)="FILED BY IVM error cleanup process was requested to stop"
  1.  S MSG(4)="by the user. Please restart the process by using the following"
  1.  S MSG(5)="command at the programmer prompt:"
  1.  S MSG(6)="D EP^IVM2101C"
  1.  D ^XMD
  1.  Q
  1. COMPMSG ;Send message for completed Task.
  1.  N MSG,XMDUX,XMSUB,XMTEXT,XMY
  1.  S XMSUB=NAMESPC_" - FILED BY IVM FLAG CLEANUP completed"
  1.  S XMDUZ=NAMESPC_" INSTALLATION PROCESS"
  1.  S (XMY(.5),XMY(DUZ))="",XMTEXT="MSG("
  1.  S MSG(1)="TASK: "_$G(^XTMP(NAMESPC,"CONFIG","TASK"))_" FILED BY IVM FLAG CLEANUP"
  1.  S MSG(2)=""
  1.  S MSG(3)="FILED BY IVM error cleanup process has completed.  Review the"
  1.  S MSG(4)="following ^XTMP global for details on the Patient Relation file (408.12)"
  1.  S MSG(5)="records converted: ^XTMP("""_NAMESPC_""","
  1.  S MSG(6)=""
  1.  S MSG(7)="This global will be deleted in no more than 120 days from the date"
  1.  S MSG(8)="of this message."
  1.  D ^XMD
  1.  Q