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

IVM2B102.m

Go to the documentation of this file. 
  1. IVM2B102 ;ALB/PJR - IVM*2.0*102 POST-INSTALL ; 12/30/04 3:51pm
  1.  ;;2.0;INCOME VERIFICATION MATCH;**102**; 21-OCT-94
  1.  ;
  1.  ;This post install routine will loop through patient file (#2)
  1.  ;and trigger a Z07 message to the HEC system
  1.  ;for all entries that have a value in the DATE OF DEATH field (#.351)
  1.  ;and a value in the SOURCE OF NOTIFICATION field (#.353)
  1.  ;of 1, 2, 3, 4, 5, 8, or 9
  1.  Q
  1.  ;
  1. EP ;Entry point
  1.  N OK
  1.  D CHK Q:'OK
  1.  D MSG
  1.  D QUETASK
  1.  Q
  1.  ;
  1. QUETASK ;Queue the task
  1.  N TXT,ZTRTN,ZTDESC,ZTSK,ZTIO,ZTDTH
  1.  S ZTRTN="EP1^IVM2B102",ZTIO="",ZTDTH=$$NOW^XLFDT()
  1.  S ZTDESC="DOD ENHANCEMENT POST-INSTALL"
  1.  D ^%ZTLOAD S ^XTMP("IVM2B102","TASK")=ZTSK
  1.  S TXT(1)="Task: "_ZTSK_" Queued."
  1.  D BMES^XPDUTL(.TXT)
  1.  Q
  1.  ;
  1. EP1 ;Entry point
  1.  N X,XIEN,EVENT,IYR,ZCNT,ZIEN,ZEND,ZDATE,ZEDATE
  1.  L +^XTMP("IVM2B102"):1 E  Q
  1.  S X=$G(^XTMP("IVM2B102",0)),ZCNT=+X,ZIEN=+$P(X,U,4),ZEND=ZCNT+4999
  1.  S ZDATE=$$DT^XLFDT D IVM2
  1.  S ^XTMP("IVM2B102",0)=ZCNT_U_ZDATE_U_X_U_ZIEN
  1.  S $P(^XTMP("IVM2B102","DATE"),"^")=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
  1.  D LMINUS
  1.  ;Loop through patient file
  1.  F  S ZIEN=$O(^DPT(ZIEN)) Q:ZCNT>ZEND!('ZIEN)  D
  1.  .S X=$G(^DPT(ZIEN,.35)) I X,"^1^2^3^4^5^8^9^"[("^"_$P(X,"^",3)_"^") D
  1.  ..S IYR=$$INCYR(ZIEN) Q:IYR=""
  1.  ..Q:'$$LOG^IVMPLOG(ZIEN,IYR,.EVENT)  ;Queue Z07
  1.  ..S ZCNT=ZCNT+1 ;Tot Z07's queued
  1.  S $P(^XTMP("IVM2B102","DATE"),"^",2)=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
  1.  S ZDATE=$$DT^XLFDT,ZEDATE=$$FMTE^XLFDT(DT) D IVM2
  1.  S ^XTMP("IVM2B102",0)=ZCNT_U_ZDATE_U_X_U_(ZIEN-1)
  1.  I 'ZIEN S ^XTMP("IVM2B102","COMPLETED")=1 D MAIL
  1.  D IVM2 S X="The "_X_" process is complete"
  1.  I ZIEN S X=X_" for "_ZEDATE
  1.  S X=X_"." D BMES^XPDUTL(X)
  1.  Q
  1.  ;
  1. CHK ;check for completion
  1.  N TXT,TASKNUM,STAT
  1.  S OK=1 L +^XTMP("IVM2B102"):1 E  D  Q
  1.  .S OK=0 D IVM2 S TXT(1)=X_" process has a lock table"
  1.  .S TXT(2)="problem.  Nothing Done!"
  1.  .D BMES^XPDUTL(.TXT),LMINUS
  1.  ;
  1.  I $G(^XTMP("IVM2B102","COMPLETED")) D  Q
  1.  .S OK=0 D IVM2 S TXT(1)=X_" process was completed in a"
  1.  .S TXT(2)="previous run.  Nothing Done!"
  1.  .D BMES^XPDUTL(.TXT),LMINUS
  1.  ;
  1.  S X=$G(^XTMP("IVM2B102",0))
  1.  I $$DT^XLFDT=$P(X,U,2) D  Q
  1.  .S OK=0 D IVM2 S TXT(1)=X_" is complete for today."
  1.  .S TXT(2)="Please re-start tomorrow."
  1.  .D BMES^XPDUTL(.TXT),LMINUS
  1.  ;
  1.  S TASKNUM=$G(^XTMP("IVM2B102","TASK"))
  1.  I +TASKNUM D  Q
  1.  .S STAT=$$ACTIVE(TASKNUM)
  1.  .I STAT>0 D
  1.  ..S OK=0 D IVM2
  1.  ..S TXT(1)="Task: "_TASKNUM_" is currently running the"
  1.  ..S TXT(2)=X_" process."
  1.  ..S TXT(3)="Duplicate processes cannot be started."
  1.  ..D BMES^XPDUTL(.TXT)
  1.  .D LMINUS
  1.  ;
  1.  D LMINUS Q
  1.  ;
  1. MSG ;create bulletin message in install file.
  1.  N TXT
  1.  S TXT(1)="This Post Install routine will queue a Z07 HL7 message to be sent to the"
  1.  S TXT(2)="Health Eligibility Center (HEC) for all entries in the PATIENT (#2) file"
  1.  S TXT(3)="that have a value in the DATE OF DEATH (#.531) field and a"
  1.  S TXT(4)="SOURCE OF NOTIFICATION (#.533) value of 1, 2, 3, 4, 5, 8, or 9"
  1.  S TXT(5)=" "
  1.  D BMES^XPDUTL(.TXT)
  1.  Q
  1.  ;
  1. MAIL N SITE,STATN,SITENM,XMDUZ,XMSUB,XMY,XMTEXT,MSG
  1.  S SITE=$$SITE^VASITE,STATN=$P($G(SITE),"^",3),SITENM=$P($G(SITE),"^",2)
  1.  S:$$GET1^DIQ(869.3,"1,",.03,"I")'="P" STATN=STATN_" [TEST]"
  1.  D IVM2 S XMDUZ=X,XMSUB=XMDUZ_" - "_STATN_" (IVM*2.0*102)"
  1.  S (XMY(DUZ),XMY(.5))=""
  1.  S XMTEXT="MSG(" D IVM2
  1.  S MSG(1)="The "_X_" process"
  1.  S MSG(2)="has completed successfully."
  1.  S MSG(3)="Task: "_$G(^XTMP("IVM2B102","TASK"))
  1.  S MSG(4)=""
  1.  S MSG(5)="Site Station number: "_STATN
  1.  S MSG(6)="Site Name: "_SITENM
  1.  S MSG(7)=""
  1.  S MSG(8)="Final process started at     : "_$P($G(^XTMP("IVM2B102","DATE")),"^",1)
  1.  S MSG(8)="Final process completed at   : "_$P($G(^XTMP("IVM2B102","DATE")),"^",2)
  1.  S MSG(10)="Total Veterans queued for Z07: "_+$G(^XTMP("IVM2B102",0))
  1.  D ^XMD
  1.  Q
  1.  ;
  1. INCYR(XIEN) ;Get valid income year
  1.  N I,LMT,TMP,INCYR
  1.  I $D(^IVM(301.5,"APT",XIEN)) Q $O(^IVM(301.5,"APT",XIEN,""),-1)
  1.  F I=1,2,4 S LMT=$$LST^DGMTU(XIEN,,I) S:+$G(LMT) TMP($P(LMT,"^",2))=""
  1.  I $D(TMP) S LMT=$O(TMP(""),-1),INCYR=($E(LMT,1,3)-1)_"0000" Q INCYR
  1.  S INCYR=($E(DT,1,3)-1)_"0000"
  1.  Q INCYR
  1.  ;
  1. ACTIVE(TASK) ;Checks if task is running
  1.  ;  input  --  The taskman ID
  1.  ;  output --  1=The task is running
  1.  ;             0=The task is not running
  1.  N STAT,ZTSK,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. IVM2 S X="IVM*2.0*102 DOD Post-Install transmit Z07's to HEC" Q
  1. LMINUS L -^XTMP("IVM2B102") Q