- 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
