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

DG53735P.m

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