- AGEL3 ; IHS/ASDS/EFG - Add/Edit Eligibility Info PAGE 3 ;
- ;;7.1;PATIENT REGISTRATION;**1,2**;JAN 31, 2007
- ;
- V14 K DIC,AGELP("RELSH")
- S TEMPDFN=DFN
- S DIC="^DPT(",DIC(0)="QEAM"
- S DIC("A")="Select Member to Add..: "
- D ^DIC
- S DFN=TEMPDFN
- I +Y<1 Q
- I $D(AGELP(+Y)) W *7 Q
- VENT S AGEL("X")=+Y
- I '$D(^AUPNPRVT(+Y,0)) D Q:Y<0
- .K DIC,DD,DO
- .S DIC="^AUPNPRVT(",DIC(0)="L",(X,DINUM)=+Y
- .D FILE^DICN
- .K X,DINUM
- G VADD
- S (AGEL("INX"),AGEL("IN"))=0
- F AGZ("I")=1:1 S AGEL("IN")=$O(^AUPNPRVT(AGEL("X"),11,AGEL("IN"))) Q:'+AGEL("IN") S AGEL("IN0")=^(AGEL("IN"),0) D Q:AGEL("INX")
- .I $P(AGEL("IN0"),U)=AGELP("INS"),$P(AGEL("IN0"),U,2)=""!($P(AGEL("IN0"),U,2)=$P(^AUPN3PPH(AGELP("PH"),0),U,4)) D
- ..S AGEL("INX")=1 Q
- I AGEL("INX") G VEDIT
- VADD S X=AGELP("INS")
- ;I '$D(^AUPNPRVT(+Y,11)) S ^AUPNPRVT(+Y,11,0)="^9000006.11P^^"
- I '$D(^AUPNPRVT(+Y,11)) S DIC("P")=$P(^DD(9000006,1101,0),U,2) ;AG*7.1*1 IMPROPER HARD SET OF SUBFILE
- K DD,DO,DIC,AGREC
- S DIC(0)="L",DA(1)=AGEL("X")
- S DIC="^AUPNPRVT("_DA(1)_",11,"
- D FILE^DICN
- K DIC Q:+Y<1
- S AGEL("IN")=+Y
- S AGREC=+Y
- S DR=".12 Person Code..: "
- S DR=DR_";.14 Primary Care Provider...: "
- S DR=DR_";21 Member Number..: "
- S DR=DR_";.15 Card Copy Obtained (Y/N)?..: "
- S DA=+Y,DA(1)=AGEL("X")
- S $P(AGINSREC,U,11)=DA(1)_",11,"_DA_",0"
- S DIE="^AUPNPRVT("_DA(1)_",11,"
- D ^DIE
- I $P($G(^AUPNPRVT(DFN,11,DA,0)),U,15)["Y" D
- .S DR=".16 Date CC Obtained..: "
- .D ^DIE
- VEDIT S DR=".02////"_$P(^AUPN3PPH(AGELP("PH"),0),U,4)_";.03////"_$P(^(0),U,5)_";.06////"_$P(^(0),U,17)
- S DR=DR_";.07////"_$P(^(0),U,18)_";.08////"_AGELP("PH")_";.04////"_$P(^AUPN3PPH(AGELP("PH"),0),U)
- I AGELP("SAME") S DR=DR_";.05///SELF"
- E I $D(AGELP("RELSH")) S DR=DR_";.05////"_AGELP("RELSH")
- E S DR=DR_";.05R~Relationship to Insured..: "
- S DA=AGEL("IN"),DA(1)=AGEL("X")
- S DIE="^AUPNPRVT("_DA(1)_",11,"
- D ^DIE
- S AGEL("DFN")=$S($G(AGEL("IN")):AGEL("IN"),$D(DFN):DFN,1:"")
- S DFN=DA(1)
- D UPDATE1^AGED(DUZ(2),DA(1),7,DA)
- Q
- AGEL3 ; IHS/ASDS/EFG - Add/Edit Eligibility Info PAGE 3 ;
- +1 ;;7.1;PATIENT REGISTRATION;**1,2**;JAN 31, 2007
- +2 ;
- V14 KILL DIC,AGELP("RELSH")
- +1 SET TEMPDFN=DFN
- +2 SET DIC="^DPT("
- SET DIC(0)="QEAM"
- +3 SET DIC("A")="Select Member to Add..: "
- +4 DO ^DIC
- +5 SET DFN=TEMPDFN
- +6 IF +Y<1
- QUIT
- +7 IF $DATA(AGELP(+Y))
- WRITE *7
- QUIT
- VENT SET AGEL("X")=+Y
- +1 IF '$DATA(^AUPNPRVT(+Y,0))
- Begin DoDot:1
- +2 KILL DIC,DD,DO
- +3 SET DIC="^AUPNPRVT("
- SET DIC(0)="L"
- SET (X,DINUM)=+Y
- +4 DO FILE^DICN
- +5 KILL X,DINUM
- End DoDot:1
- IF Y<0
- QUIT
- +6 GOTO VADD
- +7 SET (AGEL("INX"),AGEL("IN"))=0
- +8 FOR AGZ("I")=1:1
- SET AGEL("IN")=$ORDER(^AUPNPRVT(AGEL("X"),11,AGEL("IN")))
- IF '+AGEL("IN")
- QUIT
- SET AGEL("IN0")=^(AGEL("IN"),0)
- Begin DoDot:1
- +9 IF $PIECE(AGEL("IN0"),U)=AGELP("INS")
- IF $PIECE(AGEL("IN0"),U,2)=""!($PIECE(AGEL("IN0"),U,2)=$PIECE(^AUPN3PPH(AGELP("PH"),0),U,4))
- Begin DoDot:2
- +10 SET AGEL("INX")=1
- QUIT
- End DoDot:2
- End DoDot:1
- IF AGEL("INX")
- QUIT
- +11 IF AGEL("INX")
- GOTO VEDIT
- VADD SET X=AGELP("INS")
- +1 ;I '$D(^AUPNPRVT(+Y,11)) S ^AUPNPRVT(+Y,11,0)="^9000006.11P^^"
- +2 ;AG*7.1*1 IMPROPER HARD SET OF SUBFILE
- IF '$DATA(^AUPNPRVT(+Y,11))
- SET DIC("P")=$PIECE(^DD(9000006,1101,0),U,2)
- +3 KILL DD,DO,DIC,AGREC
- +4 SET DIC(0)="L"
- SET DA(1)=AGEL("X")
- +5 SET DIC="^AUPNPRVT("_DA(1)_",11,"
- +6 DO FILE^DICN
- +7 KILL DIC
- IF +Y<1
- QUIT
- +8 SET AGEL("IN")=+Y
- +9 SET AGREC=+Y
- +10 SET DR=".12 Person Code..: "
- +11 SET DR=DR_";.14 Primary Care Provider...: "
- +12 SET DR=DR_";21 Member Number..: "
- +13 SET DR=DR_";.15 Card Copy Obtained (Y/N)?..: "
- +14 SET DA=+Y
- SET DA(1)=AGEL("X")
- +15 SET $PIECE(AGINSREC,U,11)=DA(1)_",11,"_DA_",0"
- +16 SET DIE="^AUPNPRVT("_DA(1)_",11,"
- +17 DO ^DIE
- +18 IF $PIECE($GET(^AUPNPRVT(DFN,11,DA,0)),U,15)["Y"
- Begin DoDot:1
- +19 SET DR=".16 Date CC Obtained..: "
- +20 DO ^DIE
- End DoDot:1
- VEDIT SET DR=".02////"_$PIECE(^AUPN3PPH(AGELP("PH"),0),U,4)_";.03////"_$PIECE(^(0),U,5)_";.06////"_$PIECE(^(0),U,17)
- +1 SET DR=DR_";.07////"_$PIECE(^(0),U,18)_";.08////"_AGELP("PH")_";.04////"_$PIECE(^AUPN3PPH(AGELP("PH"),0),U)
- +2 IF AGELP("SAME")
- SET DR=DR_";.05///SELF"
- +3 IF '$TEST
- IF $DATA(AGELP("RELSH"))
- SET DR=DR_";.05////"_AGELP("RELSH")
- +4 IF '$TEST
- SET DR=DR_";.05R~Relationship to Insured..: "
- +5 SET DA=AGEL("IN")
- SET DA(1)=AGEL("X")
- +6 SET DIE="^AUPNPRVT("_DA(1)_",11,"
- +7 DO ^DIE
- +8 SET AGEL("DFN")=$SELECT($GET(AGEL("IN")):AGEL("IN"),$DATA(DFN):DFN,1:"")
- +9 SET DFN=DA(1)
- +10 DO UPDATE1^AGED(DUZ(2),DA(1),7,DA)
- +11 QUIT
