AGELE2X2 ; IHS/ASDS/EFG - PAGE 2 - INSURER PART 2 ;
;;7.1;PATIENT REGISTRATION;;AUG 25,2005
;
;X2=PHDFN;NAME^RDFN;RELATIONSHIP^ADDR1^ADDR2^PHONE^SEX^DOB
;X3=EMPLOYER^ADDR1^ADDR2^PHONE^STATUS;DESC^GROUP^GROUP #^EMPL #
;
I +AGV("X2")="" G XIT
I '$D(^AUPN3PPH(+AGV("X2"),0)) G XIT
I $P(^AUPN3PPH(+AGV("X2"),0),U,2)]"" S AGX("HDFN")=$P(^(0),U,2)
S $P(AGV("X3"),U,6)=$P(^AUPN3PPH(+AGV("X2"),0),U,6),$P(AGV("X3"),U,7)=$P(^(0),U,7)
S $P(AGV("X2"),U,6)=$P(^AUPN3PPH(+AGV("X2"),0),U,8)
S $P(AGV("X2"),U,7)=$P(^AUPN3PPH(+AGV("X2"),0),U,19)
REG I $P(^AUPN3PPH(+AGV("X2"),0),U,2)="" G PHINFO
I $D(^DPT(AGX("HDFN"),.11)),$P(^(.11),U)]"",$P(^(.11),U,4)]"",$P(^(.11),U,5)]"",$P(^(.11),U,6)]"" D
.S $P(AGV("X2"),U,3)=$P(^(.11),U)
.S AG("PH9")=$P(^(.11),U)
.S $P(AGV("X2"),U,4)=$P(^(.11),U,4)_", "
.S AG("PH11")=$P(^(.11),U,4)
E G REMPL
I $P(^DPT(AGX("HDFN"),.11),U,5)]"",$D(^DIC(5,$P(^(.11),U,5),0)) D
.S $P(AGV("X2"),U,4)=$P(AGV("X2"),U,4)_$P(^(0),U,2)_" "_$P(^DPT(AGX("HDFN"),.11),U,6)
.S AG("PH12")=$P(^(.11),U,5)
.S AG("PH13")=$P(^(.11),U,6)
.S:$D(^(.13)) $P(AGV("X2"),U,5)=$P(^(.13),U)
.S:$D(^(.13)) AG("PH14")=$P(^(.13),U)
REMPL I $P(^AUPNPAT(AGX("HDFN"),0),U,19)]"",$D(^AUTNEMPL($P(^(0),U,19),0)) D
.S $P(AGV("X3"),U)=$P(^(0),U)
.S AGX("E0")=^(0)
E G REMST
S $P(AGV("X3"),U,2)=$P(AGX("E0"),U,2)
S $P(AGV("X3"),U,3)=$P(AGX("E0"),U,3)_", "
I $P(AGX("E0"),U,4)]"",$D(^DIC(5,$P(AGX("E0"),U,4),0)) D
.S $P(AGV("X3"),U,3)=$P(AGV("X3"),U,3)_$P(^(0),U,2)_" "_$P(AGX("E0"),U,5)
S $P(AGV("X3"),U,4)=$P(AGX("E0"),U,6)
REMST S AGX("Y")=$P(^AUPNPAT(AGX("HDFN"),0),U,21)
I AGX("Y")="" S AGX("Y")=9
S AGX("Y0")=$P(^DD(9000001,.21,0),U,3)
S AGX("Y0")=$P($P(AGX("Y0"),AGX("Y")_":",2),";",1)
S $P(AGV("X3"),U,5)=AGX("Y")_";"_AGX("Y0")
G XIT
PHINFO ;INSURER INFO FROM POLICY HOLDER FILE
S AGX("Y")=$P(^AUPN3PPH(+AGV("X2"),0),U,15)
I AGX("Y")="" G PHADD
S AGX("Y0")=$P(^DD(9000003.1,.15,0),U,3)
S AGX("Y0")=$P($P(AGX("Y0"),AGX("Y")_":",2),";",1)
S $P(AGV("X3"),U,5)=AGX("Y")_";"_AGX("Y0")
PHADD I $P(^AUPN3PPH(+AGV("X2"),0),U,9)]"",$P(^(0),U,11)]"",$P(^(0),U,12)]"",$P(^(0),U,13)]"" D
.S $P(AGV("X2"),U,3)=$P(^(0),U,9)
.S $P(AGV("X2"),U,4)=$P(^(0),U,11)_", "
E G PEMPL
I $D(^DIC(5,$P(^AUPN3PPH(+AGV("X2"),0),U,12),0)) D
.S $P(AGV("X2"),U,4)=$P(AGV("X2"),U,4)_$P(^(0),U,2)_" "_$P(^AUPN3PPH(+AGV("X2"),0),U,13)
.S $P(AGV("X2"),U,5)=$P(^(0),U,14)
PEMPL I $P(^AUPN3PPH(+AGV("X2"),0),U,16)]"",$D(^AUTNEMPL($P(^(0),U,16),0)) D
.S $P(AGV("X3"),U)=$P(^(0),U),AGX("E0")=^(0)
E G XIT
I $P(AGX("E0"),U,2)]"",$P(AGX("E0"),U,3)]"",$P(AGX("E0"),U,4)]"",$P(AGX("E0"),U,5)]""
E G XIT
S $P(AGV("X3"),U,2)=$P(AGX("E0"),U,2)
S $P(AGV("X3"),U,3)=$P(AGX("E0"),U,3)_", "
I $D(^DIC(5,$P(AGX("E0"),U,4),0)) D
.S $P(AGV("X3"),U,3)=$P(AGV("X3"),U,3)_$P(^(0),U,2)_" "_$P(AGX("E0"),U,5)
S $P(AGV("X3"),U,4)=$P(AGX("E0"),U,6)
XIT K AGX Q
AGELE2X2 ; IHS/ASDS/EFG - PAGE 2 - INSURER PART 2 ;
+1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
+2 ;
+3 ;X2=PHDFN;NAME^RDFN;RELATIONSHIP^ADDR1^ADDR2^PHONE^SEX^DOB
+4 ;X3=EMPLOYER^ADDR1^ADDR2^PHONE^STATUS;DESC^GROUP^GROUP #^EMPL #
+5 ;
+6 IF +AGV("X2")=""
GOTO XIT
+7 IF '$DATA(^AUPN3PPH(+AGV("X2"),0))
GOTO XIT
+8 IF $PIECE(^AUPN3PPH(+AGV("X2"),0),U,2)]""
SET AGX("HDFN")=$PIECE(^(0),U,2)
+9 SET $PIECE(AGV("X3"),U,6)=$PIECE(^AUPN3PPH(+AGV("X2"),0),U,6)
SET $PIECE(AGV("X3"),U,7)=$PIECE(^(0),U,7)
+10 SET $PIECE(AGV("X2"),U,6)=$PIECE(^AUPN3PPH(+AGV("X2"),0),U,8)
+11 SET $PIECE(AGV("X2"),U,7)=$PIECE(^AUPN3PPH(+AGV("X2"),0),U,19)
REG IF $PIECE(^AUPN3PPH(+AGV("X2"),0),U,2)=""
GOTO PHINFO
+1 IF $DATA(^DPT(AGX("HDFN"),.11))
IF $PIECE(^(.11),U)]""
IF $PIECE(^(.11),U,4)]""
IF $PIECE(^(.11),U,5)]""
IF $PIECE(^(.11),U,6)]""
Begin DoDot:1
+2 SET $PIECE(AGV("X2"),U,3)=$PIECE(^(.11),U)
+3 SET AG("PH9")=$PIECE(^(.11),U)
+4 SET $PIECE(AGV("X2"),U,4)=$PIECE(^(.11),U,4)_", "
+5 SET AG("PH11")=$PIECE(^(.11),U,4)
End DoDot:1
+6 IF '$TEST
GOTO REMPL
+7 IF $PIECE(^DPT(AGX("HDFN"),.11),U,5)]""
IF $DATA(^DIC(5,$PIECE(^(.11),U,5),0))
Begin DoDot:1
+8 SET $PIECE(AGV("X2"),U,4)=$PIECE(AGV("X2"),U,4)_$PIECE(^(0),U,2)_" "_$PIECE(^DPT(AGX("HDFN"),.11),U,6)
+9 SET AG("PH12")=$PIECE(^(.11),U,5)
+10 SET AG("PH13")=$PIECE(^(.11),U,6)
+11 IF $DATA(^(.13))
SET $PIECE(AGV("X2"),U,5)=$PIECE(^(.13),U)
+12 IF $DATA(^(.13))
SET AG("PH14")=$PIECE(^(.13),U)
End DoDot:1
REMPL IF $PIECE(^AUPNPAT(AGX("HDFN"),0),U,19)]""
IF $DATA(^AUTNEMPL($PIECE(^(0),U,19),0))
Begin DoDot:1
+1 SET $PIECE(AGV("X3"),U)=$PIECE(^(0),U)
+2 SET AGX("E0")=^(0)
End DoDot:1
+3 IF '$TEST
GOTO REMST
+4 SET $PIECE(AGV("X3"),U,2)=$PIECE(AGX("E0"),U,2)
+5 SET $PIECE(AGV("X3"),U,3)=$PIECE(AGX("E0"),U,3)_", "
+6 IF $PIECE(AGX("E0"),U,4)]""
IF $DATA(^DIC(5,$PIECE(AGX("E0"),U,4),0))
Begin DoDot:1
+7 SET $PIECE(AGV("X3"),U,3)=$PIECE(AGV("X3"),U,3)_$PIECE(^(0),U,2)_" "_$PIECE(AGX("E0"),U,5)
End DoDot:1
+8 SET $PIECE(AGV("X3"),U,4)=$PIECE(AGX("E0"),U,6)
REMST SET AGX("Y")=$PIECE(^AUPNPAT(AGX("HDFN"),0),U,21)
+1 IF AGX("Y")=""
SET AGX("Y")=9
+2 SET AGX("Y0")=$PIECE(^DD(9000001,.21,0),U,3)
+3 SET AGX("Y0")=$PIECE($PIECE(AGX("Y0"),AGX("Y")_":",2),";",1)
+4 SET $PIECE(AGV("X3"),U,5)=AGX("Y")_";"_AGX("Y0")
+5 GOTO XIT
PHINFO ;INSURER INFO FROM POLICY HOLDER FILE
+1 SET AGX("Y")=$PIECE(^AUPN3PPH(+AGV("X2"),0),U,15)
+2 IF AGX("Y")=""
GOTO PHADD
+3 SET AGX("Y0")=$PIECE(^DD(9000003.1,.15,0),U,3)
+4 SET AGX("Y0")=$PIECE($PIECE(AGX("Y0"),AGX("Y")_":",2),";",1)
+5 SET $PIECE(AGV("X3"),U,5)=AGX("Y")_";"_AGX("Y0")
PHADD IF $PIECE(^AUPN3PPH(+AGV("X2"),0),U,9)]""
IF $PIECE(^(0),U,11)]""
IF $PIECE(^(0),U,12)]""
IF $PIECE(^(0),U,13)]""
Begin DoDot:1
+1 SET $PIECE(AGV("X2"),U,3)=$PIECE(^(0),U,9)
+2 SET $PIECE(AGV("X2"),U,4)=$PIECE(^(0),U,11)_", "
End DoDot:1
+3 IF '$TEST
GOTO PEMPL
+4 IF $DATA(^DIC(5,$PIECE(^AUPN3PPH(+AGV("X2"),0),U,12),0))
Begin DoDot:1
+5 SET $PIECE(AGV("X2"),U,4)=$PIECE(AGV("X2"),U,4)_$PIECE(^(0),U,2)_" "_$PIECE(^AUPN3PPH(+AGV("X2"),0),U,13)
+6 SET $PIECE(AGV("X2"),U,5)=$PIECE(^(0),U,14)
End DoDot:1
PEMPL IF $PIECE(^AUPN3PPH(+AGV("X2"),0),U,16)]""
IF $DATA(^AUTNEMPL($PIECE(^(0),U,16),0))
Begin DoDot:1
+1 SET $PIECE(AGV("X3"),U)=$PIECE(^(0),U)
SET AGX("E0")=^(0)
End DoDot:1
+2 IF '$TEST
GOTO XIT
+3 IF $PIECE(AGX("E0"),U,2)]""
IF $PIECE(AGX("E0"),U,3)]""
IF $PIECE(AGX("E0"),U,4)]""
IF $PIECE(AGX("E0"),U,5)]""
+4 IF '$TEST
GOTO XIT
+5 SET $PIECE(AGV("X3"),U,2)=$PIECE(AGX("E0"),U,2)
+6 SET $PIECE(AGV("X3"),U,3)=$PIECE(AGX("E0"),U,3)_", "
+7 IF $DATA(^DIC(5,$PIECE(AGX("E0"),U,4),0))
Begin DoDot:1
+8 SET $PIECE(AGV("X3"),U,3)=$PIECE(AGV("X3"),U,3)_$PIECE(^(0),U,2)_" "_$PIECE(AGX("E0"),U,5)
End DoDot:1
+9 SET $PIECE(AGV("X3"),U,4)=$PIECE(AGX("E0"),U,6)
XIT KILL AGX
QUIT
