source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCDXRT03.m@ 623

Last change on this file since 623 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.9 KB
RevLine 
[613]1SCDXRT03 ;BP OIFO/KEITH - AMB CARE RETRANSMISSION BY SELECTED ERROR CODE ; 12/26/01 2:08pm
2 ;;5.3;Scheduling;**215,247**;AUG 13, 1993
3 ;
4CODE ;Retransmit by selected error code
5 ;
6 N DIC,X,Y,SDERR,DIR,SDBEG,SDEND,SDCT,SDT,SDTOE,SDTOEE,SDTOEE0,SDTOT
7 S DIC="^SD(409.76,",DIC(0)="AEMQ" W ! D ^DIC
8 Q:$D(DTOUT)!$D(DUOUT) Q:Y'>0 S SDERR=+Y
9BEG S X=$$ECLMO() S:'X X=2991000 S X=X+1
10 I '$O(^SD(409.75,"AEDT",X)) D Q
11 .W !!,"No errors on file since the most recent database closeout date."
12 .Q
13 S DIR(0)="D^"_X_":"_DT_":EXP"
14 S DIR("A")="Start date"
15 W ! D ^DIR Q:$D(DTOUT)!$D(DUOUT) S SDBEG=Y
16 I '$O(^SD(409.75,"AEDT",Y)) D G BEG
17 .W !!,"No errors on file later than the date specified."
18 .Q
19 S DIR(0)="D^"_Y_":"_DT_":EXP"
20 S DIR("A")=" End date"
21 W ! D ^DIR Q:$D(DTOUT)!$D(DUOUT) S SDEND=Y_.999999
22 I $O(^SD(409.75,"AEDT",SDBEG))>SDEND D G BEG
23 .W !!,"No errors on file within the date range specified."
24 .Q
25 W ! D WAIT^DICD ;Pause
26 ;Search for transmitted encounters with selected error by date range
27 S (SDTOT,SDCT)=0,SDT=SDBEG
28 F S SDT=$O(^SD(409.75,"AEDT",SDT)) Q:'SDT!(SDT>SDEND) D
29 .S SDTOE=0 F S SDTOE=$O(^SD(409.75,"AEDT",SDT,SDTOE)) Q:'SDTOE D
30 ..S SDTOEE=0
31 ..F S SDTOEE=$O(^SD(409.75,"AEDT",SDT,SDTOE,SDTOEE)) Q:'SDTOEE D
32 ...S SDTOEE0=$G(^SD(409.75,SDTOEE,0))
33 ...S SDCT=SDCT+1 W:SDCT#100=0 "." ;Dot out
34 ...Q:$P(SDTOEE0,U,2)'=SDERR ;Quit if not the selected error
35 ...S SDTOT=SDTOT+1 ;Count records flagged
36 ...D STREEVNT^SCDXFU01(SDTOE,0) ;Record event
37 ...D XMITFLAG^SCDXFU01(SDTOE,0) ;Mark record for transmission
38 ...Q
39 ..Q
40 .Q
41 I 'SDTOT D Q
42 .W !!,"No encounters were found in this date range with the selected error code!"
43 .Q
44 W !!,SDTOT," encounter",$S(SDTOT=1:"",1:"s")," flagged for transmission."
45 Q
46 ;
47ECLMO() ;Earliest month following the most recent database closeout
48 N SDY,SDM,SDX
49 S SDY=$E(DT,1,3)
50 S SDM=$E(DT,4,5)
51 S SDY=SDY-2 S:SDM<10 SDY=SDY-1
52 S SDX=SDY_1000 ;Days greater than this one are acceptable
53 Q SDX
Note: See TracBrowser for help on using the repository browser.