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

SCDXRT03.m

Go to the documentation of this file.
  1. SCDXRT03 ;BP OIFO/KEITH - AMB CARE RETRANSMISSION BY SELECTED ERROR CODE ;12/26/01
  1. ;;5.3;Scheduling;**215,247,640**;AUG 13, 1993;Build 8
  1. ;
  1. CODE ;Retransmit by selected error code
  1. ;
  1. ;SD*640 Stop retransmit by selected error code
  1. Q
  1. ;
  1. N DIC,X,Y,SDERR,DIR,SDBEG,SDEND,SDCT,SDT,SDTOE,SDTOEE,SDTOEE0,SDTOT
  1. S DIC="^SD(409.76,",DIC(0)="AEMQ" W ! D ^DIC
  1. Q:$D(DTOUT)!$D(DUOUT) Q:Y'>0 S SDERR=+Y
  1. BEG S X=$$ECLMO() S:'X X=2991000 S X=X+1
  1. I '$O(^SD(409.75,"AEDT",X)) D Q
  1. .W !!,"No errors on file since the most recent database closeout date."
  1. .Q
  1. S DIR(0)="D^"_X_":"_DT_":EXP"
  1. S DIR("A")="Start date"
  1. W ! D ^DIR Q:$D(DTOUT)!$D(DUOUT) S SDBEG=Y
  1. I '$O(^SD(409.75,"AEDT",Y)) D G BEG
  1. .W !!,"No errors on file later than the date specified."
  1. .Q
  1. S DIR(0)="D^"_Y_":"_DT_":EXP"
  1. S DIR("A")=" End date"
  1. W ! D ^DIR Q:$D(DTOUT)!$D(DUOUT) S SDEND=Y_.999999
  1. I $O(^SD(409.75,"AEDT",SDBEG))>SDEND D G BEG
  1. .W !!,"No errors on file within the date range specified."
  1. .Q
  1. W ! D WAIT^DICD ;Pause
  1. ;Search for transmitted encounters with selected error by date range
  1. S (SDTOT,SDCT)=0,SDT=SDBEG
  1. F S SDT=$O(^SD(409.75,"AEDT",SDT)) Q:'SDT!(SDT>SDEND) D
  1. .S SDTOE=0 F S SDTOE=$O(^SD(409.75,"AEDT",SDT,SDTOE)) Q:'SDTOE D
  1. ..S SDTOEE=0
  1. ..F S SDTOEE=$O(^SD(409.75,"AEDT",SDT,SDTOE,SDTOEE)) Q:'SDTOEE D
  1. ...S SDTOEE0=$G(^SD(409.75,SDTOEE,0))
  1. ...S SDCT=SDCT+1 W:SDCT#100=0 "." ;Dot out
  1. ...Q:$P(SDTOEE0,U,2)'=SDERR ;Quit if not the selected error
  1. ...S SDTOT=SDTOT+1 ;Count records flagged
  1. ...D STREEVNT^SCDXFU01(SDTOE,0) ;Record event
  1. ...D XMITFLAG^SCDXFU01(SDTOE,0) ;Mark record for transmission
  1. ...Q
  1. ..Q
  1. .Q
  1. I 'SDTOT D Q
  1. .W !!,"No encounters were found in this date range with the selected error code!"
  1. .Q
  1. W !!,SDTOT," encounter",$S(SDTOT=1:"",1:"s")," flagged for transmission."
  1. Q
  1. ;
  1. ECLMO() ;Earliest month following the most recent database closeout
  1. N SDY,SDM,SDX
  1. S SDY=$E(DT,1,3)
  1. S SDM=$E(DT,4,5)
  1. S SDY=SDY-2 S:SDM<10 SDY=SDY-1
  1. S SDX=SDY_1000 ;Days greater than this one are acceptable
  1. Q SDX