DG53735P ;EG,TMK - Re-transmit OEF-OIF Data to HEC ; 10/24/2006
;;5.3;Registration;**735**;Aug 13,1993;Build 11
; LOGIC USED:
; - Find all veterans with OEF/OIF data using the 'ALOEIF;' cross
; reference by latest OEF/OIF TO DATE and patient
; - Check the PATIENT file (#2) record for a valid CV end date.
; - If the CV end date is not valid, or
; If the CV End Date is valid, but the last Z07 message transmission
; for the veteran was dated before the OEF/OIF data was added,
; Flag the record so it will be sent to HEC via an HL7 Z07 message
; and if the CV End date was not valid, update it to be the
; calculated value.
;
EP ; Queue the conversion
N %
S %=$$NEWCP^XPDUTL("IEN12","POST^DG53735P")
S %=$$NEWCP^XPDUTL("END","END^DG53735P") ; Leave as last update
Q
;
POST N ZTSK
D BMES^XPDUTL("Queue-ing Transmit OEF/OIF data to HEC ...")
D QUE
D BMES^XPDUTL("This request queued as Task # "_$G(ZTSK))
D BMES^XPDUTL("=====================================================")
D BMES^XPDUTL("")
Q
;
END ; Post-install done
D BMES^XPDUTL("Post install complete.")
Q
;
QUE N ZTRTN,ZTDESC,ZTSAVE,ZTIO,ZTDTH
S ZTRTN="RUN^DG53735P",ZTDESC="Re-transmit of OEF/OIF Data"
S ZTIO="",ZTDTH=$$NOW^XLFDT()
D ^%ZTLOAD
Q
;
RUN ;entry point from taskman
N NAMSPC
S NAMSPC=$$NAMSPC
I '$$CHKSTAT(1,NAMSPC) D Q
. D BMES^XPDUTL("Conversion routine already running, process aborted")
N TESTING
S TESTING="N" K ^XTMP(NAMSPC) D DEQUE(NAMSPC)
Q
;
TEST ; test entry point
N TESTING,X,STARTDT,ENDDT,NAMSPC
S NAMSPC=$$NAMSPC
S TESTING="Y"
S X=$$CHKSTAT(0,NAMSPC)
K ^XTMP(NAMSPC,"TEST RANGE"),^XTMP(NAMSPC,"TEST")
S STARTDT=$$TESTID("Starting ")
Q:'STARTDT
S ENDDT=$$TESTID("Ending ")
Q:'ENDDT
I ENDDT<STARTDT W !,?10,"Ending To Date can't be less than starting To Date" Q
S ^XTMP(NAMSPC,"TEST RANGE")=STARTDT_U_ENDDT
D DEQUE(NAMSPC)
Q
;
TESTID(MESS) ;
N DGX,DIR,DTOUT,DUOUT,X,Y
S DIR(0)="DA",DIR("A")=MESS_" To Date for OEF/OIF xref: "
W !! D ^DIR K DIR
S DGX=Y
I $D(DUOUT)!$D(DTOUT) S DGX=""
Q DGX
;
DEQUE(NAMSPC) ;
N X
I '$D(TESTING) N TESTING S TESTING="N"
D SETUPX(90,NAMSPC)
S X=$G(^XTMP(NAMSPC,0,0))
S $P(X,U,6)="RUNNING"
S $P(X,U,7)=$$NOW^XLFDT()
S ^XTMP(NAMSPC,0,0)=X
;
S ZTSTOP=$$LOOP(NAMSPC,TESTING)
S X=$G(^XTMP(NAMSPC,0,0))
S $P(X,U,6)=$S(ZTSTOP:"STOPPED",1:"COMPLETED")
S $P(X,U,8)=$$NOW^XLFDT()
S ^XTMP(NAMSPC,0,0)=X
;
D MAIL(NAMSPC,TESTING,DUZ)
K TESTING
L -^XTMP(NAMSPC)
Q
;
SETUPX(EXPDAYS,NAMSPC) ;
; requires EXPDAYS - # of days to keep XTMP
N BEGTIME,PURGDT
S BEGTIME=$$NOW^XLFDT()
S PURGDT=$$FMADD^XLFDT(BEGTIME,EXPDAYS)
S ^XTMP(NAMSPC,0)=PURGDT_U_BEGTIME
S $P(^XTMP(NAMSPC,0),U,3)="Transmit unsent OEF/OIF data to HEC"
Q
;
LOOP(NAMSPC,TESTING) ;
;returns stop flag
N X,XREC,LASTREC,TOTREC,TOTPAT
S LASTREC="0;0;;0;0",ZTSTOP=0
S TOTREC=0
I $D(^XTMP(NAMSPC,0,0)) D
. S XREC=$G(^XTMP(NAMSPC,0,0))
. ;last TODT processed
. S LASTREC=$P(XREC,U,1)
. ;total records read
. S TOTREC=+$P(XREC,U,2)
. S TOTPAT=+$P(XREC,U,10)
. Q
D ALOEIF(NAMSPC,TESTING,.ZTSTOP)
Q ZTSTOP
;
ALOEIF(NAMSPC,TESTING,ZTSTOP) ;
N CONF,DFN,END,FIRST,FRDT,IEN,TODT,X
S ZTSTOP=0
S TODT=$P(LASTREC,";"),END=9999999
I $G(TESTING)="Y" D
. S X=$G(^XTMP(NAMSPC,"TEST RANGE"))
. I $L(X) S TODT=$P(X,U,1)-1,END=$P(X,U,2)
S FIRST("FRDT")=$P(LASTREC,";",2),FIRST("CONF")=$P(LASTREC,";",3),FIRST("DFN")=$P(LASTREC,";",4),FIRST("IEN")=$P(LASTREC,";",5)
F S TODT=$O(^DPT("ALOEIF",TODT)) Q:'TODT!ZTSTOP S:TODT>END ZTSTOP=2 Q:ZTSTOP S FRDT=FIRST("FRDT"),FIRST("FRDT")=0 F S FRDT=$O(^DPT("ALOEIF",TODT,FRDT)) Q:'FRDT!ZTSTOP S CONF=FIRST("CONF"),FIRST("CONF")="" D
. F S CONF=$O(^DPT("ALOEIF",TODT,FRDT,CONF)) Q:CONF=""!ZTSTOP S DFN=FIRST("DFN"),FIRST("DFN")=0 F S DFN=$O(^DPT("ALOEIF",TODT,FRDT,CONF,DFN)) Q:'DFN!ZTSTOP S IEN=FIRST("IEN"),FIRST("IEN")=0 D
.. F S IEN=$O(^DPT("ALOEIF",TODT,FRDT,CONF,DFN,IEN)) Q:'IEN!ZTSTOP D CHKR(DFN,IEN)
Q
;
CHKR(DFN,IEN) ;
N X,CEN,CALC
; Assume TODT,FRDT,CONF,TOTREC,LASTREC,TOTPAT,NAMSPC are defined
S TOTREC=TOTREC+1
;
; Chk for correct CV End Date
I '$$CHPAT(DFN,.CEN,.CALC) D
. D TRANSMIT(DFN)
;
E D ; If CV End Date OK, must be transmitted after OEF/OIF filed
. N LD,LTR,LOEIF
. S LD=$$YEAR^IVMPLOG(DFN),LTR=$P($G(^IVM(301.5,+$O(^IVM(301.5,"APT",DFN,+LD,0)),0)),U,5)
. S LOEIF=$P($G(^DPT(DFN,.3215,IEN,0)),U,5)
. I $S('LD!'LTR:1,LOEIF>LTR:1,1:0) D
.. D SET(DFN,CEN,CALC,"OEF/OIF DATA NOT TX")
.. D TRANSMIT(DFN)
;
S LASTREC=TODT_";"_FRDT_";"_CONF_";"_DFN_";"_IEN
D UPDATEX(NAMSPC,TOTREC,LASTREC,TOTPAT)
;
I (TOTREC#100)=0 S ZTSTOP=$$STOP(NAMSPC)
Q
;
TRANSMIT(DFN) ;
S TOTPAT=TOTPAT+1
Q:TESTING="Y" ; No update
D EVENT^IVMPLOG(DFN)
Q
;
CHPAT(DFN,CEN,CALC) ; Function returns:
; 0 if no CV End date or CV End date not correct
; 1 if CV End Date correct
; Also returns CEN=CV END DATE ON FILE CALC=CALCULATED CV END DATE
;
N DGARRY,DGOK,X
S (CEN,CALC)=""
S CEN=$P($G(^DPT(DFN,.52)),U,15)
S CALC=$$CVDATE^DGCVRPT(DFN,.DGARRY)
;
I 'CEN D:CALC UPDCVED(NAMSPC,DFN,CEN,CALC) D SET(DFN,CEN,CALC,"CV END DATE MISSING") S DGOK=0
;
I CEN D
. I $G(DGARRY("OEF/OIF")) D
.. N LSSD
.. S LSSD=$G(DGARRY(2,DFN_",",.327,"I"))
.. I DGARRY("OEF/OIF")>LSSD S ^XTMP(NAMSPC,"DATA",DFN,"MSE DATA MISSING")=CEN_U_CALC
.. ; Correct CV End Date if value on file is not the calculated value
.. Q:CEN=CALC
.. D UPDCVED(NAMSPC,DFN,CEN,CALC)
. I CEN=CALC S DGOK=1 Q
. D SET(DFN,CEN,CALC,"CV END DATE INCORRECT")
. S DGOK=0
Q DGOK
;
UPDCVED(NAMSPC,DFN,CEN,CALC) ; Update CV end date
N DA,DIE,DR,X,Y
S DA=DFN,DIE="^DPT(",DR=".5295////"_CALC
D ^DIE
S ^XTMP(NAMSPC,"DATA",DFN,"CV END DATE UPDATED TO "_CALC)=CEN
Q
;
SET(DFN,CEN,CALC,REASON) ;
S ^XTMP(NAMSPC,"DATA",DFN)=CEN_U_CALC_U_REASON
Q
;
UPDATEX(NAMSPC,TOTREC,LASTREC,TOTPAT) ;
N X
S X=$G(^XTMP(NAMSPC,0,0))
S $P(X,U,1)=$G(LASTREC),$P(X,U,2)=$G(TOTREC)
S $P(X,U,10)=$G(TOTPAT)
S ^XTMP(NAMSPC,0,0)=X
Q
;
STATUS ; current run status
N X,NAMSPC
S NAMSPC=$$NAMSPC
S X=$G(^XTMP(NAMSPC,0,0))
I X="" U 0 W !!,"Task not started!!!" Q
W !!," Current status: ",$P(X,U,6)
W !," Starting time: ",$$FMTE^XLFDT($P(X,U,7))
I $P(X,U,8) D
. W !," Ending time: ",$$FMTE^XLFDT($P(X,U,8))
W !!," Total patient records read: ",$P(X,U,2)
W !," Last ALOEIF xref processed: ",$P(X,U,1)
W !," Total patient records set for re-transmit: ",$P(X,U,10)
Q
;
STOP(NAMSPC) ; returns stop flag
N X
S ZTSTOP=0
I $$S^%ZTLOAD S ZTSTOP=1
I $D(^XTMP(NAMSPC,"STOP")) S ZTSTOP=1 K ^XTMP(NAMSPC,"STOP")
I ZTSTOP D
. S X=$G(^XTMP(NAMSPC,0,0))
. S $P(X,U,6)="STOPPED",$P(X,U,7)=$$NOW^XLFDT()
. S ^XTMP(NAMSPC,0,0)=X
. Q
Q ZTSTOP
;
MAIL(NAMSPC,TESTING,DUZ) ; stats
N ETIME,STAT,STIME,TOTPAT,TOTREC,X
S X=$G(^XTMP(NAMSPC,0,0))
S TOTREC=$P(X,U,2)
S STAT=$P(X,U,6),STIME=$P(X,U,7)
S ETIME=$P(X,U,8)
S TOTPAT=$P(X,U,10)
;
D HDNG(NAMSPC,.LIN,STAT,STIME,ETIME,TESTING)
D SUMRY(.LIN,TOTREC,TOTPAT,NAMSPC)
D MAILIT("SUMMARY STATS - TRANSMIT UNSENT OEF/OIF DATA TO HEC",DUZ,NAMSPC)
K ^TMP(NAMSPC,$J,"MSG")
Q
;
HDNG(NAMSPC,LIN,STAT,STIME,ETIME,TESTING) ; hdr lines
N HTEXT,TEXT,X
K ^TMP(NAMSPC,$J,"MSG")
S LIN=0
S HTEXT="Transmit unsent OEF/OIF data to HEC "_STAT_" on "
D BLDLINE(NAMSPC,HTEXT,.LIN)
S HTEXT=$$FMTE^XLFDT(ETIME)
D BLDLINE(NAMSPC,HTEXT,.LIN)
D BLDLINE(NAMSPC,"",.LIN)
I TESTING="Y" D
. S TEXT="** TESTING - NO CHANGES MADE TO DATABASE **"
. D BLDLINE(NAMSPC,TEXT,.LIN)
D BLDLINE(NAMSPC,"",.LIN)
Q
;
SUMRY(LIN,TOTREC,TOTPAT,NAMSPC) ; summary lines
N TEXT,X
S TEXT=" Total Patient Records Read: "_$J($FN(TOTREC,","),11)
D BLDLINE(NAMSPC,TEXT,.LIN)
S TEXT=" Total Patient Records Set for Re-transmit: "_$J($FN(TOTPAT,","),11)
D BLDLINE(NAMSPC,TEXT,.LIN)
Q
;
BLDLINE(NAMSPC,TEXT,LIN) ;bld line in TMP
S LIN=LIN+1
S ^TMP(NAMSPC,$J,"MSG",LIN)=TEXT
Q
;
MAILIT(HTEXT,DUZ,NAMSPC) ; send mail msg
N XMY,XMDUZ,XMSUB,XMTEXT
S XMY(DUZ)="",XMDUZ=.5
S XMY("G.DGEN ELIGIBILITY ALERT")=""
S XMSUB=HTEXT
S XMTEXT="^TMP(NAMSPC,$J,""MSG"","
D ^XMD
Q
;
CHKSTAT(POST,NAMSPC) ;check if job is running, stopped, or complete
L +^XTMP(NAMSPC):1
I '$T Q 0
D KILIT(POST,NAMSPC)
Q 1
;
KILIT(POST,NAMSPC) ;
I 'POST K ^XTMP(NAMSPC)
Q
;
NAMSPC() ;
Q $T(+0)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53735P 8577 printed Nov 22, 2024@17:48:35 Page 2
DG53735P ;EG,TMK - Re-transmit OEF-OIF Data to HEC ; 10/24/2006
+1 ;;5.3;Registration;**735**;Aug 13,1993;Build 11
+2 ; LOGIC USED:
+3 ; - Find all veterans with OEF/OIF data using the 'ALOEIF;' cross
+4 ; reference by latest OEF/OIF TO DATE and patient
+5 ; - Check the PATIENT file (#2) record for a valid CV end date.
+6 ; - If the CV end date is not valid, or
+7 ; If the CV End Date is valid, but the last Z07 message transmission
+8 ; for the veteran was dated before the OEF/OIF data was added,
+9 ; Flag the record so it will be sent to HEC via an HL7 Z07 message
+10 ; and if the CV End date was not valid, update it to be the
+11 ; calculated value.
+12 ;
EP ; Queue the conversion
+1 NEW %
+2 SET %=$$NEWCP^XPDUTL("IEN12","POST^DG53735P")
+3 ; Leave as last update
SET %=$$NEWCP^XPDUTL("END","END^DG53735P")
+4 QUIT
+5 ;
POST NEW ZTSK
+1 DO BMES^XPDUTL("Queue-ing Transmit OEF/OIF data to HEC ...")
+2 DO QUE
+3 DO BMES^XPDUTL("This request queued as Task # "_$GET(ZTSK))
+4 DO BMES^XPDUTL("=====================================================")
+5 DO BMES^XPDUTL("")
+6 QUIT
+7 ;
END ; Post-install done
+1 DO BMES^XPDUTL("Post install complete.")
+2 QUIT
+3 ;
QUE NEW ZTRTN,ZTDESC,ZTSAVE,ZTIO,ZTDTH
+1 SET ZTRTN="RUN^DG53735P"
SET ZTDESC="Re-transmit of OEF/OIF Data"
+2 SET ZTIO=""
SET ZTDTH=$$NOW^XLFDT()
+3 DO ^%ZTLOAD
+4 QUIT
+5 ;
RUN ;entry point from taskman
+1 NEW NAMSPC
+2 SET NAMSPC=$$NAMSPC
+3 IF '$$CHKSTAT(1,NAMSPC)
Begin DoDot:1
+4 DO BMES^XPDUTL("Conversion routine already running, process aborted")
End DoDot:1
QUIT
+5 NEW TESTING
+6 SET TESTING="N"
KILL ^XTMP(NAMSPC)
DO DEQUE(NAMSPC)
+7 QUIT
+8 ;
TEST ; test entry point
+1 NEW TESTING,X,STARTDT,ENDDT,NAMSPC
+2 SET NAMSPC=$$NAMSPC
+3 SET TESTING="Y"
+4 SET X=$$CHKSTAT(0,NAMSPC)
+5 KILL ^XTMP(NAMSPC,"TEST RANGE"),^XTMP(NAMSPC,"TEST")
+6 SET STARTDT=$$TESTID("Starting ")
+7 if 'STARTDT
QUIT
+8 SET ENDDT=$$TESTID("Ending ")
+9 if 'ENDDT
QUIT
+10 IF ENDDT<STARTDT
WRITE !,?10,"Ending To Date can't be less than starting To Date"
QUIT
+11 SET ^XTMP(NAMSPC,"TEST RANGE")=STARTDT_U_ENDDT
+12 DO DEQUE(NAMSPC)
+13 QUIT
+14 ;
TESTID(MESS) ;
+1 NEW DGX,DIR,DTOUT,DUOUT,X,Y
+2 SET DIR(0)="DA"
SET DIR("A")=MESS_" To Date for OEF/OIF xref: "
+3 WRITE !!
DO ^DIR
KILL DIR
+4 SET DGX=Y
+5 IF $DATA(DUOUT)!$DATA(DTOUT)
SET DGX=""
+6 QUIT DGX
+7 ;
DEQUE(NAMSPC) ;
+1 NEW X
+2 IF '$DATA(TESTING)
NEW TESTING
SET TESTING="N"
+3 DO SETUPX(90,NAMSPC)
+4 SET X=$GET(^XTMP(NAMSPC,0,0))
+5 SET $PIECE(X,U,6)="RUNNING"
+6 SET $PIECE(X,U,7)=$$NOW^XLFDT()
+7 SET ^XTMP(NAMSPC,0,0)=X
+8 ;
+9 SET ZTSTOP=$$LOOP(NAMSPC,TESTING)
+10 SET X=$GET(^XTMP(NAMSPC,0,0))
+11 SET $PIECE(X,U,6)=$SELECT(ZTSTOP:"STOPPED",1:"COMPLETED")
+12 SET $PIECE(X,U,8)=$$NOW^XLFDT()
+13 SET ^XTMP(NAMSPC,0,0)=X
+14 ;
+15 DO MAIL(NAMSPC,TESTING,DUZ)
+16 KILL TESTING
+17 LOCK -^XTMP(NAMSPC)
+18 QUIT
+19 ;
SETUPX(EXPDAYS,NAMSPC) ;
+1 ; requires EXPDAYS - # of days to keep XTMP
+2 NEW BEGTIME,PURGDT
+3 SET BEGTIME=$$NOW^XLFDT()
+4 SET PURGDT=$$FMADD^XLFDT(BEGTIME,EXPDAYS)
+5 SET ^XTMP(NAMSPC,0)=PURGDT_U_BEGTIME
+6 SET $PIECE(^XTMP(NAMSPC,0),U,3)="Transmit unsent OEF/OIF data to HEC"
+7 QUIT
+8 ;
LOOP(NAMSPC,TESTING) ;
+1 ;returns stop flag
+2 NEW X,XREC,LASTREC,TOTREC,TOTPAT
+3 SET LASTREC="0;0;;0;0"
SET ZTSTOP=0
+4 SET TOTREC=0
+5 IF $DATA(^XTMP(NAMSPC,0,0))
Begin DoDot:1
+6 SET XREC=$GET(^XTMP(NAMSPC,0,0))
+7 ;last TODT processed
+8 SET LASTREC=$PIECE(XREC,U,1)
+9 ;total records read
+10 SET TOTREC=+$PIECE(XREC,U,2)
+11 SET TOTPAT=+$PIECE(XREC,U,10)
+12 QUIT
End DoDot:1
+13 DO ALOEIF(NAMSPC,TESTING,.ZTSTOP)
+14 QUIT ZTSTOP
+15 ;
ALOEIF(NAMSPC,TESTING,ZTSTOP) ;
+1 NEW CONF,DFN,END,FIRST,FRDT,IEN,TODT,X
+2 SET ZTSTOP=0
+3 SET TODT=$PIECE(LASTREC,";")
SET END=9999999
+4 IF $GET(TESTING)="Y"
Begin DoDot:1
+5 SET X=$GET(^XTMP(NAMSPC,"TEST RANGE"))
+6 IF $LENGTH(X)
SET TODT=$PIECE(X,U,1)-1
SET END=$PIECE(X,U,2)
End DoDot:1
+7 SET FIRST("FRDT")=$PIECE(LASTREC,";",2)
SET FIRST("CONF")=$PIECE(LASTREC,";",3)
SET FIRST("DFN")=$PIECE(LASTREC,";",4)
SET FIRST("IEN")=$PIECE(LASTREC,";",5)
+8 FOR
SET TODT=$ORDER(^DPT("ALOEIF",TODT))
if 'TODT!ZTSTOP
QUIT
if TODT>END
SET ZTSTOP=2
if ZTSTOP
QUIT
SET FRDT=FIRST("FRDT")
SET FIRST("FRDT")=0
FOR
SET FRDT=$ORDER(^DPT("ALOEIF",TODT,FRDT))
if 'FRDT!ZTSTOP
QUIT
SET CONF=FIRST("CONF")
SET FIRST("CONF")=""
Begin DoDot:1
+9 FOR
SET CONF=$ORDER(^DPT("ALOEIF",TODT,FRDT,CONF))
if CONF=""!ZTSTOP
QUIT
SET DFN=FIRST("DFN")
SET FIRST("DFN")=0
FOR
SET DFN=$ORDER(^DPT("ALOEIF",TODT,FRDT,CONF,DFN))
if 'DFN!ZTSTOP
QUIT
SET IEN=FIRST("IEN")
SET FIRST("IEN")=0
Begin DoDot:2
+10 FOR
SET IEN=$ORDER(^DPT("ALOEIF",TODT,FRDT,CONF,DFN,IEN))
if 'IEN!ZTSTOP
QUIT
DO CHKR(DFN,IEN)
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
CHKR(DFN,IEN) ;
+1 NEW X,CEN,CALC
+2 ; Assume TODT,FRDT,CONF,TOTREC,LASTREC,TOTPAT,NAMSPC are defined
+3 SET TOTREC=TOTREC+1
+4 ;
+5 ; Chk for correct CV End Date
+6 IF '$$CHPAT(DFN,.CEN,.CALC)
Begin DoDot:1
+7 DO TRANSMIT(DFN)
End DoDot:1
+8 ;
+9 ; If CV End Date OK, must be transmitted after OEF/OIF filed
IF '$TEST
Begin DoDot:1
+10 NEW LD,LTR,LOEIF
+11 SET LD=$$YEAR^IVMPLOG(DFN)
SET LTR=$PIECE($GET(^IVM(301.5,+$ORDER(^IVM(301.5,"APT",DFN,+LD,0)),0)),U,5)
+12 SET LOEIF=$PIECE($GET(^DPT(DFN,.3215,IEN,0)),U,5)
+13 IF $SELECT('LD!'LTR:1,LOEIF>LTR:1,1:0)
Begin DoDot:2
+14 DO SET(DFN,CEN,CALC,"OEF/OIF DATA NOT TX")
+15 DO TRANSMIT(DFN)
End DoDot:2
End DoDot:1
+16 ;
+17 SET LASTREC=TODT_";"_FRDT_";"_CONF_";"_DFN_";"_IEN
+18 DO UPDATEX(NAMSPC,TOTREC,LASTREC,TOTPAT)
+19 ;
+20 IF (TOTREC#100)=0
SET ZTSTOP=$$STOP(NAMSPC)
+21 QUIT
+22 ;
TRANSMIT(DFN) ;
+1 SET TOTPAT=TOTPAT+1
+2 ; No update
if TESTING="Y"
QUIT
+3 DO EVENT^IVMPLOG(DFN)
+4 QUIT
+5 ;
CHPAT(DFN,CEN,CALC) ; Function returns:
+1 ; 0 if no CV End date or CV End date not correct
+2 ; 1 if CV End Date correct
+3 ; Also returns CEN=CV END DATE ON FILE CALC=CALCULATED CV END DATE
+4 ;
+5 NEW DGARRY,DGOK,X
+6 SET (CEN,CALC)=""
+7 SET CEN=$PIECE($GET(^DPT(DFN,.52)),U,15)
+8 SET CALC=$$CVDATE^DGCVRPT(DFN,.DGARRY)
+9 ;
+10 IF 'CEN
if CALC
DO UPDCVED(NAMSPC,DFN,CEN,CALC)
DO SET(DFN,CEN,CALC,"CV END DATE MISSING")
SET DGOK=0
+11 ;
+12 IF CEN
Begin DoDot:1
+13 IF $GET(DGARRY("OEF/OIF"))
Begin DoDot:2
+14 NEW LSSD
+15 SET LSSD=$GET(DGARRY(2,DFN_",",.327,"I"))
+16 IF DGARRY("OEF/OIF")>LSSD
SET ^XTMP(NAMSPC,"DATA",DFN,"MSE DATA MISSING")=CEN_U_CALC
+17 ; Correct CV End Date if value on file is not the calculated value
+18 if CEN=CALC
QUIT
+19 DO UPDCVED(NAMSPC,DFN,CEN,CALC)
End DoDot:2
+20 IF CEN=CALC
SET DGOK=1
QUIT
+21 DO SET(DFN,CEN,CALC,"CV END DATE INCORRECT")
+22 SET DGOK=0
End DoDot:1
+23 QUIT DGOK
+24 ;
UPDCVED(NAMSPC,DFN,CEN,CALC) ; Update CV end date
+1 NEW DA,DIE,DR,X,Y
+2 SET DA=DFN
SET DIE="^DPT("
SET DR=".5295////"_CALC
+3 DO ^DIE
+4 SET ^XTMP(NAMSPC,"DATA",DFN,"CV END DATE UPDATED TO "_CALC)=CEN
+5 QUIT
+6 ;
SET(DFN,CEN,CALC,REASON) ;
+1 SET ^XTMP(NAMSPC,"DATA",DFN)=CEN_U_CALC_U_REASON
+2 QUIT
+3 ;
UPDATEX(NAMSPC,TOTREC,LASTREC,TOTPAT) ;
+1 NEW X
+2 SET X=$GET(^XTMP(NAMSPC,0,0))
+3 SET $PIECE(X,U,1)=$GET(LASTREC)
SET $PIECE(X,U,2)=$GET(TOTREC)
+4 SET $PIECE(X,U,10)=$GET(TOTPAT)
+5 SET ^XTMP(NAMSPC,0,0)=X
+6 QUIT
+7 ;
STATUS ; current run status
+1 NEW X,NAMSPC
+2 SET NAMSPC=$$NAMSPC
+3 SET X=$GET(^XTMP(NAMSPC,0,0))
+4 IF X=""
USE 0
WRITE !!,"Task not started!!!"
QUIT
+5 WRITE !!," Current status: ",$PIECE(X,U,6)
+6 WRITE !," Starting time: ",$$FMTE^XLFDT($PIECE(X,U,7))
+7 IF $PIECE(X,U,8)
Begin DoDot:1
+8 WRITE !," Ending time: ",$$FMTE^XLFDT($PIECE(X,U,8))
End DoDot:1
+9 WRITE !!," Total patient records read: ",$PIECE(X,U,2)
+10 WRITE !," Last ALOEIF xref processed: ",$PIECE(X,U,1)
+11 WRITE !," Total patient records set for re-transmit: ",$PIECE(X,U,10)
+12 QUIT
+13 ;
STOP(NAMSPC) ; returns stop flag
+1 NEW X
+2 SET ZTSTOP=0
+3 IF $$S^%ZTLOAD
SET ZTSTOP=1
+4 IF $DATA(^XTMP(NAMSPC,"STOP"))
SET ZTSTOP=1
KILL ^XTMP(NAMSPC,"STOP")
+5 IF ZTSTOP
Begin DoDot:1
+6 SET X=$GET(^XTMP(NAMSPC,0,0))
+7 SET $PIECE(X,U,6)="STOPPED"
SET $PIECE(X,U,7)=$$NOW^XLFDT()
+8 SET ^XTMP(NAMSPC,0,0)=X
+9 QUIT
End DoDot:1
+10 QUIT ZTSTOP
+11 ;
MAIL(NAMSPC,TESTING,DUZ) ; stats
+1 NEW ETIME,STAT,STIME,TOTPAT,TOTREC,X
+2 SET X=$GET(^XTMP(NAMSPC,0,0))
+3 SET TOTREC=$PIECE(X,U,2)
+4 SET STAT=$PIECE(X,U,6)
SET STIME=$PIECE(X,U,7)
+5 SET ETIME=$PIECE(X,U,8)
+6 SET TOTPAT=$PIECE(X,U,10)
+7 ;
+8 DO HDNG(NAMSPC,.LIN,STAT,STIME,ETIME,TESTING)
+9 DO SUMRY(.LIN,TOTREC,TOTPAT,NAMSPC)
+10 DO MAILIT("SUMMARY STATS - TRANSMIT UNSENT OEF/OIF DATA TO HEC",DUZ,NAMSPC)
+11 KILL ^TMP(NAMSPC,$JOB,"MSG")
+12 QUIT
+13 ;
HDNG(NAMSPC,LIN,STAT,STIME,ETIME,TESTING) ; hdr lines
+1 NEW HTEXT,TEXT,X
+2 KILL ^TMP(NAMSPC,$JOB,"MSG")
+3 SET LIN=0
+4 SET HTEXT="Transmit unsent OEF/OIF data to HEC "_STAT_" on "
+5 DO BLDLINE(NAMSPC,HTEXT,.LIN)
+6 SET HTEXT=$$FMTE^XLFDT(ETIME)
+7 DO BLDLINE(NAMSPC,HTEXT,.LIN)
+8 DO BLDLINE(NAMSPC,"",.LIN)
+9 IF TESTING="Y"
Begin DoDot:1
+10 SET TEXT="** TESTING - NO CHANGES MADE TO DATABASE **"
+11 DO BLDLINE(NAMSPC,TEXT,.LIN)
End DoDot:1
+12 DO BLDLINE(NAMSPC,"",.LIN)
+13 QUIT
+14 ;
SUMRY(LIN,TOTREC,TOTPAT,NAMSPC) ; summary lines
+1 NEW TEXT,X
+2 SET TEXT=" Total Patient Records Read: "_$JUSTIFY($FNUMBER(TOTREC,","),11)
+3 DO BLDLINE(NAMSPC,TEXT,.LIN)
+4 SET TEXT=" Total Patient Records Set for Re-transmit: "_$JUSTIFY($FNUMBER(TOTPAT,","),11)
+5 DO BLDLINE(NAMSPC,TEXT,.LIN)
+6 QUIT
+7 ;
BLDLINE(NAMSPC,TEXT,LIN) ;bld line in TMP
+1 SET LIN=LIN+1
+2 SET ^TMP(NAMSPC,$JOB,"MSG",LIN)=TEXT
+3 QUIT
+4 ;
MAILIT(HTEXT,DUZ,NAMSPC) ; send mail msg
+1 NEW XMY,XMDUZ,XMSUB,XMTEXT
+2 SET XMY(DUZ)=""
SET XMDUZ=.5
+3 SET XMY("G.DGEN ELIGIBILITY ALERT")=""
+4 SET XMSUB=HTEXT
+5 SET XMTEXT="^TMP(NAMSPC,$J,""MSG"","
+6 DO ^XMD
+7 QUIT
+8 ;
CHKSTAT(POST,NAMSPC) ;check if job is running, stopped, or complete
+1 LOCK +^XTMP(NAMSPC):1
+2 IF '$TEST
QUIT 0
+3 DO KILIT(POST,NAMSPC)
+4 QUIT 1
+5 ;
KILIT(POST,NAMSPC) ;
+1 IF 'POST
KILL ^XTMP(NAMSPC)
+2 QUIT
+3 ;
NAMSPC() ;
+1 QUIT $TEXT(+0)
+2 ;
