AGTX5 ; IHS/ASDS/EFG - EXPORT REG DATA CONT'D APR 14,1995 ;
;;7.1;PATIENT REGISTRATION;;AUG 25,2005
;
START ;
S (AGDTS,AGFHRN,AGLHRN)=0,AG("TXMERG")="",AG("TXDEL")=""
I '$D(^AGCHDFN(DFN,"CK")) S DFN=AGRCT K AG("ER") D ^AGDATCK I $D(AG("ER")) K AG("ER") S ^AGCHDFN(AGRCT,"RG1")="" ;mark to not send rg1 if datchk fails
AGDTS ;
F S AGDTS=$O(^AGCHDFN(AGRCT,AG("SITE"),AGDTS)) Q:'+AGDTS D RG3MGR ;>LOOP DATE/TIME | one patient
G BLDRG3 ;>PROC RG3
RG3MGR ;>HRN/INS D/M/C | RG5
S AGX=^AGCHDFN(AGRCT,AG("SITE"),AGDTS)
S:AGX="NEW" AG("TXNEW")=1 ;mark so as not to send any Change HRNs
D:($D(^AGCHDFN(AGRCT,AG("SITE"),AGDTS))>1) DELINS ;>DEL INS | RG5
Q:'+AGX ;>NO HRN D/M/C
I $P(AGX,"^",6) S AG("TXMERG")=AGDTS Q ;>MERG
Q:'$D(^AGFAC("AC",AG("SITE"))) ;>NOT PARENT FAC
I $P(AGX,"^",3)="" S AG("TXDEL")=AGDTS Q ;>DEL HRN/PAT
S:'AGFHRN AGFHRN=$P(AGX,"^",2)
S AG("CHRN")=AGDTS,AGLHRN=$P(AGX,"^",3)
Q
BLDRG3 ;EP - Build various RG3s
TXCHRN ;>HRN CHANGES
G:'$D(AG("CHRN")) TXMERG ;>NO HRN CHANGE
G:'$G(AG("TXNEW")) TXMERG ;new pat - send no Chng HRN
S AGDTS=AG("CHRN")
D SETRG3
S $P(AGTEMP(3),U,3,4)=AGFHRN_"^"_AGLHRN
D SETAGTX
TXMERG ;>MERGS
G:AG("TXMERG")="" TXDEL ;----- ;>NO MERG
S AGDTS=AG("TXMERG"),AGX=^AGCHDFN(AGRCT,AG("SITE"),AGDTS)
D SETRG3,SETAGTX
S ^AGCHDFN(AGRCT,"RG1")="" ;mark to not send demog for merged patient
TXDEL ;>DEL PAT
G:AG("TXDEL")="" FIN ;>NO DEL HRN
S AGDTS=AG("TXDEL"),AGX=^AGCHDFN(AGRCT,AG("SITE"),AGDTS),AGX1=$P(^AUTTLOC(+AGX,0),U,10)
S AGTEMP(3)="RG3^"_AGX1_U_$P(AGX,U,2,99) D SETAGTX S ^AGCHDFN(AGRCT,"RG1")=""
FIN ;>CLEAN UP | RET AG("TXDEL")
K AGDTS,AGRHRN,AGLHRN,AG("MERG"),AG("CHRN"),AG("TXNEW")
Q
DELINS ;INSURANCE COVERAGE DELETES ;>LOOP INS
S AG("SUB")=""
F AGZ("I")=1:1 S AG("SUB")=$O(^AGCHDFN(AGRCT,AG("SITE"),AGDTS,AG("SUB"))) Q:AG("SUB")="" D DELCOV
Q
DELCOV ;>DEL INS COV | AGTEMP(5)=RG5^..
Q:($P(^AGCHDFN(AGRCT,AG("SITE"),AGDTS,AG("SUB")),U,2)="")!($P(^(AG("SUB")),U,3)="")
S AGTXSUB=AG("SUB")
I $P(^AGCHDFN(AGRCT,AG("SITE"),AGDTS,AG("SUB")),U)="MCARE" Q:'$D(^AUTTMCS($P(^(AGTXSUB),U,3)))
I $P(^AGCHDFN(AGRCT,AG("SITE"),AGDTS,AG("SUB")),U)="MCAID" Q:'$D(^DIC(5,$P(^(AGTXSUB),U,3)))
S AGTEMP(5)="RG5",$P(AGTEMP(5),U,2)=$E($P(^AGCHDFN(AGRCT,AG("SITE"),AGDTS,AG("SUB")),U,2),1,14),AGCT=$P(^AGCHDFN(AGRCT,AG("SITE"),AGDTS,AG("SUB")),U,6),AGELGEND=$P(^(AG("SUB")),U,5)
S1 ;
S $P(AGTEMP(5),U,2)=$P(AGTEMP(5),U,2)_$S($P(^AGCHDFN(AGRCT,AG("SITE"),AGDTS,AG("SUB")),U)="MCARE":$P(^AUTTMCS($P(^(AG("SUB")),U,3),0),U),1:"")
S AGVAL=$P(^DPT(AGRCT,0),U,3) D D8CV^AGTX1
S $P(AGTEMP(5),U,4)=$S(AGCT="A":1,AGCT="B":2,AGCT="AB":3,1:4)
S $P(AGTEMP(5),U,5)=AGVAL
S $P(AGTEMP(5),U,6)=$$Y2KD2($P(^AGCHDFN(AGRCT,AG("SITE"),AGDTS,AG("SUB")),U,4))
S $P(AGTEMP(5),U,15,18)=""
S $P(AGTEMP(5),U,$S(AGCT="A":15,AGCT="B":16,AGCT="AB":17,1:18))=$$Y2KD2(AGELGEND)
RG5 ;>AGTXDATA=AGTEMP(5)
S AGROUT=AGROUT+1,AGTEMP(5)=$P(AGTEMP(5),U,1)_U_$$UID^AGTXID(AGRCT)_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 X XY W AGROUT
Q
SETRG3 ;>AGTEMP(3)=RG3^..
S AGTEMP(3)="RG3^"_$P(^AUTTLOC($P(^AGCHDFN(AGRCT,AG("SITE"),AGDTS),U),0),U,10)_U_$P(^AGCHDFN(AGRCT,AG("SITE"),AGDTS),U,2,5)_U_""
I $P(^AGCHDFN(AGRCT,AG("SITE"),AGDTS),U,6)]"" S $P(AGTEMP(3),U,7,8)=1_"^"_$P(^AUTTLOC($P(AGX,U,6),0),U,10)
Q
SETAGTX ;>AGTXDATA=AGTEMP(3)
I '$D(ZTQUEUED) W:AGOUTFLG !,AGTEMP(3) I 'AGOUTFLG,AGROUT#10=0 X XY W AGROUT
S AGROUT=AGROUT+1,AGTEMP(3)=$P(AGTEMP(3),U,1)_U_$$UID^AGTXID(AGRCT)_U_$P(AGTEMP(3),U,2,999),$P(AGTEMP(3),U,9)=$P(AGTEMP(3),U,9),^AGTXDATA(AGROUT)=AGTEMP(3),AG("TOT")=$G(AG("TOT"))+1
Q
Y2KD2(X) ;EP - date from fileman to Y2K format Y=CCYYMMDD
N Y
I X="" Q X
S Y=($E(X,1,3)+1700)_$E(X,4,7)
Q Y
AGTX5 ; IHS/ASDS/EFG - EXPORT REG DATA CONT'D APR 14,1995 ;
+1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
+2 ;
START ;
+1 SET (AGDTS,AGFHRN,AGLHRN)=0
SET AG("TXMERG")=""
SET AG("TXDEL")=""
+2 ;mark to not send rg1 if datchk fails
IF '$DATA(^AGCHDFN(DFN,"CK"))
SET DFN=AGRCT
KILL AG("ER")
DO ^AGDATCK
IF $DATA(AG("ER"))
KILL AG("ER")
SET ^AGCHDFN(AGRCT,"RG1")=""
AGDTS ;
+1 ;>LOOP DATE/TIME | one patient
FOR
SET AGDTS=$ORDER(^AGCHDFN(AGRCT,AG("SITE"),AGDTS))
IF '+AGDTS
QUIT
DO RG3MGR
+2 ;>PROC RG3
GOTO BLDRG3
RG3MGR ;>HRN/INS D/M/C | RG5
+1 SET AGX=^AGCHDFN(AGRCT,AG("SITE"),AGDTS)
+2 ;mark so as not to send any Change HRNs
IF AGX="NEW"
SET AG("TXNEW")=1
+3 ;>DEL INS | RG5
IF ($DATA(^AGCHDFN(AGRCT,AG("SITE"),AGDTS))>1)
DO DELINS
+4 ;>NO HRN D/M/C
IF '+AGX
QUIT
+5 ;>MERG
IF $PIECE(AGX,"^",6)
SET AG("TXMERG")=AGDTS
QUIT
+6 ;>NOT PARENT FAC
IF '$DATA(^AGFAC("AC",AG("SITE")))
QUIT
+7 ;>DEL HRN/PAT
IF $PIECE(AGX,"^",3)=""
SET AG("TXDEL")=AGDTS
QUIT
+8 IF 'AGFHRN
SET AGFHRN=$PIECE(AGX,"^",2)
+9 SET AG("CHRN")=AGDTS
SET AGLHRN=$PIECE(AGX,"^",3)
+10 QUIT
BLDRG3 ;EP - Build various RG3s
TXCHRN ;>HRN CHANGES
+1 ;>NO HRN CHANGE
IF '$DATA(AG("CHRN"))
GOTO TXMERG
+2 ;new pat - send no Chng HRN
IF '$GET(AG("TXNEW"))
GOTO TXMERG
+3 SET AGDTS=AG("CHRN")
+4 DO SETRG3
+5 SET $PIECE(AGTEMP(3),U,3,4)=AGFHRN_"^"_AGLHRN
+6 DO SETAGTX
TXMERG ;>MERGS
+1 ;----- ;>NO MERG
IF AG("TXMERG")=""
GOTO TXDEL
+2 SET AGDTS=AG("TXMERG")
SET AGX=^AGCHDFN(AGRCT,AG("SITE"),AGDTS)
+3 DO SETRG3
DO SETAGTX
+4 ;mark to not send demog for merged patient
SET ^AGCHDFN(AGRCT,"RG1")=""
TXDEL ;>DEL PAT
+1 ;>NO DEL HRN
IF AG("TXDEL")=""
GOTO FIN
+2 SET AGDTS=AG("TXDEL")
SET AGX=^AGCHDFN(AGRCT,AG("SITE"),AGDTS)
SET AGX1=$PIECE(^AUTTLOC(+AGX,0),U,10)
+3 SET AGTEMP(3)="RG3^"_AGX1_U_$PIECE(AGX,U,2,99)
DO SETAGTX
SET ^AGCHDFN(AGRCT,"RG1")=""
FIN ;>CLEAN UP | RET AG("TXDEL")
+1 KILL AGDTS,AGRHRN,AGLHRN,AG("MERG"),AG("CHRN"),AG("TXNEW")
+2 QUIT
DELINS ;INSURANCE COVERAGE DELETES ;>LOOP INS
+1 SET AG("SUB")=""
+2 FOR AGZ("I")=1:1
SET AG("SUB")=$ORDER(^AGCHDFN(AGRCT,AG("SITE"),AGDTS,AG("SUB")))
IF AG("SUB")=""
QUIT
DO DELCOV
+3 QUIT
DELCOV ;>DEL INS COV | AGTEMP(5)=RG5^..
+1 IF ($PIECE(^AGCHDFN(AGRCT,AG("SITE"),AGDTS,AG("SUB")),U,2)="")!($PIECE(^(AG("SUB")),U,3)="")
QUIT
+2 SET AGTXSUB=AG("SUB")
+3 IF $PIECE(^AGCHDFN(AGRCT,AG("SITE"),AGDTS,AG("SUB")),U)="MCARE"
IF '$DATA(^AUTTMCS($PIECE(^(AGTXSUB),U,3)))
QUIT
+4 IF $PIECE(^AGCHDFN(AGRCT,AG("SITE"),AGDTS,AG("SUB")),U)="MCAID"
IF '$DATA(^DIC(5,$PIECE(^(AGTXSUB),U,3)))
QUIT
+5 SET AGTEMP(5)="RG5"
SET $PIECE(AGTEMP(5),U,2)=$EXTRACT($PIECE(^AGCHDFN(AGRCT,AG("SITE"),AGDTS,AG("SUB")),U,2),1,14)
SET AGCT=$PIECE(^AGCHDFN(AGRCT,AG("SITE"),AGDTS,AG("SUB")),U,6)
SET AGELGEND=$PIECE(^(AG("SUB")),U,5)
S1 ;
+1 SET $PIECE(AGTEMP(5),U,2)=$PIECE(AGTEMP(5),U,2)_$SELECT($PIECE(^AGCHDFN(AGRCT,AG("SITE"),AGDTS,AG("SUB")),U)="MCARE":$PIECE(^AUTTMCS($PIECE(^(AG("SUB")),U,3),0),U),1:"")
+2 SET AGVAL=$PIECE(^DPT(AGRCT,0),U,3)
DO D8CV^AGTX1
+3 SET $PIECE(AGTEMP(5),U,4)=$SELECT(AGCT="A":1,AGCT="B":2,AGCT="AB":3,1:4)
+4 SET $PIECE(AGTEMP(5),U,5)=AGVAL
+5 SET $PIECE(AGTEMP(5),U,6)=$$Y2KD2($PIECE(^AGCHDFN(AGRCT,AG("SITE"),AGDTS,AG("SUB")),U,4))
+6 SET $PIECE(AGTEMP(5),U,15,18)=""
+7 SET $PIECE(AGTEMP(5),U,$SELECT(AGCT="A":15,AGCT="B":16,AGCT="AB":17,1:18))=$$Y2KD2(AGELGEND)
RG5 ;>AGTXDATA=AGTEMP(5)
+1 SET AGROUT=AGROUT+1
SET AGTEMP(5)=$PIECE(AGTEMP(5),U,1)_U_$$UID^AGTXID(AGRCT)_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
+2 IF AGOUTFLG
WRITE !,AGTEMP(5)
+3 IF 'AGOUTFLG
IF AGROUT#10=0
XECUTE XY
WRITE AGROUT
+4 QUIT
SETRG3 ;>AGTEMP(3)=RG3^..
+1 SET AGTEMP(3)="RG3^"_$PIECE(^AUTTLOC($PIECE(^AGCHDFN(AGRCT,AG("SITE"),AGDTS),U),0),U,10)_U_$PIECE(^AGCHDFN(AGRCT,AG("SITE"),AGDTS),U,2,5)_U_""
+2 IF $PIECE(^AGCHDFN(AGRCT,AG("SITE"),AGDTS),U,6)]""
SET $PIECE(AGTEMP(3),U,7,8)=1_"^"_$PIECE(^AUTTLOC($PIECE(AGX,U,6),0),U,10)
+3 QUIT
SETAGTX ;>AGTXDATA=AGTEMP(3)
+1 IF '$DATA(ZTQUEUED)
IF AGOUTFLG
WRITE !,AGTEMP(3)
IF 'AGOUTFLG
IF AGROUT#10=0
XECUTE XY
WRITE AGROUT
+2 SET AGROUT=AGROUT+1
SET AGTEMP(3)=$PIECE(AGTEMP(3),U,1)_U_$$UID^AGTXID(AGRCT)_U_$PIECE(AGTEMP(3),U,2,999)
SET $PIECE(AGTEMP(3),U,9)=$PIECE(AGTEMP(3),U,9)
SET ^AGTXDATA(AGROUT)=AGTEMP(3)
SET AG("TOT")=$GET(AG("TOT"))+1
+3 QUIT
Y2KD2(X) ;EP - date from fileman to Y2K format Y=CCYYMMDD
+1 NEW Y
+2 IF X=""
QUIT X
+3 SET Y=($EXTRACT(X,1,3)+1700)_$EXTRACT(X,4,7)
+4 QUIT Y
