ADEXSU3.m

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