- ACHSEOBC ; IHS/ITSC/TPF/PMF - AUTOMATICALLY DELETE EOBR FILES AT FACILITY ;
- ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**18**;JUN 11, 2001
- ;
- U IO(0)
- W !,*7,?10,"NOT AN ENTRY POINT"
- Q
- ;
- FILDEL ;EP - Delete EOBR import files.
- S ACHSI=""
- FILDELA ;
- S ACHSI=$O(ACHSUFLS(ACHSI))
- G FILDELC:+ACHSI=0
- S ACHSDATE=$P(ACHSUFLS(ACHSI)," ",2)
- G FILDELA:$L(ACHSDATE)=0
- S ACHSRDAT=9999999-ACHSDATE,ACHSUFLS("C",ACHSRDAT,ACHSI)=""
- G FILDELA
- ;
- FILDELC ;
- S (ACHSR,ACHSRR,ACHSDELD,ACHSCNT,ACHSDSAV)=0
- FILDELC1 ;
- S ACHSR=$O(ACHSUFLS("C",ACHSR))
- G FILDELF:+ACHSR=0
- FILDELC2 ;
- S ACHSRR=$O(ACHSUFLS("C",ACHSR,ACHSRR))
- G FILDELC1:+ACHSRR=0
- S ACHSCNT=ACHSCNT+1
- I ACHSCNT=3 S ACHSDELD=9999999-ACHSR
- G FILDELC2
- ;
- FILDELF ;
- G FILDEND:+ACHSDELD=0
- U IO(0)
- ;ACHS*3.1*18 4.6.2010 IHS.OIT.FCJ CHANGED DEFAULT TO NO IN NXT LINE
- I '$$DIR^XBDIR("Y","Delete ALL FI EOBR FILES With Process Date BEFORE "_$$FMTE^XLFDT(ACHSDELD),"N","","","",1) G FILDEND
- S ACHSR=9999999-ACHSDELD
- FILDELK1 ;
- S ACHSR=$O(ACHSUFLS("C",ACHSR))
- G FILDEND:+ACHSR=0
- S ACHSRR="",ACHSRR=$O(ACHSUFLS("C",ACHSR,ACHSRR))
- G FILDELK1:+ACHSRR=0
- I +$P(^ACHSF(DUZ(2),2),U,21)<10,$P(ACHSUFLS(ACHSRR)," ",4)>990 G FILDELK2
- G FILDELK1:$P(ACHSUFLS(ACHSRR)," ",4)'<+$P(^ACHSF(DUZ(2),2),U,21)
- FILDELK2 ;
- G FILDELK1:$P(ACHSUFLS(ACHSRR)," ",4)=+$P(^ACHSF(DUZ(2),2),U,21)
- S ACHSZFN=$P(ACHSUFLS(ACHSRR)," ",1)
- I '$$DEL^%ZISH($$IM^ACHS,ACHSZFN) U IO(0) W !!?10,ACHSZFN," has been DELETED" K ACHSUFLS("C",ACHSR,ACHSRR),ACHSUFLS(ACHSRR)
- G FILDELK1
- ;
- FILDEND ;
- Q
- ;
- REPORT ;EP - Print EOBR processing summary report.
- S ACHSPG=0,ACHSZFPT="",ACHSERR=0
- D NOW^ACHS
- S IOP=ZTIO
- D ^%ZIS
- I POP S ACHSERR=1 D HOME^%ZIS Q
- U IO
- D HDR
- REPORT1 ;
- S ACHSZFPT=$O(ACHSZFCT(ACHSZFPT))
- G TOT:ACHSZFPT=""
- W !?10,$P(^DIC(4,ACHSZFPT,0),U,1),?55,$J($FN(ACHSZFCT(ACHSZFPT),","),10),!
- G REPORT1
- ;
- HDR ;
- S ACHSPG=ACHSPG+1
- W @IOF,ACHSTIME,!,?28,"CHS EOBR PROCESSING REPORT",?67,"PAGE ",$J(ACHSPG,3),!,?22,"for Documents Processed on: ",$$FMTE^XLFDT(ACHSEOBD),!,?40-(($L($$LOC^ACHS)+4)\2),"for ",$$LOC^ACHS,!
- HDR1 ;
- W !!?20,"Facility",?60,"# EOBR's",!?10,$$REPEAT^XLFSTR("-",60),!!
- Q
- ;
- TOT ;
- W !!?10,$$REPEAT^XLFSTR("=",60),!
- W:$D(ACHSZRC) !!?20,"Total For All Facilities = ",?55,$J($FN(ACHSZRC,","),10)
- D RTRN^ACHS
- W @IOF
- Q
- ;
- ACHSEOBC ; IHS/ITSC/TPF/PMF - AUTOMATICALLY DELETE EOBR FILES AT FACILITY ;
- +1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**18**;JUN 11, 2001
- +2 ;
- +3 USE IO(0)
- +4 WRITE !,*7,?10,"NOT AN ENTRY POINT"
- +5 QUIT
- +6 ;
- FILDEL ;EP - Delete EOBR import files.
- +1 SET ACHSI=""
- FILDELA ;
- +1 SET ACHSI=$ORDER(ACHSUFLS(ACHSI))
- +2 IF +ACHSI=0
- GOTO FILDELC
- +3 SET ACHSDATE=$PIECE(ACHSUFLS(ACHSI)," ",2)
- +4 IF $LENGTH(ACHSDATE)=0
- GOTO FILDELA
- +5 SET ACHSRDAT=9999999-ACHSDATE
- SET ACHSUFLS("C",ACHSRDAT,ACHSI)=""
- +6 GOTO FILDELA
- +7 ;
- FILDELC ;
- +1 SET (ACHSR,ACHSRR,ACHSDELD,ACHSCNT,ACHSDSAV)=0
- FILDELC1 ;
- +1 SET ACHSR=$ORDER(ACHSUFLS("C",ACHSR))
- +2 IF +ACHSR=0
- GOTO FILDELF
- FILDELC2 ;
- +1 SET ACHSRR=$ORDER(ACHSUFLS("C",ACHSR,ACHSRR))
- +2 IF +ACHSRR=0
- GOTO FILDELC1
- +3 SET ACHSCNT=ACHSCNT+1
- +4 IF ACHSCNT=3
- SET ACHSDELD=9999999-ACHSR
- +5 GOTO FILDELC2
- +6 ;
- FILDELF ;
- +1 IF +ACHSDELD=0
- GOTO FILDEND
- +2 USE IO(0)
- +3 ;ACHS*3.1*18 4.6.2010 IHS.OIT.FCJ CHANGED DEFAULT TO NO IN NXT LINE
- +4 IF '$$DIR^XBDIR("Y","Delete ALL FI EOBR FILES With Process Date BEFORE "_$$FMTE^XLFDT(ACHSDELD),"N","","","",1)
- GOTO FILDEND
- +5 SET ACHSR=9999999-ACHSDELD
- FILDELK1 ;
- +1 SET ACHSR=$ORDER(ACHSUFLS("C",ACHSR))
- +2 IF +ACHSR=0
- GOTO FILDEND
- +3 SET ACHSRR=""
- SET ACHSRR=$ORDER(ACHSUFLS("C",ACHSR,ACHSRR))
- +4 IF +ACHSRR=0
- GOTO FILDELK1
- +5 IF +$PIECE(^ACHSF(DUZ(2),2),U,21)<10
- IF $PIECE(ACHSUFLS(ACHSRR)," ",4)>990
- GOTO FILDELK2
- +6 IF $PIECE(ACHSUFLS(ACHSRR)," ",4)'<+$PIECE(^ACHSF(DUZ(2),2),U,21)
- GOTO FILDELK1
- FILDELK2 ;
- +1 IF $PIECE(ACHSUFLS(ACHSRR)," ",4)=+$PIECE(^ACHSF(DUZ(2),2),U,21)
- GOTO FILDELK1
- +2 SET ACHSZFN=$PIECE(ACHSUFLS(ACHSRR)," ",1)
- +3 IF '$$DEL^%ZISH($$IM^ACHS,ACHSZFN)
- USE IO(0)
- WRITE !!?10,ACHSZFN," has been DELETED"
- KILL ACHSUFLS("C",ACHSR,ACHSRR),ACHSUFLS(ACHSRR)
- +4 GOTO FILDELK1
- +5 ;
- FILDEND ;
- +1 QUIT
- +2 ;
- REPORT ;EP - Print EOBR processing summary report.
- +1 SET ACHSPG=0
- SET ACHSZFPT=""
- SET ACHSERR=0
- +2 DO NOW^ACHS
- +3 SET IOP=ZTIO
- +4 DO ^%ZIS
- +5 IF POP
- SET ACHSERR=1
- DO HOME^%ZIS
- QUIT
- +6 USE IO
- +7 DO HDR
- REPORT1 ;
- +1 SET ACHSZFPT=$ORDER(ACHSZFCT(ACHSZFPT))
- +2 IF ACHSZFPT=""
- GOTO TOT
- +3 WRITE !?10,$PIECE(^DIC(4,ACHSZFPT,0),U,1),?55,$JUSTIFY($FNUMBER(ACHSZFCT(ACHSZFPT),","),10),!
- +4 GOTO REPORT1
- +5 ;
- HDR ;
- +1 SET ACHSPG=ACHSPG+1
- +2 WRITE @IOF,ACHSTIME,!,?28,"CHS EOBR PROCESSING REPORT",?67,"PAGE ",$JUSTIFY(ACHSPG,3),!,?22,"for Documents Processed on: ",$$FMTE^XLFDT(ACHSEOBD),!,?40-(($LENGTH($$LOC^ACHS)+4)\2),"for ",$$LOC^ACHS,!
- HDR1 ;
- +1 WRITE !!?20,"Facility",?60,"# EOBR's",!?10,$$REPEAT^XLFSTR("-",60),!!
- +2 QUIT
- +3 ;
- TOT ;
- +1 WRITE !!?10,$$REPEAT^XLFSTR("=",60),!
- +2 IF $DATA(ACHSZRC)
- WRITE !!?20,"Total For All Facilities = ",?55,$JUSTIFY($FNUMBER(ACHSZRC,","),10)
- +3 DO RTRN^ACHS
- +4 WRITE @IOF
- +5 QUIT
- +6 ;