ACHSTXTT.m

ACHSTXTT ; IHS/ITSC/TPF/PMF - TRANSFER ACHSDATA GLOBAL TO EXPORT MEDIA ; 

 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**25**;JUN 11, 2001;Build 43

 ;

 D LINES^ACHSFU,^ACHSVAR

L1 ;

 W @IOF,!,ACHS("*"),!,"*",?23,"COPY CHS TX DATA FOR EXPORT",?78,"*",!,ACHS("*"),!

 I '$D(^ACHSDATA(0)) W !?25,"CHS EXPORT RECORDS NOT FOUND" G END

L2 ;

 W !?10,"CHS EXPORT DATA FOUND FOR : ",$P(^ACHSDATA(0),U,2)

 W !!?25,"EXPORT RUN DATE",?50,"=",?55,$$FMTE^XLFDT($P(^ACHSDATA(0),U,3))

 W !?25,"BEGINNING ADD/UPD DATE",?50,"=",?55,$$FMTE^XLFDT($P(^ACHSDATA(0),U,4))

 W !?25,"ENDING ADD/UPD DATE",?50,"=",?55,$$FMTE^XLFDT($P(^ACHSDATA(0),U,5))

 W !?25,"NUMB OF DATA RECORDS",?50,"=",?55,$P(^ACHSDATA(0),U,7)

 I '$D(^ACHSTXST("C",$P(^ACHSDATA(0),U,3),DUZ(2))) W !!,"CHS TX DATA DOES NOT MATCH LAST EXPORT DATE & FACILITY",*7 G END

 S DA=$P(^ACHSTXST(DUZ(2),1,0),U,3)

 I '$D(^ACHSTXST(DUZ(2),1,DA,0)) W !!,"CHS TX STATUS NODE FOR THIS SITE IS MISSING",*7 G END

 I $P(^ACHSTXST(DUZ(2),1,DA,0),U,10)="N" W !,*7,?27,"RECOPYING EXPORT DATA TO DATA MEDIA"

L3 ;

 S ACHSMDAT=$$DTAO^ACHSTX

 G END:$D(DUOUT)!$D(DTOUT)

 S %=$$DIR^XBDIR("Y","ARE ALL ENTRIES CORRECT (Y/N)")

 G END:$D(DTOUT)!$D(DUOUT),L1:'%

 S $P(^ACHSDATA(0),U,9)=ACHSMDAT,$P(^ACHSDATA(0),U,8)=""

L5 ;

 S XBGL="ACHSDATA",XBNAR="CONTRACT HEALTH export data"

 S XBMED="F"    ;ACHS*3.1*25

 I $P(^AUTTSITE(1,0),U,14)'="",$D(^%ZIB(9888888.93,"B",$P(^AUTTSITE(1,0),U,14))) S XBS1=$P(^AUTTSITE(1,0),U,14) ;ACHS*3.1*25

 D ^XBGSAVE

 I XBFLG G END

 S $P(^ACHSTXST(DUZ(2),1,DA,0),U,10)="Y",$P(^(0),U,7)=ACHSMDAT,$P(^ACHSTXST(DUZ(2),1,DA,0),U,6)=""

 W !!,"NORMAL END OF JOB"

END ; Show results, ask EOP, kill vars, quit.

 I $D(XBFLG),XBFLG W !!,XBFLG(1),!!

 I $$DIR^XBDIR("E","Press RETURN...")

 K %DT,ACHS,XBOK,ACHSMDAT,DA,DIR

 Q

 ;

ACHSTXTT  ; IHS/ITSC/TPF/PMF - TRANSFER ACHSDATA GLOBAL TO EXPORT MEDIA ; 

 +1       ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**25**;JUN 11, 2001;Build 43

 +2       ;

 +3        DO LINES^ACHSFU

           DO ^ACHSVAR

L1        ;

 +1        WRITE @IOF,!,ACHS("*"),!,"*",?23,"COPY CHS TX DATA FOR EXPORT",?78,"*",!,ACHS("*"),!

 +2        IF '$DATA(^ACHSDATA(0))

               WRITE !?25,"CHS EXPORT RECORDS NOT FOUND"

               GOTO END

L2        ;

 +1        WRITE !?10,"CHS EXPORT DATA FOUND FOR : ",$PIECE(^ACHSDATA(0),U,2)

 +2        WRITE !!?25,"EXPORT RUN DATE",?50,"=",?55,$$FMTE^XLFDT($PIECE(^ACHSDATA(0),U,3))

 +3        WRITE !?25,"BEGINNING ADD/UPD DATE",?50,"=",?55,$$FMTE^XLFDT($PIECE(^ACHSDATA(0),U,4))

 +4        WRITE !?25,"ENDING ADD/UPD DATE",?50,"=",?55,$$FMTE^XLFDT($PIECE(^ACHSDATA(0),U,5))

 +5        WRITE !?25,"NUMB OF DATA RECORDS",?50,"=",?55,$PIECE(^ACHSDATA(0),U,7)

 +6        IF '$DATA(^ACHSTXST("C",$PIECE(^ACHSDATA(0),U,3),DUZ(2)))

               WRITE !!,"CHS TX DATA DOES NOT MATCH LAST EXPORT DATE & FACILITY",*7

               GOTO END

 +7        SET DA=$PIECE(^ACHSTXST(DUZ(2),1,0),U,3)

 +8        IF '$DATA(^ACHSTXST(DUZ(2),1,DA,0))

               WRITE !!,"CHS TX STATUS NODE FOR THIS SITE IS MISSING",*7

               GOTO END

 +9        IF $PIECE(^ACHSTXST(DUZ(2),1,DA,0),U,10)="N"

               WRITE !,*7,?27,"RECOPYING EXPORT DATA TO DATA MEDIA"

L3        ;

 +1        SET ACHSMDAT=$$DTAO^ACHSTX

 +2        IF $DATA(DUOUT)!$DATA(DTOUT)

               GOTO END

 +3        SET %=$$DIR^XBDIR("Y","ARE ALL ENTRIES CORRECT (Y/N)")

 +4        IF $DATA(DTOUT)!$DATA(DUOUT)

               GOTO END

           IF '%

               GOTO L1

 +5        SET $PIECE(^ACHSDATA(0),U,9)=ACHSMDAT

           SET $PIECE(^ACHSDATA(0),U,8)=""

L5        ;

 +1        SET XBGL="ACHSDATA"

           SET XBNAR="CONTRACT HEALTH export data"

 +2       ;ACHS*3.1*25

           SET XBMED="F"

 +3       ;ACHS*3.1*25

           IF $PIECE(^AUTTSITE(1,0),U,14)'=""

               IF $DATA(^%ZIB(9888888.93,"B",$PIECE(^AUTTSITE(1,0),U,14)))

                   SET XBS1=$PIECE(^AUTTSITE(1,0),U,14)

 +4        DO ^XBGSAVE

 +5        IF XBFLG

               GOTO END

 +6        SET $PIECE(^ACHSTXST(DUZ(2),1,DA,0),U,10)="Y"

           SET $PIECE(^(0),U,7)=ACHSMDAT

           SET $PIECE(^ACHSTXST(DUZ(2),1,DA,0),U,6)=""

 +7        WRITE !!,"NORMAL END OF JOB"

END       ; Show results, ask EOP, kill vars, quit.

 +1        IF $DATA(XBFLG)

               IF XBFLG

                   WRITE !!,XBFLG(1),!!

 +2        IF $$DIR^XBDIR("E","Press RETURN...")

 +3        KILL %DT,ACHS,XBOK,ACHSMDAT,DA,DIR

 +4        QUIT 

 +5       ;