DG53602S ;ALB/TDM,BRM - Combat Veteran End Date Sync ; 6/3/04 12:16pm
;;5.3;Registration;**602**; Aug 13,1993
;This post install routine will loop through the "E" cross reference
;of the PATIENT (#2) file and trigger a Z07 message to the HEC system
;for all entries that have a value in the COMBAT VETERAN END DATE
;(#.5295) field that is greater than 1/16/03.
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^DG53602S",ZTIO="",ZTDTH=$$NOW^XLFDT()
S ZTDESC="CV END DATE SYNCHRONIZATION"
K ^XTMP("DG53602S")
D ^%ZTLOAD S ^XTMP("DG53602S","TASK")=ZTSK
S TXT(1)="Task: "_ZTSK_" Queued."
D BMES^XPDUTL(.TXT)
Q
;
EP1 ;Entry point
N X1,X2,X,XCVDT,XIEN,TOT,CVDT,CNT,EVENT,IYR
S X1=DT,X2=60 D C^%DTC
S ^XTMP("DG53602S",0)=X_"^"_$$DT^XLFDT_"^DG*5.3*602 Combat Vet Information Sharing w/HEC"
S $P(^XTMP("DG53602S","DATE"),"^")=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
;
;Create index by patient.
I $D(^DPT("E")) D
. S (XCVDT,XIEN)=0
. F S XCVDT=$O(^DPT("E",XCVDT)) Q:XCVDT="" D
. . F S XIEN=$O(^DPT("E",XCVDT,XIEN)) Q:XIEN="" D
. . . S ^XTMP("DG53602S","INDEX",XIEN)=""
;
;Loop through ^XTMP("DG53602S","INDEX") index.
I $D(^XTMP("DG53602S","INDEX")) D
. S (XIEN,TOT,CNT)=0,EVENT("ENROLL")=1
. F S XIEN=$O(^XTMP("DG53602S","INDEX",XIEN)) Q:+XIEN=0 D
. . S CVDT=$P($G(^DPT(XIEN,.52)),"^",15) Q:'CVDT ;No CV End Date
. . S TOT=TOT+1,$P(^XTMP("DG53602S",1),"^")=TOT ;Tot records
. . Q:(CVDT<3030117) ;No CV END DT or CVDT<EGT date
. . S IYR=$$INCYR(XIEN) Q:'$$LOG^IVMPLOG(XIEN,IYR,.EVENT) ;Queue Z07
. . S CNT=CNT+1,$P(^XTMP("DG53602S",1),"^",2)=CNT ;Tot Z07's queued
. . S ^XTMP("DG53602S","INDEX",XIEN)="Z07 Queued"
S $P(^XTMP("DG53602S","DATE"),"^",2)=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
S ^XTMP("DG53602S","COMPLETED")=1
D MAIL ;send mailman message to User
D BMES^XPDUTL("Post install process for Combat Veteran End Date synchronization is complete.")
Q
;
CHK ;check for completion
N TXT,TASKNUM,STAT
S OK=1
I $D(^XTMP("DG53602S","COMPLETED")) D
. S OK=0
. N TXT
. S TXT(1)="The Combat Veteran End Date synchronization process was completed in a"
. S TXT(2)="previous run. Nothing Done!"
. D BMES^XPDUTL(.TXT)
;
S TASKNUM=$G(^XTMP("DG53602S","TASK"))
I +TASKNUM D Q
. S STAT=$$ACTIVE(TASKNUM)
. I STAT>0 D
. . S OK=0
. . S TXT(1)="Task: "_TASKNUM_" is currently running the Combat Veteran End Date"
. . S TXT(2)="synchronization process. Duplicate processes cannot be started."
. . D BMES^XPDUTL(.TXT)
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 COMBAT VETERAN END DATE (#.5295) field that is"
S TXT(4)="on or after 1/17/03."
S TXT(5)=" "
D BMES^XPDUTL(.TXT)
Q
;
MAIL N SITE,STATN,SITENM,XMDUZ,XMSUB,XMY,XMTEXT,MSG,ADR
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]"
S XMDUZ="CV END DATE SYNCHRONIZATION",XMSUB=XMDUZ_" - "_STATN_" (DG*5.3*602)"
S (XMY(DUZ),XMY(.5))=""
S XMY("terry.moore3@domain.ext")="",XMY("pat.wilson@domain.ext")=""
S XMTEXT="MSG("
S MSG(1)="Combat Veteran End Date synchronization process has completed successfully."
S MSG(1.5)="Task: "_$G(^XTMP("DG53602S","TASK"))
S MSG(2)=""
S MSG(3)="Site Station number: "_STATN
S MSG(4)="Site Name: "_SITENM
S MSG(5)=""
S MSG(6)="Process started at : "_$P($G(^XTMP("DG53602S","DATE")),"^",1)
S MSG(7)="Process completed at : "_$P($G(^XTMP("DG53602S","DATE")),"^",2)
S MSG(8)="Total Veterans processed : "_+$P($G(^XTMP("DG53602S",1)),"^",1)
S MSG(9)="Total Veterans queued for Z07: "_+$P($G(^XTMP("DG53602S",1)),"^",2)
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53602S 4635 printed Apr 09, 2024@21:43:06 Page 2
DG53602S ;ALB/TDM,BRM - Combat Veteran End Date Sync ; 6/3/04 12:16pm
+1 ;;5.3;Registration;**602**; Aug 13,1993
+2 ;This post install routine will loop through the "E" cross reference
+3 ;of the PATIENT (#2) file and trigger a Z07 message to the HEC system
+4 ;for all entries that have a value in the COMBAT VETERAN END DATE
+5 ;(#.5295) field that is greater than 1/16/03.
+6 QUIT
+7 ;
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^DG53602S"
SET ZTIO=""
SET ZTDTH=$$NOW^XLFDT()
+3 SET ZTDESC="CV END DATE SYNCHRONIZATION"
+4 KILL ^XTMP("DG53602S")
+5 DO ^%ZTLOAD
SET ^XTMP("DG53602S","TASK")=ZTSK
+6 SET TXT(1)="Task: "_ZTSK_" Queued."
+7 DO BMES^XPDUTL(.TXT)
+8 QUIT
+9 ;
EP1 ;Entry point
+1 NEW X1,X2,X,XCVDT,XIEN,TOT,CVDT,CNT,EVENT,IYR
+2 SET X1=DT
SET X2=60
DO C^%DTC
+3 SET ^XTMP("DG53602S",0)=X_"^"_$$DT^XLFDT_"^DG*5.3*602 Combat Vet Information Sharing w/HEC"
+4 SET $PIECE(^XTMP("DG53602S","DATE"),"^")=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
+5 ;
+6 ;Create index by patient.
+7 IF $DATA(^DPT("E"))
Begin DoDot:1
+8 SET (XCVDT,XIEN)=0
+9 FOR
SET XCVDT=$ORDER(^DPT("E",XCVDT))
if XCVDT=""
QUIT
Begin DoDot:2
+10 FOR
SET XIEN=$ORDER(^DPT("E",XCVDT,XIEN))
if XIEN=""
QUIT
Begin DoDot:3
+11 SET ^XTMP("DG53602S","INDEX",XIEN)=""
End DoDot:3
End DoDot:2
End DoDot:1
+12 ;
+13 ;Loop through ^XTMP("DG53602S","INDEX") index.
+14 IF $DATA(^XTMP("DG53602S","INDEX"))
Begin DoDot:1
+15 SET (XIEN,TOT,CNT)=0
SET EVENT("ENROLL")=1
+16 FOR
SET XIEN=$ORDER(^XTMP("DG53602S","INDEX",XIEN))
if +XIEN=0
QUIT
Begin DoDot:2
+17 ;No CV End Date
SET CVDT=$PIECE($GET(^DPT(XIEN,.52)),"^",15)
if 'CVDT
QUIT
+18 ;Tot records
SET TOT=TOT+1
SET $PIECE(^XTMP("DG53602S",1),"^")=TOT
+19 ;No CV END DT or CVDT<EGT date
if (CVDT<3030117)
QUIT
+20 ;Queue Z07
SET IYR=$$INCYR(XIEN)
if '$$LOG^IVMPLOG(XIEN,IYR,.EVENT)
QUIT
+21 ;Tot Z07's queued
SET CNT=CNT+1
SET $PIECE(^XTMP("DG53602S",1),"^",2)=CNT
+22 SET ^XTMP("DG53602S","INDEX",XIEN)="Z07 Queued"
End DoDot:2
End DoDot:1
+23 SET $PIECE(^XTMP("DG53602S","DATE"),"^",2)=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
+24 SET ^XTMP("DG53602S","COMPLETED")=1
+25 ;send mailman message to User
DO MAIL
+26 DO BMES^XPDUTL("Post install process for Combat Veteran End Date synchronization is complete.")
+27 QUIT
+28 ;
CHK ;check for completion
+1 NEW TXT,TASKNUM,STAT
+2 SET OK=1
+3 IF $DATA(^XTMP("DG53602S","COMPLETED"))
Begin DoDot:1
+4 SET OK=0
+5 NEW TXT
+6 SET TXT(1)="The Combat Veteran End Date synchronization process was completed in a"
+7 SET TXT(2)="previous run. Nothing Done!"
+8 DO BMES^XPDUTL(.TXT)
End DoDot:1
+9 ;
+10 SET TASKNUM=$GET(^XTMP("DG53602S","TASK"))
+11 IF +TASKNUM
Begin DoDot:1
+12 SET STAT=$$ACTIVE(TASKNUM)
+13 IF STAT>0
Begin DoDot:2
+14 SET OK=0
+15 SET TXT(1)="Task: "_TASKNUM_" is currently running the Combat Veteran End Date"
+16 SET TXT(2)="synchronization process. Duplicate processes cannot be started."
+17 DO BMES^XPDUTL(.TXT)
End DoDot:2
End DoDot:1
QUIT
+18 QUIT
+19 ;
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 COMBAT VETERAN END DATE (#.5295) field that is"
+5 SET TXT(4)="on or after 1/17/03."
+6 SET TXT(5)=" "
+7 DO BMES^XPDUTL(.TXT)
+8 QUIT
+9 ;
MAIL NEW SITE,STATN,SITENM,XMDUZ,XMSUB,XMY,XMTEXT,MSG,ADR
+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 SET XMDUZ="CV END DATE SYNCHRONIZATION"
SET XMSUB=XMDUZ_" - "_STATN_" (DG*5.3*602)"
+4 SET (XMY(DUZ),XMY(.5))=""
+5 SET XMY("terry.moore3@domain.ext")=""
SET XMY("pat.wilson@domain.ext")=""
+6 SET XMTEXT="MSG("
+7 SET MSG(1)="Combat Veteran End Date synchronization process has completed successfully."
+8 SET MSG(1.5)="Task: "_$GET(^XTMP("DG53602S","TASK"))
+9 SET MSG(2)=""
+10 SET MSG(3)="Site Station number: "_STATN
+11 SET MSG(4)="Site Name: "_SITENM
+12 SET MSG(5)=""
+13 SET MSG(6)="Process started at : "_$PIECE($GET(^XTMP("DG53602S","DATE")),"^",1)
+14 SET MSG(7)="Process completed at : "_$PIECE($GET(^XTMP("DG53602S","DATE")),"^",2)
+15 SET MSG(8)="Total Veterans processed : "_+$PIECE($GET(^XTMP("DG53602S",1)),"^",1)
+16 SET MSG(9)="Total Veterans queued for Z07: "_+$PIECE($GET(^XTMP("DG53602S",1)),"^",2)
+17 DO ^XMD
+18 QUIT
+19 ;
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
