IBDFOSG2 ;ALB/TMP - ENCOUNTERS WITH BILLING DATA CONT. - SEP 11, 1995
;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
TOT2 ; #2a,b
N IBDHD,IBBY,IBFLDS
I '$D(DT) D DT^DICRW
S (IBFLDS,IBBY)="OPT AMT BILLED & # GEN"
S IBDHD="(#2a,2b) OUTPT DOLLARS BILLED, # OF OUTPT BILLS GENERATED"
D PRT("2a,b",IBFLDS,IBBY,IBDHD)
K IOP,DQTIME
Q
;
TOT3 ; #3a,b
N IBDHD,IBBY,IBFLDS
I '$D(DT) D DT^DICRW
S (IBFLDS,IBBY)="OPT NUM BILLS GEN < 65"
S IBDHD="(#3a) # OF OUTPT BILLS FOR PATIENTS < 65 YEARS OF AGE DATE: "
D PRT("3a",IBFLDS,IBBY,IBDHD)
;
I '$D(IOP) W !,"#3b" D SELDEV Q:'$D(IOP)!('$D(DQTIME))
S (IBFLDS,IBBY)="OPT NUM BILLS GEN 65 & UP"
S IBDHD="(#3b) # OF OUTPT BILLS FOR PATIENTS AGE 65 AND OVER"
D PRT("3b",IBFLDS,IBBY,IBDHD)
K IOP,DQTIME
Q
;
TOT4 ; #4
N IBDHD,IBBY,IBFLDS
I '$D(DT) D DT^DICRW
S (IBFLDS,IBBY)="OPT # BILLS GEN < 30 DYS"
S IBDHD="(#4) # BILLS GENERATED < 30 DAYS FROM DT OF SERVICE"
D PRT(4,IBFLDS,IBBY,IBDHD)
K IOP,DQTIME
Q
;
TOT7 ; #7
N IBDHD,IBBY,IBFLDS
I '$D(DT) D DT^DICRW
S (IBFLDS,IBBY)="CPT CODE - MNTH OPT BILLS"
S IBDHD="(#7) TOTAL # CPT CODES ON OUTPATIENT BILLS FOR A MONTH"
D PRT(7,IBFLDS,IBBY,IBDHD)
K IOP,DQTIME
Q
;
TOT10 ; #10a,b
N IBDHD,IBBY,IBFLDS
I '$D(DT) D DT^DICRW
S (IBFLDS,IBBY)="LAG ENC DT TO CREAT & PRT"
S IBDHD="(#10a,10b) AVG LAG FROM ENC DATE TO CREATE AND PRINT DATES"
D PRT(10,IBFLDS,IBBY,IBDHD)
K IOP,DQTIME
Q
;
TOT11 ; #11
N DTRNG,DTRNG1
I '$D(DT) D DT^DICRW
D END
W !,"#11"
W !!,"Scanned Encounter Forms with Outpatient Bills Generated."
;I $D(^DG(43,1,"GL")) S IBDFMUL=$P(^DG(43,1,"GL"),"^",2)
;I $D(IBDFMUL),IBDFMUL D DIVISION^VAUTOMA I Y=-1 G END
;I 'IBDFMUL S IBDFDV=$O(^DG(40.8,0))
S (VAUTD,IBDFMUL)=1
;
W !!,"You will need a 132 column printer for this report!",!
D SELDEV I '$D(IOP)!('$D(DQTIME)) G END
;
D DTRNG ;,SELMONTH
S IBZ=$G(DTRNG1($E(Y,1,5)_"01"))
I IBZ,$D(DTRNG(IBZ)) S IBBDT=$P(DTRNG(IBZ),U),IBEDT=$P(DTRNG(IBZ),U,2) D PRT11
S DIR(0)="SB^A:ALL 24 MONTHS;S:SELECTED MONTH ONLY",DIR("A")="INCLUDE ALL MONTHS OR A SELECTED MONTH",DIR("B")="A" D ^DIR K DIR
G:$D(DIRUT) TOT11Q
I Y="A" D G TOT11Q
.F IBZ=1:1:24 D PRT11
D SELMONTH
S IBZ=$G(DTRNG1($E(Y,1,5)_"01")) I IBZ D PRT11
;
TOT11Q G END
;
PRT11 ;
I IBZ,$D(DTRNG(IBZ)) S IBBDT=$P(DTRNG(IBZ),U),IBEDT=$P(DTRNG(IBZ),U,2)
S DIPA("DTFR")=IBBDT
W !,"#11 MONTH: "_$$DT()
S IBDFL="CLN",VAUTC=1
S IBDFDAT=$$HTE^XLFDT($H)
S IBDFBEG=IBBDT,IBDFEND=IBEDT
S ZTDTH=$TR(DQTIME,"@",".")
S ZTRTN="DQ^IBDFOSG",ZTSAVE("IB*")="",ZTSAVE("VAU*")="",ZTSAVE("VAD*")="",ZTDESC="Scanned Encntr Forms Totals" D ^%ZTLOAD
W !,$S($D(ZTSK):"Request Queued Task="_ZTSK,1:"Request Canceled")
Q
;
END D END^IBDFOSG
K DQTIME,IOP
Q
;
PRT(IBTOT,IBFLDS,IBBY,IBDHD,DIOBEG,DIOEND) ; Prt rpt
N IBZ,DTRNG,DTRNG1,DIPA,Y,X
W !,"#",IBTOT
D:'$D(IOP) SELDEV G:'$D(IOP)!('$D(DQTIME)) PRTQ
D DTRNG
S DIR(0)="SB^A:ALL 24 MONTHS;S:SELECTED MONTH ONLY",DIR("A")="INCLUDE ALL MONTHS OR A SELECTED MONTH",DIR("B")="A" D ^DIR K DIR
G:$D(DIRUT) PRTQ
I Y="A" D G PRTQ
.F IBZ=1:1:24 D PRT1
D SELMONTH
S IBZ=$G(DTRNG1($E(Y,1,5)_"01")) I IBZ D PRT1
PRTQ Q
;
PRT1 I $G(IBTOT)=10 S DIOBEG="D BEG10^IBDFOSG2",DIOEND="D END10^IBDFOSG2"
S DIPA("DTTO")=$P(DTRNG(IBZ),U,2),DIPA("DTFR")=$P(DTRNG(IBZ),U),FLDS="[EFDP "_IBFLDS_"]",BY="[EFDP "_IBBY_"]"
S FR="3,"_DIPA("DTFR"),TO="4,"_DIPA("DTTO"),L=0,DHD=IBDHD_" MONTH: "_$$DT(),DIC="^DGCR(399,",DIS(0)="I $O(^DGCR(399,D0,""OP"",0))'="""""
W !,"TOTALS FOR #"_IBTOT_" ("_$$DT()_")"
D EN1^DIP
Q
;
BEG10 ; DIOBEG
S ^TMP($J,"EFDPTOT",1)=0,^(2)=0,^TMP($J,"EFDPTOT",3)=0,^(4)=0
Q
;
END10 ; DIOEND
W !!,"(10a) AVERAGE # DAYS LAG FROM ENCOUNTER TO BILL CREATE: ",$J($S(^TMP($J,"EFDPTOT",2):^TMP($J,"EFDPTOT",1)/^TMP($J,"EFDPTOT",2),1:0),10,2)
W !,"(10b) AVERAGE # DAYS LAG FROM ENCOUNTER TO BILL PRINT : ",$J($S(^TMP($J,"EFDPTOT",4):^TMP($J,"EFDPTOT",3)/^TMP($J,"EFDPTOT",4),1:0),10,2)
K ^TMP($J,"EFDPTOT")
Q
;
LAG ; Set up lag time accumulators-from computed fld
N X1,X2,Z,Z0,Z1
S (Z,X)=0,Z0=+$G(^DGCR(399,D0,"S")),Z1=+$P($G(^("S")),U,12)
F S Z=$O(^DGCR(399,D0,"OP",Z)) S:'Z X=0 Q:'Z D ;loop thru opt visits
.S X1=Z0,X2=+$G(^DGCR(399,D0,"OP",Z,0)) I X2,X1 D ^%DTC S ^TMP($J,"EFDPTOT",1)=$G(^TMP($J,"EFDPTOT",1))+X,^TMP($J,"EFDPTOT",2)=$G(^TMP($J,"EFDPTOT",2))+1 ;elapsed time and count - encounter to bill create
.S X1=Z1,X2=+$G(^DGCR(399,D0,"OP",Z,0)) I X2,X1 D ^%DTC S ^TMP($J,"EFDPTOT",3)=$G(^TMP($J,"EFDPTOT",3))+X,^TMP($J,"EFDPTOT",4)=$G(^TMP($J,"EFDPTOT",4))+1 ;elapsed tm,ct (encntr-bill 1st prt)
Q
;
GEN30 ; Was printed within 30 days of any visit on bill
N X1,X2,Z,Z0
S (Z,X)=0,Z0=+$P($G(^DGCR(399,D0,"S")),U,12) Q:'Z0
F S Z=$O(^DGCR(399,D0,"OP",Z)) S:'Z X=0 Q:'Z D Q:X ;loop thru opt visits
.S X1=Z0,X2=+$G(^DGCR(399,D0,"OP",Z,0)) I X2,X1 D ^%DTC S X=$S(X<30:1,1:0)
Q
;
DTRNG ;
N Z,Z0,X1,X2,X
;S Z=2931001 F Z0=1:1:23 D
S Z=2940401 F Z0=1:1:24 D
.S X2=-1,Z1=$E(Z,1,5)+1_"01" S:$E(Z1,4,5)=13 Z1=Z1+8800
.S X1=Z1 D C^%DTC S DTRNG(Z0)=Z_U_X,DTRNG1(Z)=Z0,Z=Z1
Q
;
SELDEV ; Device/queue tm (IOP,DQTIME returned)
K IOP,DQTIME
S %ZIS("A")="Select device the output will be queued to: ",%ZIS="NQ",%ZIS("B")=""
D ^%ZIS K %ZIS
I IO=IO(0) W !,$C(7),"CANNOT BE YOUR HOME DEVICE" G SELDEV
I POP D HOME^%ZIS G SELDEVQ
S IOP="Q;"_IO
S %DT("A")="Select date/time to queue these reports to run: ",%DT="AEXRF",%DT("B")="NOW",%DT(0)="NOW" D ^%DT K %DT
I Y>0 S DQTIME=$TR(Y,".","@") I $L($P(Y,"@",2))<4 S DQTIME=DQTIME_$E("0000",1,4-$L($P(DQTIME,"@",2)))
SELDEVQ Q
;
DT() ; Display date format
S Y=$E(DIPA("DTFR"),1,5)_"00"
D DD^%DT
Q Y
;
SELMONTH ;
F S %DT="AEPN",%DT(0)=-2960300,%DT("A")="SELECT MONTH: " D ^%DT K %DT Q:X="^"!($D(DTOUT))!($D(DTRNG1($E(Y,1,5)_"01"))) W !,$C(7),"Must choose a month from 4/94 thru 3/96"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFOSG2 5928 printed Dec 13, 2024@02:53:05 Page 2
IBDFOSG2 ;ALB/TMP - ENCOUNTERS WITH BILLING DATA CONT. - SEP 11, 1995
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
TOT2 ; #2a,b
+1 NEW IBDHD,IBBY,IBFLDS
+2 IF '$DATA(DT)
DO DT^DICRW
+3 SET (IBFLDS,IBBY)="OPT AMT BILLED & # GEN"
+4 SET IBDHD="(#2a,2b) OUTPT DOLLARS BILLED, # OF OUTPT BILLS GENERATED"
+5 DO PRT("2a,b",IBFLDS,IBBY,IBDHD)
+6 KILL IOP,DQTIME
+7 QUIT
+8 ;
TOT3 ; #3a,b
+1 NEW IBDHD,IBBY,IBFLDS
+2 IF '$DATA(DT)
DO DT^DICRW
+3 SET (IBFLDS,IBBY)="OPT NUM BILLS GEN < 65"
+4 SET IBDHD="(#3a) # OF OUTPT BILLS FOR PATIENTS < 65 YEARS OF AGE DATE: "
+5 DO PRT("3a",IBFLDS,IBBY,IBDHD)
+6 ;
+7 IF '$DATA(IOP)
WRITE !,"#3b"
DO SELDEV
if '$DATA(IOP)!('$DATA(DQTIME))
QUIT
+8 SET (IBFLDS,IBBY)="OPT NUM BILLS GEN 65 & UP"
+9 SET IBDHD="(#3b) # OF OUTPT BILLS FOR PATIENTS AGE 65 AND OVER"
+10 DO PRT("3b",IBFLDS,IBBY,IBDHD)
+11 KILL IOP,DQTIME
+12 QUIT
+13 ;
TOT4 ; #4
+1 NEW IBDHD,IBBY,IBFLDS
+2 IF '$DATA(DT)
DO DT^DICRW
+3 SET (IBFLDS,IBBY)="OPT # BILLS GEN < 30 DYS"
+4 SET IBDHD="(#4) # BILLS GENERATED < 30 DAYS FROM DT OF SERVICE"
+5 DO PRT(4,IBFLDS,IBBY,IBDHD)
+6 KILL IOP,DQTIME
+7 QUIT
+8 ;
TOT7 ; #7
+1 NEW IBDHD,IBBY,IBFLDS
+2 IF '$DATA(DT)
DO DT^DICRW
+3 SET (IBFLDS,IBBY)="CPT CODE - MNTH OPT BILLS"
+4 SET IBDHD="(#7) TOTAL # CPT CODES ON OUTPATIENT BILLS FOR A MONTH"
+5 DO PRT(7,IBFLDS,IBBY,IBDHD)
+6 KILL IOP,DQTIME
+7 QUIT
+8 ;
TOT10 ; #10a,b
+1 NEW IBDHD,IBBY,IBFLDS
+2 IF '$DATA(DT)
DO DT^DICRW
+3 SET (IBFLDS,IBBY)="LAG ENC DT TO CREAT & PRT"
+4 SET IBDHD="(#10a,10b) AVG LAG FROM ENC DATE TO CREATE AND PRINT DATES"
+5 DO PRT(10,IBFLDS,IBBY,IBDHD)
+6 KILL IOP,DQTIME
+7 QUIT
+8 ;
TOT11 ; #11
+1 NEW DTRNG,DTRNG1
+2 IF '$DATA(DT)
DO DT^DICRW
+3 DO END
+4 WRITE !,"#11"
+5 WRITE !!,"Scanned Encounter Forms with Outpatient Bills Generated."
+6 ;I $D(^DG(43,1,"GL")) S IBDFMUL=$P(^DG(43,1,"GL"),"^",2)
+7 ;I $D(IBDFMUL),IBDFMUL D DIVISION^VAUTOMA I Y=-1 G END
+8 ;I 'IBDFMUL S IBDFDV=$O(^DG(40.8,0))
+9 SET (VAUTD,IBDFMUL)=1
+10 ;
+11 WRITE !!,"You will need a 132 column printer for this report!",!
+12 DO SELDEV
IF '$DATA(IOP)!('$DATA(DQTIME))
GOTO END
+13 ;
+14 ;,SELMONTH
DO DTRNG
+15 SET IBZ=$GET(DTRNG1($EXTRACT(Y,1,5)_"01"))
+16 IF IBZ
IF $DATA(DTRNG(IBZ))
SET IBBDT=$PIECE(DTRNG(IBZ),U)
SET IBEDT=$PIECE(DTRNG(IBZ),U,2)
DO PRT11
+17 SET DIR(0)="SB^A:ALL 24 MONTHS;S:SELECTED MONTH ONLY"
SET DIR("A")="INCLUDE ALL MONTHS OR A SELECTED MONTH"
SET DIR("B")="A"
DO ^DIR
KILL DIR
+18 if $DATA(DIRUT)
GOTO TOT11Q
+19 IF Y="A"
Begin DoDot:1
+20 FOR IBZ=1:1:24
DO PRT11
End DoDot:1
GOTO TOT11Q
+21 DO SELMONTH
+22 SET IBZ=$GET(DTRNG1($EXTRACT(Y,1,5)_"01"))
IF IBZ
DO PRT11
+23 ;
TOT11Q GOTO END
+1 ;
PRT11 ;
+1 IF IBZ
IF $DATA(DTRNG(IBZ))
SET IBBDT=$PIECE(DTRNG(IBZ),U)
SET IBEDT=$PIECE(DTRNG(IBZ),U,2)
+2 SET DIPA("DTFR")=IBBDT
+3 WRITE !,"#11 MONTH: "_$$DT()
+4 SET IBDFL="CLN"
SET VAUTC=1
+5 SET IBDFDAT=$$HTE^XLFDT($HOROLOG)
+6 SET IBDFBEG=IBBDT
SET IBDFEND=IBEDT
+7 SET ZTDTH=$TRANSLATE(DQTIME,"@",".")
+8 SET ZTRTN="DQ^IBDFOSG"
SET ZTSAVE("IB*")=""
SET ZTSAVE("VAU*")=""
SET ZTSAVE("VAD*")=""
SET ZTDESC="Scanned Encntr Forms Totals"
DO ^%ZTLOAD
+9 WRITE !,$SELECT($DATA(ZTSK):"Request Queued Task="_ZTSK,1:"Request Canceled")
+10 QUIT
+11 ;
END DO END^IBDFOSG
+1 KILL DQTIME,IOP
+2 QUIT
+3 ;
PRT(IBTOT,IBFLDS,IBBY,IBDHD,DIOBEG,DIOEND) ; Prt rpt
+1 NEW IBZ,DTRNG,DTRNG1,DIPA,Y,X
+2 WRITE !,"#",IBTOT
+3 if '$DATA(IOP)
DO SELDEV
if '$DATA(IOP)!('$DATA(DQTIME))
GOTO PRTQ
+4 DO DTRNG
+5 SET DIR(0)="SB^A:ALL 24 MONTHS;S:SELECTED MONTH ONLY"
SET DIR("A")="INCLUDE ALL MONTHS OR A SELECTED MONTH"
SET DIR("B")="A"
DO ^DIR
KILL DIR
+6 if $DATA(DIRUT)
GOTO PRTQ
+7 IF Y="A"
Begin DoDot:1
+8 FOR IBZ=1:1:24
DO PRT1
End DoDot:1
GOTO PRTQ
+9 DO SELMONTH
+10 SET IBZ=$GET(DTRNG1($EXTRACT(Y,1,5)_"01"))
IF IBZ
DO PRT1
PRTQ QUIT
+1 ;
PRT1 IF $GET(IBTOT)=10
SET DIOBEG="D BEG10^IBDFOSG2"
SET DIOEND="D END10^IBDFOSG2"
+1 SET DIPA("DTTO")=$PIECE(DTRNG(IBZ),U,2)
SET DIPA("DTFR")=$PIECE(DTRNG(IBZ),U)
SET FLDS="[EFDP "_IBFLDS_"]"
SET BY="[EFDP "_IBBY_"]"
+2 SET FR="3,"_DIPA("DTFR")
SET TO="4,"_DIPA("DTTO")
SET L=0
SET DHD=IBDHD_" MONTH: "_$$DT()
SET DIC="^DGCR(399,"
SET DIS(0)="I $O(^DGCR(399,D0,""OP"",0))'="""""
+3 WRITE !,"TOTALS FOR #"_IBTOT_" ("_$$DT()_")"
+4 DO EN1^DIP
+5 QUIT
+6 ;
BEG10 ; DIOBEG
+1 SET ^TMP($JOB,"EFDPTOT",1)=0
SET ^(2)=0
SET ^TMP($JOB,"EFDPTOT",3)=0
SET ^(4)=0
+2 QUIT
+3 ;
END10 ; DIOEND
+1 WRITE !!,"(10a) AVERAGE # DAYS LAG FROM ENCOUNTER TO BILL CREATE: ",$JUSTIFY($SELECT(^TMP($JOB,"EFDPTOT",2):^TMP($JOB,"EFDPTOT",1)/^TMP($JOB,"EFDPTOT",2),1:0),10,2)
+2 WRITE !,"(10b) AVERAGE # DAYS LAG FROM ENCOUNTER TO BILL PRINT : ",$JUSTIFY($SELECT(^TMP($JOB,"EFDPTOT",4):^TMP($JOB,"EFDPTOT",3)/^TMP($JOB,"EFDPTOT",4),1:0),10,2)
+3 KILL ^TMP($JOB,"EFDPTOT")
+4 QUIT
+5 ;
LAG ; Set up lag time accumulators-from computed fld
+1 NEW X1,X2,Z,Z0,Z1
+2 SET (Z,X)=0
SET Z0=+$GET(^DGCR(399,D0,"S"))
SET Z1=+$PIECE($GET(^("S")),U,12)
+3 ;loop thru opt visits
FOR
SET Z=$ORDER(^DGCR(399,D0,"OP",Z))
if 'Z
SET X=0
if 'Z
QUIT
Begin DoDot:1
+4 ;elapsed time and count - encounter to bill create
SET X1=Z0
SET X2=+$GET(^DGCR(399,D0,"OP",Z,0))
IF X2
IF X1
DO ^%DTC
SET ^TMP($JOB,"EFDPTOT",1)=$GET(^TMP($JOB,"EFDPTOT",1))+X
SET ^TMP($JOB,"EFDPTOT",2)=$GET(^TMP($JOB,"EFDPTOT",2))+1
+5 ;elapsed tm,ct (encntr-bill 1st prt)
SET X1=Z1
SET X2=+$GET(^DGCR(399,D0,"OP",Z,0))
IF X2
IF X1
DO ^%DTC
SET ^TMP($JOB,"EFDPTOT",3)=$GET(^TMP($JOB,"EFDPTOT",3))+X
SET ^TMP($JOB,"EFDPTOT",4)=$GET(^TMP($JOB,"EFDPTOT",4))+1
End DoDot:1
+6 QUIT
+7 ;
GEN30 ; Was printed within 30 days of any visit on bill
+1 NEW X1,X2,Z,Z0
+2 SET (Z,X)=0
SET Z0=+$PIECE($GET(^DGCR(399,D0,"S")),U,12)
if 'Z0
QUIT
+3 ;loop thru opt visits
FOR
SET Z=$ORDER(^DGCR(399,D0,"OP",Z))
if 'Z
SET X=0
if 'Z
QUIT
Begin DoDot:1
+4 SET X1=Z0
SET X2=+$GET(^DGCR(399,D0,"OP",Z,0))
IF X2
IF X1
DO ^%DTC
SET X=$SELECT(X<30:1,1:0)
End DoDot:1
if X
QUIT
+5 QUIT
+6 ;
DTRNG ;
+1 NEW Z,Z0,X1,X2,X
+2 ;S Z=2931001 F Z0=1:1:23 D
+3 SET Z=2940401
FOR Z0=1:1:24
Begin DoDot:1
+4 SET X2=-1
SET Z1=$EXTRACT(Z,1,5)+1_"01"
if $EXTRACT(Z1,4,5)=13
SET Z1=Z1+8800
+5 SET X1=Z1
DO C^%DTC
SET DTRNG(Z0)=Z_U_X
SET DTRNG1(Z)=Z0
SET Z=Z1
End DoDot:1
+6 QUIT
+7 ;
SELDEV ; Device/queue tm (IOP,DQTIME returned)
+1 KILL IOP,DQTIME
+2 SET %ZIS("A")="Select device the output will be queued to: "
SET %ZIS="NQ"
SET %ZIS("B")=""
+3 DO ^%ZIS
KILL %ZIS
+4 IF IO=IO(0)
WRITE !,$CHAR(7),"CANNOT BE YOUR HOME DEVICE"
GOTO SELDEV
+5 IF POP
DO HOME^%ZIS
GOTO SELDEVQ
+6 SET IOP="Q;"_IO
+7 SET %DT("A")="Select date/time to queue these reports to run: "
SET %DT="AEXRF"
SET %DT("B")="NOW"
SET %DT(0)="NOW"
DO ^%DT
KILL %DT
+8 IF Y>0
SET DQTIME=$TRANSLATE(Y,".","@")
IF $LENGTH($PIECE(Y,"@",2))<4
SET DQTIME=DQTIME_$EXTRACT("0000",1,4-$LENGTH($PIECE(DQTIME,"@",2)))
SELDEVQ QUIT
+1 ;
DT() ; Display date format
+1 SET Y=$EXTRACT(DIPA("DTFR"),1,5)_"00"
+2 DO DD^%DT
+3 QUIT Y
+4 ;
SELMONTH ;
+1 FOR
SET %DT="AEPN"
SET %DT(0)=-2960300
SET %DT("A")="SELECT MONTH: "
DO ^%DT
KILL %DT
if X="^"!($DATA(DTOUT))!($DATA(DTRNG1($EXTRACT(Y,1,5)_"01")))
QUIT
WRITE !,$CHAR(7),"Must choose a month from 4/94 thru 3/96"
+2 QUIT
+3 ;
