- 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 Jan 18, 2025@03:40:40 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