AGTX0 ; IHS/ASDS/EFG - EXPORT REG DATA CONT'D ;
;;7.1;PATIENT REGISTRATION;;AUG 25,2005
SETCHDFN ;EP -
W !!?10,"NOW PROCESSING REGISTRATION TRANSACTIONS..." S DX=$X,DY=$Y+1
S %DT="",X="T" D ^%DT S (AGDT,DT)=Y
S:'$G(AGTXSITE) AGTXSITE=$P(^AUTTSITE(1,0),"^")
D AGR1^AGTXST ;find last completed transmission, returned in AGLIEN
S AGR1=$S($G(AGLIEN):$P(^AGTXST(AGTXSITE,1,AGLIEN,0),U,3),1:0)
I AGR1,$D(AG("REGEN")) S AGR1=($P(AG("REGEN"),U,2)-.1),AGDT=$P(AG("REGEN"),U,3)+.000001
S1 K AGFDATE,AGTEMP S ^AGTXER(0)="",^AGCHDFN(0)=""
;WHY ARE THE ABOVE SET THEN KILLED IN THE VERY NEXT LINE?? IHS/ITSC/TPF 5/31/05 ADDED DURING ALPHA TESTING
;F AGTMP="^AGTXER","^AGCHDFN","^AGTXDATA" K @AGTMP
S AGTMP="^AGTXDATA" K @AGTMP
;END CHANGE
S AGTXBDT=AGR1
S AGTXRGSV=$P(^AUTTAREA($P(^AUTTLOC($P(^AUTTSITE(1,0),U),0),U,4),0),U,3)
X XY W "Scanning Past Errors",! H 2
D ^AGTXPER ;>SCAN PAST ERRORS
X XY W "Completed Past Errors",! H 2 X XY W " ",!
S AGR1C=0
S1A S AGR1=$O(^AGPATCH(AGR1)),AGR1C=AGR1C+1 I ('AGR1!(AGR1'<AGDT)) K AGTXBDT Q ;----
I '(AGR1C#200) X XY W "FM date=",AGR1,! ;do not report every node
S AG("SITE")=0,AGRR1=AGR1,AGDTS=AGR1
S1AA S AG("SITE")=$O(^AGPATCH(AGR1,AG("SITE"))) G S1A:AG("SITE")="",S1AA:$P(^AUTTAREA($P(^AUTTLOC(AG("SITE"),0),U,4),0),U,3)'=AGTXRGSV
S AGR2=0
S1B S AGR2=$O(^AGPATCH(AGR1,AG("SITE"),AGR2)) G S1AA:AGR2="",S1B:$D(^(AGR2))=10,S1B:'$D(^DPT(AGR2)),S1B:$L($P(^AGPATCH(AGR1,AG("SITE"),AGR2),U,2))>6
S DFN=AGR2
TXPER ;EP - ;>Single Pat
I '$D(^AUPNPAT(DFN,0)) K ^AGPATCH(AGR1,AG("SITE"),AGR2) G S1B
I $D(^AGCHDFN(DFN,"CK")) G CK ;skip if already passed AGDATCK
S AGSITE=DUZ(2),DUZ(2)=AG("SITE") ;flip duz(2) for use with AGDATCK
K AG("ER") S AG("DTOT")=0 I ($P(^AGPATCH(AGR1,AG("SITE"),AGR2),U,6)="") D ^AGDATCK I '$D(AG("ER")) S ^AGCHDFN(DFN,"CK")="" ;do check except for merged patients, mark if passed check
S DUZ(2)=AGSITE ;unflip duz(2)
I '+^AGPATCH(AGR1,AG("SITE"),AGR2),$P(^DPT(AGR2,0),U,19) K AG("ER") G S1B ;>SKIP EDIT ON MERGED PAT
I +^AGPATCH(AGR1,AG("SITE"),AGR2),$P(^(AGR2),U,3)="",$P(^DPT(AGR2,0),U,19) K AG("ER") G S1B ;>skip del hrn trans on a merged patient
I $G(AGTXPER),$D(AG("ER",14)) K AG("ER"),^AGPATCH("ER",AGR1,AG("SITE"),AGR2) G SA1 ;if scanning past errors and patient inactive; kill past error flag
I $D(AG("ER")),+^AGPATCH(AGR1,AG("SITE"),AGR2) K AG("ER") ;> send HRN d/c/m
;I AG("DTOT")>0!($D(AG("ER"))) S:'$D(^AGTXER(AG("SITE"),DFN)) ^AGTXER(0)=^AGTXER(0)+1 S ^AGTXER(AG("SITE"),DFN)="",^AGPATCH("ER",AGDTS,AG("SITE"),DFN)="" G SA1
;IHS/ITSC/TPF 5/31/2005 ADDED $G TO INCREMENTING OF ^AGTXER(0) - RELATES TO CHANGE MADE TO S1+2 ABOVE
I AG("DTOT")>0!($D(AG("ER"))) S:'$D(^AGTXER(AG("SITE"),DFN)) ^AGTXER(0)=$G(^AGTXER(0))+1 S ^AGTXER(AG("SITE"),DFN)="",^AGPATCH("ER",AGDTS,AG("SITE"),DFN)="" G SA1
;END CHANGE
CK S:$D(^AGPATCH("ER",AGR1,AG("SITE"),DFN)) ^(DFN)=1 ;past error was corrected and is marked for removal after tape/file is made
S1C G S1E:'$D(^AGCHDFN(AGR2,AG("SITE"),AGDTS)),SA:^AGCHDFN(AGR2,AG("SITE"),AGDTS)["^"&($P(^(AGDTS),U,3)="")
S1D I ^AGCHDFN(AGR2,AG("SITE"),AGDTS)="NEW",^AGPATCH(AGR1,AG("SITE"),AGR2)="" G SA1
S1E S ^AGCHDFN(AGR2,AG("SITE"),AGDTS)=^AGPATCH(AGR1,AG("SITE"),AGR2)
SA S AG("SUB")=$O(^AGPATCH(AGR1,AG("SITE"),AGR2,"")) F AGZ("I")=1:1 Q:((AG("SUB")="")!(AG("SUB")]"Z")) S ^AGCHDFN(AGR2,AG("SITE"),AGDTS,AG("SUB"))=^AGPATCH(AGR1,AG("SITE"),AGR2,AG("SUB")),AG("SUB")=$O(^AGPATCH(AGR1,AG("SITE"),AGR2,AG("SUB")))
I $D(^AGCHDFN(AGR2,AG("SITE"),AGDTS))=10 K ^AGCHDFN(AGR2,AG("SITE"),AGDTS)
SA1 I '$D(AGFDATE) S AGFDATE=$O(^AGPATCH(AGTXBDT))
Q:$D(AGTXPER) ;>past error
G S1B
AGTX0 ; IHS/ASDS/EFG - EXPORT REG DATA CONT'D ;
+1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
SETCHDFN ;EP -
+1 WRITE !!?10,"NOW PROCESSING REGISTRATION TRANSACTIONS..."
SET DX=$X
SET DY=$Y+1
+2 SET %DT=""
SET X="T"
DO ^%DT
SET (AGDT,DT)=Y
+3 IF '$GET(AGTXSITE)
SET AGTXSITE=$PIECE(^AUTTSITE(1,0),"^")
+4 ;find last completed transmission, returned in AGLIEN
DO AGR1^AGTXST
+5 SET AGR1=$SELECT($GET(AGLIEN):$PIECE(^AGTXST(AGTXSITE,1,AGLIEN,0),U,3),1:0)
+6 IF AGR1
IF $DATA(AG("REGEN"))
SET AGR1=($PIECE(AG("REGEN"),U,2)-.1)
SET AGDT=$PIECE(AG("REGEN"),U,3)+.000001
S1 KILL AGFDATE,AGTEMP
SET ^AGTXER(0)=""
SET ^AGCHDFN(0)=""
+1 ;WHY ARE THE ABOVE SET THEN KILLED IN THE VERY NEXT LINE?? IHS/ITSC/TPF 5/31/05 ADDED DURING ALPHA TESTING
+2 ;F AGTMP="^AGTXER","^AGCHDFN","^AGTXDATA" K @AGTMP
+3 SET AGTMP="^AGTXDATA"
KILL @AGTMP
+4 ;END CHANGE
+5 SET AGTXBDT=AGR1
+6 SET AGTXRGSV=$PIECE(^AUTTAREA($PIECE(^AUTTLOC($PIECE(^AUTTSITE(1,0),U),0),U,4),0),U,3)
+7 XECUTE XY
WRITE "Scanning Past Errors",!
HANG 2
+8 ;>SCAN PAST ERRORS
DO ^AGTXPER
+9 XECUTE XY
WRITE "Completed Past Errors",!
HANG 2
XECUTE XY
WRITE " ",!
+10 SET AGR1C=0
S1A ;----
SET AGR1=$ORDER(^AGPATCH(AGR1))
SET AGR1C=AGR1C+1
IF ('AGR1!(AGR1'<AGDT))
KILL AGTXBDT
QUIT
+1 ;do not report every node
IF '(AGR1C#200)
XECUTE XY
WRITE "FM date=",AGR1,!
+2 SET AG("SITE")=0
SET AGRR1=AGR1
SET AGDTS=AGR1
S1AA SET AG("SITE")=$ORDER(^AGPATCH(AGR1,AG("SITE")))
IF AG("SITE")=""
GOTO S1A
IF $PIECE(^AUTTAREA($PIECE(^AUTTLOC(AG("SITE"),0),U,4),0),U,3)'=AGTXRGSV
GOTO S1AA
+1 SET AGR2=0
S1B SET AGR2=$ORDER(^AGPATCH(AGR1,AG("SITE"),AGR2))
IF AGR2=""
GOTO S1AA
IF $DATA(^(AGR2))=10
GOTO S1B
IF '$DATA(^DPT(AGR2))
GOTO S1B
IF $LENGTH($PIECE(^AGPATCH(AGR1,AG("SITE"),AGR2),U,2))>6
GOTO S1B
+1 SET DFN=AGR2
TXPER ;EP - ;>Single Pat
+1 IF '$DATA(^AUPNPAT(DFN,0))
KILL ^AGPATCH(AGR1,AG("SITE"),AGR2)
GOTO S1B
+2 ;skip if already passed AGDATCK
IF $DATA(^AGCHDFN(DFN,"CK"))
GOTO CK
+3 ;flip duz(2) for use with AGDATCK
SET AGSITE=DUZ(2)
SET DUZ(2)=AG("SITE")
+4 ;do check except for merged patients, mark if passed check
KILL AG("ER")
SET AG("DTOT")=0
IF ($PIECE(^AGPATCH(AGR1,AG("SITE"),AGR2),U,6)="")
DO ^AGDATCK
IF '$DATA(AG("ER"))
SET ^AGCHDFN(DFN,"CK")=""
+5 ;unflip duz(2)
SET DUZ(2)=AGSITE
+6 ;>SKIP EDIT ON MERGED PAT
IF '+^AGPATCH(AGR1,AG("SITE"),AGR2)
IF $PIECE(^DPT(AGR2,0),U,19)
KILL AG("ER")
GOTO S1B
+7 ;>skip del hrn trans on a merged patient
IF +^AGPATCH(AGR1,AG("SITE"),AGR2)
IF $PIECE(^(AGR2),U,3)=""
IF $PIECE(^DPT(AGR2,0),U,19)
KILL AG("ER")
GOTO S1B
+8 ;if scanning past errors and patient inactive; kill past error flag
IF $GET(AGTXPER)
IF $DATA(AG("ER",14))
KILL AG("ER"),^AGPATCH("ER",AGR1,AG("SITE"),AGR2)
GOTO SA1
+9 ;> send HRN d/c/m
IF $DATA(AG("ER"))
IF +^AGPATCH(AGR1,AG("SITE"),AGR2)
KILL AG("ER")
+10 ;I AG("DTOT")>0!($D(AG("ER"))) S:'$D(^AGTXER(AG("SITE"),DFN)) ^AGTXER(0)=^AGTXER(0)+1 S ^AGTXER(AG("SITE"),DFN)="",^AGPATCH("ER",AGDTS,AG("SITE"),DFN)="" G SA1
+11 ;IHS/ITSC/TPF 5/31/2005 ADDED $G TO INCREMENTING OF ^AGTXER(0) - RELATES TO CHANGE MADE TO S1+2 ABOVE
+12 IF AG("DTOT")>0!($DATA(AG("ER")))
IF '$DATA(^AGTXER(AG("SITE"),DFN))
SET ^AGTXER(0)=$GET(^AGTXER(0))+1
SET ^AGTXER(AG("SITE"),DFN)=""
SET ^AGPATCH("ER",AGDTS,AG("SITE"),DFN)=""
GOTO SA1
+13 ;END CHANGE
CK ;past error was corrected and is marked for removal after tape/file is made
IF $DATA(^AGPATCH("ER",AGR1,AG("SITE"),DFN))
SET ^(DFN)=1
S1C IF '$DATA(^AGCHDFN(AGR2,AG("SITE"),AGDTS))
GOTO S1E
IF ^AGCHDFN(AGR2,AG("SITE"),AGDTS)["^"&($PIECE(^(AGDTS),U,3)="")
GOTO SA
S1D IF ^AGCHDFN(AGR2,AG("SITE"),AGDTS)="NEW"
IF ^AGPATCH(AGR1,AG("SITE"),AGR2)=""
GOTO SA1
S1E SET ^AGCHDFN(AGR2,AG("SITE"),AGDTS)=^AGPATCH(AGR1,AG("SITE"),AGR2)
SA SET AG("SUB")=$ORDER(^AGPATCH(AGR1,AG("SITE"),AGR2,""))
FOR AGZ("I")=1:1
IF ((AG("SUB")="")!(AG("SUB")]"Z"))
QUIT
SET ^AGCHDFN(AGR2,AG("SITE"),AGDTS,AG("SUB"))=^AGPATCH(AGR1,AG("SITE"),AGR2,AG("SUB"))
SET AG("SUB")=$ORDER(^AGPATCH(AGR1,AG("SITE"),AGR2,AG("SUB")))
+1 IF $DATA(^AGCHDFN(AGR2,AG("SITE"),AGDTS))=10
KILL ^AGCHDFN(AGR2,AG("SITE"),AGDTS)
SA1 IF '$DATA(AGFDATE)
SET AGFDATE=$ORDER(^AGPATCH(AGTXBDT))
+1 ;>past error
IF $DATA(AGTXPER)
QUIT
+2 GOTO S1B
