AGTX3 ; IHS/ASDS/EFG - EXPORT REG DATA CONT'D ;
;;7.1;PATIENT REGISTRATION;;AUG 25,2005
;
DISP ;>Set RG2s,RG4s and RG5s
I $P(^AUPNPAT(DFN,0),U,23) S $P(AGTEMP(2),U,31)=$P($G(^AUTTSSN($P(^AUPNPAT(DFN,0),U,23),0)),U,1)
I $P(^AUPNPAT(DFN,0),U,3) S $P(AGTEMP(2),U,34)=$P(^(0),U,3)+17000000
I $G(AGTXALL) S T(2)=$P(AGTEMP(2),U,1)_U_U_$P(AGTEMP(2),U,2,999) D SET^AGTXALL(2) KILL T(2) I 1
E S AGROUT=AGROUT+1,AGTEMP(2)=$P(AGTEMP(2),U,1)_U_$$UID^AGTXID(DFN)_U_$P(AGTEMP(2),U,2,999),$P(AGTEMP(2),U,35)=$P(AGTEMP(2),U,35),^AGTXDATA(AGROUT)=AGTEMP(2),AG("TOT")=AG("TOT")+1
F I=7,11,15,19 I $P(AGTEMP(2),U,I)="Y" D T5
K AGTEMP,AGFLG
S AG("HRN")=0,AGNAME=$P(^DPT(AGRCT,0),U)
D NAMECVT^AGTX1
HRN ;>Set RG4 HRNs
S AGZSITE=AG("SITE"),AGRSITE=AG("SITE"),DFN=AGRCT
D ^AGTXRHRN
S AG("SITE")=AGRSITE
I '$G(AGRHRN) K AGRSITE D ^AGTXRHRN S AG("SITE")=AGRSITE K AGRSITE,AGRHRN
;loop through other Site:HRN set RG4s
S AGRSITE=0
F S AGRSITE=$O(^AUPNPAT(AGRCT,41,AGRSITE)) Q:AGRSITE'>0 I AG("SITE")'=AGRSITE D HRN^AGTXRHRN I $G(AGRHRN) D
. Q:'$P($G(^AUTTLOC(AGRSITE,0)),U,4) Q:'$G(AG("SITE"))
. S AGTEMP(4)="RG4"_U_$P(^AUTTLOC(AG("SITE"),0),U,10)_U_$E(AGLN,1)_U_$E(AGFN,1)_U_$P(^DPT(AGRCT,0),U,2)_U_$P(^AUPNPAT(AGRCT,41,AG("SITE"),0),U,2)
. S AGTEMP(4)=AGTEMP(4)_U_$P($G(^AGFAC(AGRSITE,0)),U,21)_U_$P(^AUTTLOC(AGRSITE,0),U,10)_U_AGRHRN
. I $G(AGTXALL) S T(4)=$P(AGTEMP(4),U,1)_U_U_$P(AGTEMP(4),U,2,999) D SET^AGTXALL(4) KILL T(4) Q
. S AGROUT=AGROUT+1,AGTEMP(4)=$P(AGTEMP(4),U,1)_U_$$UID^AGTXID(AGRCT)_U_$P(AGTEMP(4),U,2,999),$P(AGTEMP(4),U,10)=$P(AGTEMP(4),U,10),^AGTXDATA(AGROUT)=AGTEMP(4),AG("TOT")=AG("TOT")+1
ENDHRN ;
S AG("SITE")=AGZSITE
K AGTEMP,AGRSITE,AGRHRN,AGZSITE
Q:$G(AGTXALL) S AGID=$$UID^AGTXID(DFN) D RG8^AGTXALL
END ;
G S2AAA^AGTX1
T5 ;>Set Coverages
S $P(AGTEMP(5),U,2,6)=$P(AGTEMP(2),U,I+1)_U_$P(AGTEMP(2),U,I+2)_U_$S(I=7:1,I=11:2,I=15:3,1:4)_U_$P(AGTEMP(1),U,9)_U_$P(AGTEMP(2),U,I+3)
I $G(AGTXALL) S T(5)=$P(AGTEMP(5),U,1)_U_U_$P(AGTEMP(5),U,2,999) D SET^AGTXALL(5) KILL T(5) Q
S AGROUT=AGROUT+1,AGTEMP(5)=$P(AGTEMP(5),U,1)_U_$$UID^AGTXID(DFN)_U_$P(AGTEMP(5),U,2,999),$P(AGTEMP(5),U,20)=$P(^AUTTLOC(AGTXSITE,0),U,10),^AGTXDATA(AGROUT)=AGTEMP(5),AG("TOT")=AG("TOT")+1
W:AGOUTFLG !,AGTEMP(5)
I 'AGOUTFLG,AGROUT#10=0,'$G(AGTXALL) X XY W AGROUT
S AGTEMP(5)=$P(AGTEMP(5),U,1)_U_$P(AGTEMP(5),U,3,999)
Q
AGTX3 ; IHS/ASDS/EFG - EXPORT REG DATA CONT'D ;
+1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
+2 ;
DISP ;>Set RG2s,RG4s and RG5s
+1 IF $PIECE(^AUPNPAT(DFN,0),U,23)
SET $PIECE(AGTEMP(2),U,31)=$PIECE($GET(^AUTTSSN($PIECE(^AUPNPAT(DFN,0),U,23),0)),U,1)
+2 IF $PIECE(^AUPNPAT(DFN,0),U,3)
SET $PIECE(AGTEMP(2),U,34)=$PIECE(^(0),U,3)+17000000
+3 IF $GET(AGTXALL)
SET T(2)=$PIECE(AGTEMP(2),U,1)_U_U_$PIECE(AGTEMP(2),U,2,999)
DO SET^AGTXALL(2)
KILL T(2)
IF 1
+4 IF '$TEST
SET AGROUT=AGROUT+1
SET AGTEMP(2)=$PIECE(AGTEMP(2),U,1)_U_$$UID^AGTXID(DFN)_U_$PIECE(AGTEMP(2),U,2,999)
SET $PIECE(AGTEMP(2),U,35)=$PIECE(AGTEMP(2),U,35)
SET ^AGTXDATA(AGROUT)=AGTEMP(2)
SET AG("TOT")=AG("TOT")+1
+5 FOR I=7,11,15,19
IF $PIECE(AGTEMP(2),U,I)="Y"
DO T5
+6 KILL AGTEMP,AGFLG
+7 SET AG("HRN")=0
SET AGNAME=$PIECE(^DPT(AGRCT,0),U)
+8 DO NAMECVT^AGTX1
HRN ;>Set RG4 HRNs
+1 SET AGZSITE=AG("SITE")
SET AGRSITE=AG("SITE")
SET DFN=AGRCT
+2 DO ^AGTXRHRN
+3 SET AG("SITE")=AGRSITE
+4 IF '$GET(AGRHRN)
KILL AGRSITE
DO ^AGTXRHRN
SET AG("SITE")=AGRSITE
KILL AGRSITE,AGRHRN
+5 ;loop through other Site:HRN set RG4s
+6 SET AGRSITE=0
+7 FOR
SET AGRSITE=$ORDER(^AUPNPAT(AGRCT,41,AGRSITE))
IF AGRSITE'>0
QUIT
IF AG("SITE")'=AGRSITE
DO HRN^AGTXRHRN
IF $GET(AGRHRN)
Begin DoDot:1
+8 IF '$PIECE($GET(^AUTTLOC(AGRSITE,0)),U,4)
QUIT
IF '$GET(AG("SITE"))
QUIT
+9 SET AGTEMP(4)="RG4"_U_$PIECE(^AUTTLOC(AG("SITE"),0),U,10)_U_$EXTRACT(AGLN,1)_U_$EXTRACT(AGFN,1)_U_$PIECE(^DPT(AGRCT,0),U,2)_U_$PIECE(^AUPNPAT(AGRCT,41,AG("SITE"),0),U,2)
+10 SET AGTEMP(4)=AGTEMP(4)_U_$PIECE($GET(^AGFAC(AGRSITE,0)),U,21)_U_$PIECE(^AUTTLOC(AGRSITE,0),U,10)_U_AGRHRN
+11 IF $GET(AGTXALL)
SET T(4)=$PIECE(AGTEMP(4),U,1)_U_U_$PIECE(AGTEMP(4),U,2,999)
DO SET^AGTXALL(4)
KILL T(4)
QUIT
+12 SET AGROUT=AGROUT+1
SET AGTEMP(4)=$PIECE(AGTEMP(4),U,1)_U_$$UID^AGTXID(AGRCT)_U_$PIECE(AGTEMP(4),U,2,999)
SET $PIECE(AGTEMP(4),U,10)=$PIECE(AGTEMP(4),U,10)
SET ^AGTXDATA(AGROUT)=AGTEMP(4)
SET AG("TOT")=AG("TOT")+1
End DoDot:1
ENDHRN ;
+1 SET AG("SITE")=AGZSITE
+2 KILL AGTEMP,AGRSITE,AGRHRN,AGZSITE
+3 IF $GET(AGTXALL)
QUIT
SET AGID=$$UID^AGTXID(DFN)
DO RG8^AGTXALL
END ;
+1 GOTO S2AAA^AGTX1
T5 ;>Set Coverages
+1 SET $PIECE(AGTEMP(5),U,2,6)=$PIECE(AGTEMP(2),U,I+1)_U_$PIECE(AGTEMP(2),U,I+2)_U_$SELECT(I=7:1,I=11:2,I=15:3,1:4)_U_$PIECE(AGTEMP(1),U,9)_U_$PIECE(AGTEMP(2),U,I+3)
+2 IF $GET(AGTXALL)
SET T(5)=$PIECE(AGTEMP(5),U,1)_U_U_$PIECE(AGTEMP(5),U,2,999)
DO SET^AGTXALL(5)
KILL T(5)
QUIT
+3 SET AGROUT=AGROUT+1
SET AGTEMP(5)=$PIECE(AGTEMP(5),U,1)_U_$$UID^AGTXID(DFN)_U_$PIECE(AGTEMP(5),U,2,999)
SET $PIECE(AGTEMP(5),U,20)=$PIECE(^AUTTLOC(AGTXSITE,0),U,10)
SET ^AGTXDATA(AGROUT)=AGTEMP(5)
SET AG("TOT")=AG("TOT")+1
+4 IF AGOUTFLG
WRITE !,AGTEMP(5)
+5 IF 'AGOUTFLG
IF AGROUT#10=0
IF '$GET(AGTXALL)
XECUTE XY
WRITE AGROUT
+6 SET AGTEMP(5)=$PIECE(AGTEMP(5),U,1)_U_$PIECE(AGTEMP(5),U,3,999)
+7 QUIT
