ADEXSU3 ; IHS/HQT/MJL - DENTAL EXTRACT PART 5 ; [ 03/24/1999 9:04 AM ]
;;6.0;ADE;;APRIL 1999
FIN ;EP
W !,?15,"RECORDS PROCESSED: ",ADERC,!
I $D(ADEERR) W !,"THE ABOVE ERRORS SHOULD BE CORRECTED BEFORE THE NEXT DENTAL DATA EXTRACTION.",! K ADEERR
W !,?15,"P R O C E S S I N G C O M P L E T E D",!!
D ^%ZISC
I $D(ZTQUEUED),$D(ZTSK) D KILL^%ZTLOAD
;
EXIT ;
K ADEA,ADEADACP,ADEADAF,ADEADAQ,ADEASF,ADEASITE,ADEB,ADEBDT,ADEBS6,ADEC,ADED,ADEDF,ADEDFN,ADEDMFLG,ADEDOB,ADEEDT,ADEERR,ADEFN,ADEFNO,ADEHRN,ADEIDX,ADENAT,ADENODE,ADERC,ADERDV,ADEREPD,ADESERV,ADESEX,ADESITE,ADESUFAC,ADESVCS,ADETCOST
K ADETYPE,ADEVDTE,ADEVDTP,ADEVISDT,ADEVNODE,ADEZIP,ADEZTSK,ADELAST,ADELDAY,ADEXDT,ADEDT,ADESTAT,ADEDA,ADEREX,ADECOD,ADEND,ADERR12,ADERR13,ADEXDA,ADEXNOD,ADERERUN,ADERROR
K ADECHS Q
;
ERR ;;Called to trap unexpected errors and resume procesing
W !,"An unexpected error occurred while processing",!,"entry number ",ADEA," in the DENTAL PROCEDURE file."
I $D(^%ZOSF("ERRTN")) D
. W !,"Local variables at the time of the error will be saved in the error trap.",!,"Processing will RESUME after logging the error",!
. I '$D(ZTQUEUED) W "and displaying an error message"
. W "."
. D @^%ZOSF("ERRTN")
. W !!,"Now resuming dental data extraction process."
S X="ERR^ADEXSU3",@^%ZOSF("TRAP")
G RESTART^ADEXSU1
;
TASK ;EP
;Entry point to queue for tasked monthly processing
;Check Extraction Log
Q:'$D(IO)
I $D(DUZ)[0 G TEND
D ^XBKVAR,DT^DICRW
;Must have "@" or "[" in DUZ(0), otw quit
I DUZ(0)'["@",DUZ(0)'["[" G TEND
I '$D(^ADELOG("LAST","D")) G TASK1
;If last extraction abended, send notificaton bulletin and quit
I $P(^ADELOG("LAST","D"),"^",2)["AB" D G TEND
. S XMB="ADEX-ABEND",XMDUZ="DENTAL PACKAGE" D ^XMB
;If last extraction was today, just quit.
I $P(^ADELOG("LAST","D"),U)=DT G TEND
TASK1 ;Send bulletin that extraction started on device #
S XMB="ADEX-START",XMB(1)=IO,XMDUZ="DENTAL PACKAGE" D ^XMB
;Set ADEBDT=First day of fiscal Year
S ADEBDT=$$FY(DT)
S ADEND=DT
S ADEXDT=DT
S ADECHS=0 S:$P(^ADEPARAM(+^AUTTSITE(1,0),0),U,6)="y" ADECHS=1
;Do Extraction (ADEXSU1)
D ^ADEXSU1
S ADERC=$S($D(^ADENDATA(0))=1:$P(^ADENDATA(0),U,7),1:0)
;Save file to unix host
I ADERC S XBIO=51,XBMED="F",XBGL="ADENDATA" D ^XBGSAVE
;(NOTE: Change AUGSAVE to XBSAVE whenever that gets written)
;Send bulletin that extraction complete and data saved to FILE
S XMB="ADEX-COMPLETE",XMDUZ="DENTAL PACKAGE"
I 'ADERC S XMB(1)=0,XMB(2)="",XMB(3)="" D ^XMB G TEND
;If AUFLG=-1 Set bulletin variable to augsave error message
;contained in AUGFLG(1)
S XMB(1)=ADERC
I $D(AUFLG),AUFLG=-1 D D ^XMB G TEND
. S XMB(2)="But the AUGSAVE routine was not able to save the extracted data to a unix file."
. I $D(AUFLG(1)),AUFLG(1)]"" S XMB(2)=XMB(2)_" The error message returned from AUGSAVE was: "_AUFLG(1)
. S XMB(3)="The dental data cannot be forwarded to the Area until it can be saved to a unix file. Please contact your Area Information System Coordinator or IHS Dental Headquarters (505) 262 6319."
;
D D ^XMB G TEND
. S XMB(2)="Data saved to unix file."
. S XMB(3)="Retain a copy of the data extraction printout for your records. Coordinate with Area Headquarters to ensure that the data file is forwarded and received."
TEND K AUFLG,ADEBDT,ADEND,ADEXDT,ADERC
Q
;
FY(ADEDT) ;;Returns beginning of ADEADEDT's fiscal year in FM form
N ADEFY
;beginning Y2K fix
;S ADEFY=1001
;S ADEFY="2"_$S($E(ADEDT,4,5)<10:$E(ADEDT,2,3)-1,1:$E(ADEDT,2,3))_ADEFY
S ADEFY=$P($$FISCAL^XBDT(ADEDT),U,2) ;Y2000
;end Y2K fix block
Q ADEFY
K ADEFY ;*NE
ADEXSU3 ; IHS/HQT/MJL - DENTAL EXTRACT PART 5 ; [ 03/24/1999 9:04 AM ]
+1 ;;6.0;ADE;;APRIL 1999
FIN ;EP
+1 WRITE !,?15,"RECORDS PROCESSED: ",ADERC,!
+2 IF $DATA(ADEERR)
WRITE !,"THE ABOVE ERRORS SHOULD BE CORRECTED BEFORE THE NEXT DENTAL DATA EXTRACTION.",!
KILL ADEERR
+3 WRITE !,?15,"P R O C E S S I N G C O M P L E T E D",!!
+4 DO ^%ZISC
+5 IF $DATA(ZTQUEUED)
IF $DATA(ZTSK)
DO KILL^%ZTLOAD
+6 ;
EXIT ;
+1 KILL ADEA,ADEADACP,ADEADAF,ADEADAQ,ADEASF,ADEASITE,ADEB,ADEBDT,ADEBS6,ADEC,ADED,ADEDF,ADEDFN,ADEDMFLG,ADEDOB,ADEEDT,ADEERR,ADEFN,ADEFNO,ADEHRN,ADEIDX,ADENAT,ADENODE,ADERC,ADERDV,ADEREPD,ADESERV,ADESEX,ADESITE,ADESUFAC,ADESVCS,ADETCOST
+2 KILL ADETYPE,ADEVDTE,ADEVDTP,ADEVISDT,ADEVNODE,ADEZIP,ADEZTSK,ADELAST,ADELDAY,ADEXDT,ADEDT,ADESTAT,ADEDA,ADEREX,ADECOD,ADEND,ADERR12,ADERR13,ADEXDA,ADEXNOD,ADERERUN,ADERROR
+3 KILL ADECHS
QUIT
+4 ;
ERR ;;Called to trap unexpected errors and resume procesing
+1 WRITE !,"An unexpected error occurred while processing",!,"entry number ",ADEA," in the DENTAL PROCEDURE file."
+2 IF $DATA(^%ZOSF("ERRTN"))
Begin DoDot:1
+3 WRITE !,"Local variables at the time of the error will be saved in the error trap.",!,"Processing will RESUME after logging the error",!
+4 IF '$DATA(ZTQUEUED)
WRITE "and displaying an error message"
+5 WRITE "."
+6 DO @^%ZOSF("ERRTN")
+7 WRITE !!,"Now resuming dental data extraction process."
End DoDot:1
+8 SET X="ERR^ADEXSU3"
SET @^%ZOSF("TRAP")
+9 GOTO RESTART^ADEXSU1
+10 ;
TASK ;EP
+1 ;Entry point to queue for tasked monthly processing
+2 ;Check Extraction Log
+3 IF '$DATA(IO)
QUIT
+4 IF $DATA(DUZ)[0
GOTO TEND
+5 DO ^XBKVAR
DO DT^DICRW
+6 ;Must have "@" or "[" in DUZ(0), otw quit
+7 IF DUZ(0)'["@"
IF DUZ(0)'["["
GOTO TEND
+8 IF '$DATA(^ADELOG("LAST","D"))
GOTO TASK1
+9 ;If last extraction abended, send notificaton bulletin and quit
+10 IF $PIECE(^ADELOG("LAST","D"),"^",2)["AB"
Begin DoDot:1
+11 SET XMB="ADEX-ABEND"
SET XMDUZ="DENTAL PACKAGE"
DO ^XMB
End DoDot:1
GOTO TEND
+12 ;If last extraction was today, just quit.
+13 IF $PIECE(^ADELOG("LAST","D"),U)=DT
GOTO TEND
TASK1 ;Send bulletin that extraction started on device #
+1 SET XMB="ADEX-START"
SET XMB(1)=IO
SET XMDUZ="DENTAL PACKAGE"
DO ^XMB
+2 ;Set ADEBDT=First day of fiscal Year
+3 SET ADEBDT=$$FY(DT)
+4 SET ADEND=DT
+5 SET ADEXDT=DT
+6 SET ADECHS=0
IF $PIECE(^ADEPARAM(+^AUTTSITE(1,0),0),U,6)="y"
SET ADECHS=1
+7 ;Do Extraction (ADEXSU1)
+8 DO ^ADEXSU1
+9 SET ADERC=$SELECT($DATA(^ADENDATA(0))=1:$PIECE(^ADENDATA(0),U,7),1:0)
+10 ;Save file to unix host
+11 IF ADERC
SET XBIO=51
SET XBMED="F"
SET XBGL="ADENDATA"
DO ^XBGSAVE
+12 ;(NOTE: Change AUGSAVE to XBSAVE whenever that gets written)
+13 ;Send bulletin that extraction complete and data saved to FILE
+14 SET XMB="ADEX-COMPLETE"
SET XMDUZ="DENTAL PACKAGE"
+15 IF 'ADERC
SET XMB(1)=0
SET XMB(2)=""
SET XMB(3)=""
DO ^XMB
GOTO TEND
+16 ;If AUFLG=-1 Set bulletin variable to augsave error message
+17 ;contained in AUGFLG(1)
+18 SET XMB(1)=ADERC
+19 IF $DATA(AUFLG)
IF AUFLG=-1
Begin DoDot:1
+20 SET XMB(2)="But the AUGSAVE routine was not able to save the extracted data to a unix file."
+21 IF $DATA(AUFLG(1))
IF AUFLG(1)]""
SET XMB(2)=XMB(2)_" The error message returned from AUGSAVE was: "_AUFLG(1)
+22 SET XMB(3)="The dental data cannot be forwarded to the Area until it can be saved to a unix file. Please contact your Area Information System Coordinator or IHS Dental Headquarters (505) 262 6319."
End DoDot:1
DO ^XMB
GOTO TEND
+23 ;
+24 Begin DoDot:1
+25 SET XMB(2)="Data saved to unix file."
+26 SET XMB(3)="Retain a copy of the data extraction printout for your records. Coordinate with Area Headquarters to ensure that the data file is forwarded and received."
End DoDot:1
DO ^XMB
GOTO TEND
TEND KILL AUFLG,ADEBDT,ADEND,ADEXDT,ADERC
+1 QUIT
+2 ;
FY(ADEDT) ;;Returns beginning of ADEADEDT's fiscal year in FM form
+1 NEW ADEFY
+2 ;beginning Y2K fix
+3 ;S ADEFY=1001
+4 ;S ADEFY="2"_$S($E(ADEDT,4,5)<10:$E(ADEDT,2,3)-1,1:$E(ADEDT,2,3))_ADEFY
+5 ;Y2000
SET ADEFY=$PIECE($$FISCAL^XBDT(ADEDT),U,2)
+6 ;end Y2K fix block
+7 QUIT ADEFY
+8 ;*NE
KILL ADEFY
