AGTXTAPE.m

AGTXTAPE ; IHS/ASDS/EFG - REG EXPORT TAPE ;   

 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

 ;

 I '$D(^AGTXDATA(0)) W !!?24,"TRANSACTION FILE DOES NOT EXIST" W !?24,"MUST RUN TRANSACTION GENERATE." G ABEND

 S IOP=ION D ^%ZIS

 I '$D(DT) S %DT="",X="T" D ^%DT S DT=Y,X=0

 X ^%ZOSF("RM")

CART U IO(0) S X2=$E(DT,1,3)_"0101",X1=DT D ^%DTC S AGCARTNO=X+1 I AGOPT(17)="Y" W !!,"ENTER DATA CARTRIDGE NUMBER (1-6 CHAR) ",AGCARTNO," //" R Y:DTIME S:Y]"" AGCARTNO=Y W ! I AGCARTNO'?1.6UN W *7 G CART

DATE I AGOPT(17)="Y" S %DT("A")="ENTER DATE SENT TO AREA OFFICE  ",%DT="AEPX" D ^%DT G ABEND:Y<0 I Y<DT W *7,!!,"INVALID DATE." G DATE

 S:AGOPT(17)="N" Y=DT+17000000 S $P(^AGTXDATA(0),U,8)=AGCARTNO,$P(^(0),U,9)=Y

 W !!?28,"***  0th Node Info  ***",!!,"Number : ",$P(^AGTXDATA(0),U),!,"  Name : ",$P(^AGTXDATA(0),U,2),!?9,$P(^AGTXDATA(0),U,7)," records"

 S Y=$P(^AGTXDATA(0),U,4)-17000000 D DD^%DT W !?9,Y S Y=$P(^AGTXDATA(0),U,5)-17000000 D DD^%DT W " to ",Y,!

 S XBGL="AGTXDATA",XBTLE="Registration Export Global for",XBMED="F",XBFN="BGTX"_$P(^AUTTLOC($P(^AUTTSITE(1,0),U,1),0),U,10)_"."_$$JDT^XBFUNC(DT) D ^XBGSAVE I XBFLG G ABEND

 S AGTXSITE=$P(^AUTTSITE(1,0),U),AG=$P(^AGTXST(AGTXSITE,1,0),U,3),$P(^AGTXST(AGTXSITE,1,AG,0),U,10)="Y",$P(^AGTXST(AGTXSITE,1,AG,0),U,6)=AGCARTNO

 D:'$G(AGTXALL) CLEAR

 G KILL

ABEND ;

 W *7,!!?22,"ABNORMAL END OF REGISTRATION EXPORT." I $D(XBFLG(1)) W !!,XBFLG(1),!!

 W !?27,"ENTER <RETURN> TO CONTINUE" R X:DTIME

KILL ;

 K AG,XBGL,XBNAR,AGCARTNO,X1,X2

 KILL:'$G(AGTXALL) XBFLG

 Q

CLEAR ;EP - Clear past errors that were corrected

 I $D(^AGPATCH("ER")) S AGDTS=0 F  S AGDTS=$O(^AGPATCH("ER",AGDTS)) Q:'AGDTS  D

 .S AGZSITE=0 F  S AGZSITE=$O(^AGPATCH("ER",AGDTS,AGZSITE)) Q:'AGZSITE  D

 ..S AGDFN=0 F  S AGDFN=$O(^AGPATCH("ER",AGDTS,AGZSITE,AGDFN)) Q:'AGDFN  I ^AGPATCH("ER",AGDTS,AGZSITE,AGDFN)=1 K ^(AGDFN)

 K AGDTS,AGZSITE,AGDFN

 ;clear del records that have been marked as loaded

 I $D(^AGPATCH("DEL")) S AGNODE="" F  S AGNODE=$O(^AGPATCH("DEL",AGNODE)) Q:AGNODE=""  I ^(AGNODE)=1 K ^(AGNODE)

 K AGNODE Q

AGTXTAPE  ; IHS/ASDS/EFG - REG EXPORT TAPE ;   

 +1       ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

 +2       ;

 +3        IF '$DATA(^AGTXDATA(0))

               WRITE !!?24,"TRANSACTION FILE DOES NOT EXIST"

               WRITE !?24,"MUST RUN TRANSACTION GENERATE."

               GOTO ABEND

 +4        SET IOP=ION

           DO ^%ZIS

 +5        IF '$DATA(DT)

               SET %DT=""

               SET X="T"

               DO ^%DT

               SET DT=Y

               SET X=0

 +6        XECUTE ^%ZOSF("RM")

CART       USE IO(0)

           SET X2=$EXTRACT(DT,1,3)_"0101"

           SET X1=DT

           DO ^%DTC

           SET AGCARTNO=X+1

           IF AGOPT(17)="Y"

               WRITE !!,"ENTER DATA CARTRIDGE NUMBER (1-6 CHAR) ",AGCARTNO," //"

               READ Y:DTIME

               IF Y]""

                   SET AGCARTNO=Y

               WRITE !

               IF AGCARTNO'?1.6UN

                   WRITE *7

                   GOTO CART

DATE       IF AGOPT(17)="Y"

               SET %DT("A")="ENTER DATE SENT TO AREA OFFICE  "

               SET %DT="AEPX"

               DO ^%DT

               IF Y<0

                   GOTO ABEND

               IF Y<DT

                   WRITE *7,!!,"INVALID DATE."

                   GOTO DATE

 +1        IF AGOPT(17)="N"

               SET Y=DT+17000000

           SET $PIECE(^AGTXDATA(0),U,8)=AGCARTNO

           SET $PIECE(^(0),U,9)=Y

 +2        WRITE !!?28,"***  0th Node Info  ***",!!,"Number : ",$PIECE(^AGTXDATA(0),U),!,"  Name : ",$PIECE(^AGTXDATA(0),U,2),!?9,$PIECE(^AGTXDATA(0),U,7)," records"

 +3        SET Y=$PIECE(^AGTXDATA(0),U,4)-17000000

           DO DD^%DT

           WRITE !?9,Y

           SET Y=$PIECE(^AGTXDATA(0),U,5)-17000000

           DO DD^%DT

           WRITE " to ",Y,!

 +4        SET XBGL="AGTXDATA"

           SET XBTLE="Registration Export Global for"

           SET XBMED="F"

           SET XBFN="BGTX"_$PIECE(^AUTTLOC($PIECE(^AUTTSITE(1,0),U,1),0),U,10)_"."_$$JDT^XBFUNC(DT)

           DO ^XBGSAVE

           IF XBFLG

               GOTO ABEND

 +5        SET AGTXSITE=$PIECE(^AUTTSITE(1,0),U)

           SET AG=$PIECE(^AGTXST(AGTXSITE,1,0),U,3)

           SET $PIECE(^AGTXST(AGTXSITE,1,AG,0),U,10)="Y"

           SET $PIECE(^AGTXST(AGTXSITE,1,AG,0),U,6)=AGCARTNO

 +6        IF '$GET(AGTXALL)

               DO CLEAR

 +7        GOTO KILL

ABEND     ;

 +1        WRITE *7,!!?22,"ABNORMAL END OF REGISTRATION EXPORT."

           IF $DATA(XBFLG(1))

               WRITE !!,XBFLG(1),!!

 +2        WRITE !?27,"ENTER <RETURN> TO CONTINUE"

           READ X:DTIME

KILL      ;

 +1        KILL AG,XBGL,XBNAR,AGCARTNO,X1,X2

 +2        IF '$GET(AGTXALL)

               KILL XBFLG

 +3        QUIT 

CLEAR     ;EP - Clear past errors that were corrected

 +1        IF $DATA(^AGPATCH("ER"))

               SET AGDTS=0

               FOR 

                   SET AGDTS=$ORDER(^AGPATCH("ER",AGDTS))

                   IF 'AGDTS

                       QUIT 

                   Begin DoDot:1

 +2                    SET AGZSITE=0

                       FOR 

                           SET AGZSITE=$ORDER(^AGPATCH("ER",AGDTS,AGZSITE))

                           IF 'AGZSITE

                               QUIT 

                           Begin DoDot:2

 +3                            SET AGDFN=0

                               FOR 

                                   SET AGDFN=$ORDER(^AGPATCH("ER",AGDTS,AGZSITE,AGDFN))

                                   IF 'AGDFN

                                       QUIT 

                                   IF ^AGPATCH("ER",AGDTS,AGZSITE,AGDFN)=1

                                       KILL ^(AGDFN)

                           End DoDot:2

                   End DoDot:1

 +4        KILL AGDTS,AGZSITE,AGDFN

 +5       ;clear del records that have been marked as loaded

 +6        IF $DATA(^AGPATCH("DEL"))

               SET AGNODE=""

               FOR 

                   SET AGNODE=$ORDER(^AGPATCH("DEL",AGNODE))

                   IF AGNODE=""

                       QUIT 

                   IF ^(AGNODE)=1

                       KILL ^(AGNODE)

 +7        KILL AGNODE

           QUIT