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