- 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
