SCDXRT03 ;BP OIFO/KEITH - AMB CARE RETRANSMISSION BY SELECTED ERROR CODE ;12/26/01
;;5.3;Scheduling;**215,247,640**;AUG 13, 1993;Build 8
;
CODE ;Retransmit by selected error code
;
;SD*640 Stop retransmit by selected error code
Q
;
N DIC,X,Y,SDERR,DIR,SDBEG,SDEND,SDCT,SDT,SDTOE,SDTOEE,SDTOEE0,SDTOT
S DIC="^SD(409.76,",DIC(0)="AEMQ" W ! D ^DIC
Q:$D(DTOUT)!$D(DUOUT) Q:Y'>0 S SDERR=+Y
BEG S X=$$ECLMO() S:'X X=2991000 S X=X+1
I '$O(^SD(409.75,"AEDT",X)) D Q
.W !!,"No errors on file since the most recent database closeout date."
.Q
S DIR(0)="D^"_X_":"_DT_":EXP"
S DIR("A")="Start date"
W ! D ^DIR Q:$D(DTOUT)!$D(DUOUT) S SDBEG=Y
I '$O(^SD(409.75,"AEDT",Y)) D G BEG
.W !!,"No errors on file later than the date specified."
.Q
S DIR(0)="D^"_Y_":"_DT_":EXP"
S DIR("A")=" End date"
W ! D ^DIR Q:$D(DTOUT)!$D(DUOUT) S SDEND=Y_.999999
I $O(^SD(409.75,"AEDT",SDBEG))>SDEND D G BEG
.W !!,"No errors on file within the date range specified."
.Q
W ! D WAIT^DICD ;Pause
;Search for transmitted encounters with selected error by date range
S (SDTOT,SDCT)=0,SDT=SDBEG
F S SDT=$O(^SD(409.75,"AEDT",SDT)) Q:'SDT!(SDT>SDEND) D
.S SDTOE=0 F S SDTOE=$O(^SD(409.75,"AEDT",SDT,SDTOE)) Q:'SDTOE D
..S SDTOEE=0
..F S SDTOEE=$O(^SD(409.75,"AEDT",SDT,SDTOE,SDTOEE)) Q:'SDTOEE D
...S SDTOEE0=$G(^SD(409.75,SDTOEE,0))
...S SDCT=SDCT+1 W:SDCT#100=0 "." ;Dot out
...Q:$P(SDTOEE0,U,2)'=SDERR ;Quit if not the selected error
...S SDTOT=SDTOT+1 ;Count records flagged
...D STREEVNT^SCDXFU01(SDTOE,0) ;Record event
...D XMITFLAG^SCDXFU01(SDTOE,0) ;Mark record for transmission
...Q
..Q
.Q
I 'SDTOT D Q
.W !!,"No encounters were found in this date range with the selected error code!"
.Q
W !!,SDTOT," encounter",$S(SDTOT=1:"",1:"s")," flagged for transmission."
Q
;
ECLMO() ;Earliest month following the most recent database closeout
N SDY,SDM,SDX
S SDY=$E(DT,1,3)
S SDM=$E(DT,4,5)
S SDY=SDY-2 S:SDM<10 SDY=SDY-1
S SDX=SDY_1000 ;Days greater than this one are acceptable
Q SDX
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCDXRT03 2074 printed Nov 22, 2024@17:49:29 Page 2
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
+2 ;
CODE ;Retransmit by selected error code
+1 ;
+2 ;SD*640 Stop retransmit by selected error code
+3 QUIT
+4 ;
+5 NEW DIC,X,Y,SDERR,DIR,SDBEG,SDEND,SDCT,SDT,SDTOE,SDTOEE,SDTOEE0,SDTOT
+6 SET DIC="^SD(409.76,"
SET DIC(0)="AEMQ"
WRITE !
DO ^DIC
+7 if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
if Y'>0
QUIT
SET SDERR=+Y
BEG SET X=$$ECLMO()
if 'X
SET X=2991000
SET X=X+1
+1 IF '$ORDER(^SD(409.75,"AEDT",X))
Begin DoDot:1
+2 WRITE !!,"No errors on file since the most recent database closeout date."
+3 QUIT
End DoDot:1
QUIT
+4 SET DIR(0)="D^"_X_":"_DT_":EXP"
+5 SET DIR("A")="Start date"
+6 WRITE !
DO ^DIR
if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
SET SDBEG=Y
+7 IF '$ORDER(^SD(409.75,"AEDT",Y))
Begin DoDot:1
+8 WRITE !!,"No errors on file later than the date specified."
+9 QUIT
End DoDot:1
GOTO BEG
+10 SET DIR(0)="D^"_Y_":"_DT_":EXP"
+11 SET DIR("A")=" End date"
+12 WRITE !
DO ^DIR
if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
SET SDEND=Y_.999999
+13 IF $ORDER(^SD(409.75,"AEDT",SDBEG))>SDEND
Begin DoDot:1
+14 WRITE !!,"No errors on file within the date range specified."
+15 QUIT
End DoDot:1
GOTO BEG
+16 ;Pause
WRITE !
DO WAIT^DICD
+17 ;Search for transmitted encounters with selected error by date range
+18 SET (SDTOT,SDCT)=0
SET SDT=SDBEG
+19 FOR
SET SDT=$ORDER(^SD(409.75,"AEDT",SDT))
if 'SDT!(SDT>SDEND)
QUIT
Begin DoDot:1
+20 SET SDTOE=0
FOR
SET SDTOE=$ORDER(^SD(409.75,"AEDT",SDT,SDTOE))
if 'SDTOE
QUIT
Begin DoDot:2
+21 SET SDTOEE=0
+22 FOR
SET SDTOEE=$ORDER(^SD(409.75,"AEDT",SDT,SDTOE,SDTOEE))
if 'SDTOEE
QUIT
Begin DoDot:3
+23 SET SDTOEE0=$GET(^SD(409.75,SDTOEE,0))
+24 ;Dot out
SET SDCT=SDCT+1
if SDCT#100=0
WRITE "."
+25 ;Quit if not the selected error
if $PIECE(SDTOEE0,U,2)'=SDERR
QUIT
+26 ;Count records flagged
SET SDTOT=SDTOT+1
+27 ;Record event
DO STREEVNT^SCDXFU01(SDTOE,0)
+28 ;Mark record for transmission
DO XMITFLAG^SCDXFU01(SDTOE,0)
+29 QUIT
End DoDot:3
+30 QUIT
End DoDot:2
+31 QUIT
End DoDot:1
+32 IF 'SDTOT
Begin DoDot:1
+33 WRITE !!,"No encounters were found in this date range with the selected error code!"
+34 QUIT
End DoDot:1
QUIT
+35 WRITE !!,SDTOT," encounter",$SELECT(SDTOT=1:"",1:"s")," flagged for transmission."
+36 QUIT
+37 ;
ECLMO() ;Earliest month following the most recent database closeout
+1 NEW SDY,SDM,SDX
+2 SET SDY=$EXTRACT(DT,1,3)
+3 SET SDM=$EXTRACT(DT,4,5)
+4 SET SDY=SDY-2
if SDM<10
SET SDY=SDY-1
+5 ;Days greater than this one are acceptable
SET SDX=SDY_1000
+6 QUIT SDX
