AGED4A01 ; IHS/ASDS/EFG - PAGE 4 - INSURANCE SUMMARY OVERFLOW ; 07 Sep 2005 7:26 AM
;;7.1;PATIENT REGISTRATION;**1,2**;JAN 31, 2007
;
EDITINS ;EP - CALLED BY AGED4A
I '$D(AGINS) W !,"THIS PATIENT HAS NO INSURERS YET" H 2 Q
D HEADING^AGED4A1
;D DISPLAYN
D DISPLAYN^AGED4A1 ;AG*7.1*1 SAC REQ TOO LRG
I $G(AGANS)="" Q
Q:$D(DTOUT)
I $G(AGANS)'=""&($G(AGANS)'="^")&($G(AGANS)'="^^")&($G(AGANS)'="/.,") D
.K AGTOUT
.I $D(AGINSNN($G(AGANS)))=10 S AGINSREC=$G(AGINSNN(AGANS,1))
.E S AGINSREC=$G(AGINSNN(AGANS))
.S AGTYPE=$P(AGINSREC,U,10)
.S AGELPTR=$P($P(AGINSREC,U,11),",",1)
.S AGEL("IN")=$P($P(AGINSREC,U,11),",",3)
.S AGELP("INS")=$P(AGINSREC,U,2)
.;I AGTYPE="R"&($P(AGINSREC,U,2)'=1) D Q
.;I ((AGTYPE="R"!(AGTYPE="MD"))&($P(AGINSREC,U,2)'=1))!($P(AGINSREC,U,3)="D") D Q ;AG/SD/TPF 12/20/2005 AG*7.1*1 ITEM 2
.I (($E($P(AGINSREC,U,7))="M")) D ;AG*7.1*2 IM????? FIX PART D RR AND MCR NOT GOING TO THE RIGHT EDIT PAGE
..S NEWENTRY=0 D EN^AGED4(AGINSREC)
..Q:$G(Y)=AGOPT("ESCAPE")
..Q:'$O(^AUPNMCR(DFN,11,0))
..D EN^AGED42(DFN,,0,AGINSREC)
.;I AGTYPE="R"&($P(AGINSREC,U,2)=1) D Q
.I (($E($P(AGINSREC,U,7))="R")) D ;AG*7.1*2
..S NEWENTRY=0 D EN^AGED6(AGINSREC)
..Q:$G(Y)=AGOPT("ESCAPE")
..Q:'$O(^AUPNRRE(DFN,11,0))
..D EN^AGED62(DFN,,0,AGINSREC)
.I AGTYPE="D"!(AGTYPE="K") D
..S PARDFN=$P($P(AGINSREC,U,11),",")
..S PARDT=$P($P(AGINSREC,U,11),",",3)
..S NEWENTRY=0
..D EN^AGEDMCD(PARDFN,PARDT,NEWENTRY,AGINSREC)
..K PARDFN,PARDT,NEWENTRY
.;I AGTYPE="P" D PRVTINS(AGINSREC) Q
.I AGTYPE="P" D PRVTINS^AGED4A3(AGINSREC) Q ;AG*7.1*2 MOVED CODE
.I AGTYPE="T" D
..S PARDFN=$P($P(AGINSREC,U,11),",")
..S PARDT=$P($P(AGINSREC,U,11),",",3)
..S NEWENTRY=0
..D EN^AGEDTPL(PARDFN,PARDT,NEWENTRY,AGINSREC)
..K PARDFN,PARDT,NEWENTRY
.I AGTYPE="W" D
..S PARDFN=$P($P(AGINSREC,U,11),",")
..S PARDT=$P($P(AGINSREC,U,11),",",2)
..S NEWENTRY=0
..D EN^AGEDWC(PARDFN,PARDT,NEWENTRY,AGINSREC)
..K PARDFN,PARDT,NEWENTRY
.I AGTYPE="G" D
..S PARDFN=$P($P(AGINSREC,U,11),",")
..;S PARDT=$P($P(AGINSREC,U,11),",",3)
..;S PARFIL=$P($P(AGINSREC,U,11),",",2)
..S PARDT=$P($P(AGINSREC,U,11),",",2)
..S PARFIL=$P($P(AGINSREC,U,11),",",3)
..S NEWENTRY=0
..D EN^AGEDGUAR(PARDFN,PARFIL,PARDT,NEWENTRY,AGINSREC)
..K PARDFN,PARFIL,PARDT,NEWENTRY
Q:$D(AGTOUT)!$D(DTOUT)
K AGINSNN,AGSELECT
D ^AGINS
I $D(^AUPNICP("C",DFN)) K AGCAT D LOADCAT^AGCAT
Q
AGED4A01 ; IHS/ASDS/EFG - PAGE 4 - INSURANCE SUMMARY OVERFLOW ; 07 Sep 2005 7:26 AM
+1 ;;7.1;PATIENT REGISTRATION;**1,2**;JAN 31, 2007
+2 ;
EDITINS ;EP - CALLED BY AGED4A
+1 IF '$DATA(AGINS)
WRITE !,"THIS PATIENT HAS NO INSURERS YET"
HANG 2
QUIT
+2 DO HEADING^AGED4A1
+3 ;D DISPLAYN
+4 ;AG*7.1*1 SAC REQ TOO LRG
DO DISPLAYN^AGED4A1
+5 IF $GET(AGANS)=""
QUIT
+6 IF $DATA(DTOUT)
QUIT
+7 IF $GET(AGANS)'=""&($GET(AGANS)'="^")&($GET(AGANS)'="^^")&($GET(AGANS)'="/.,")
Begin DoDot:1
+8 KILL AGTOUT
+9 IF $DATA(AGINSNN($GET(AGANS)))=10
SET AGINSREC=$GET(AGINSNN(AGANS,1))
+10 IF '$TEST
SET AGINSREC=$GET(AGINSNN(AGANS))
+11 SET AGTYPE=$PIECE(AGINSREC,U,10)
+12 SET AGELPTR=$PIECE($PIECE(AGINSREC,U,11),",",1)
+13 SET AGEL("IN")=$PIECE($PIECE(AGINSREC,U,11),",",3)
+14 SET AGELP("INS")=$PIECE(AGINSREC,U,2)
+15 ;I AGTYPE="R"&($P(AGINSREC,U,2)'=1) D Q
+16 ;I ((AGTYPE="R"!(AGTYPE="MD"))&($P(AGINSREC,U,2)'=1))!($P(AGINSREC,U,3)="D") D Q ;AG/SD/TPF 12/20/2005 AG*7.1*1 ITEM 2
+17 ;AG*7.1*2 IM????? FIX PART D RR AND MCR NOT GOING TO THE RIGHT EDIT PAGE
IF (($EXTRACT($PIECE(AGINSREC,U,7))="M"))
Begin DoDot:2
+18 SET NEWENTRY=0
DO EN^AGED4(AGINSREC)
+19 IF $GET(Y)=AGOPT("ESCAPE")
QUIT
+20 IF '$ORDER(^AUPNMCR(DFN,11,0))
QUIT
+21 DO EN^AGED42(DFN,,0,AGINSREC)
End DoDot:2
+22 ;I AGTYPE="R"&($P(AGINSREC,U,2)=1) D Q
+23 ;AG*7.1*2
IF (($EXTRACT($PIECE(AGINSREC,U,7))="R"))
Begin DoDot:2
+24 SET NEWENTRY=0
DO EN^AGED6(AGINSREC)
+25 IF $GET(Y)=AGOPT("ESCAPE")
QUIT
+26 IF '$ORDER(^AUPNRRE(DFN,11,0))
QUIT
+27 DO EN^AGED62(DFN,,0,AGINSREC)
End DoDot:2
+28 IF AGTYPE="D"!(AGTYPE="K")
Begin DoDot:2
+29 SET PARDFN=$PIECE($PIECE(AGINSREC,U,11),",")
+30 SET PARDT=$PIECE($PIECE(AGINSREC,U,11),",",3)
+31 SET NEWENTRY=0
+32 DO EN^AGEDMCD(PARDFN,PARDT,NEWENTRY,AGINSREC)
+33 KILL PARDFN,PARDT,NEWENTRY
End DoDot:2
+34 ;I AGTYPE="P" D PRVTINS(AGINSREC) Q
+35 ;AG*7.1*2 MOVED CODE
IF AGTYPE="P"
DO PRVTINS^AGED4A3(AGINSREC)
QUIT
+36 IF AGTYPE="T"
Begin DoDot:2
+37 SET PARDFN=$PIECE($PIECE(AGINSREC,U,11),",")
+38 SET PARDT=$PIECE($PIECE(AGINSREC,U,11),",",3)
+39 SET NEWENTRY=0
+40 DO EN^AGEDTPL(PARDFN,PARDT,NEWENTRY,AGINSREC)
+41 KILL PARDFN,PARDT,NEWENTRY
End DoDot:2
+42 IF AGTYPE="W"
Begin DoDot:2
+43 SET PARDFN=$PIECE($PIECE(AGINSREC,U,11),",")
+44 SET PARDT=$PIECE($PIECE(AGINSREC,U,11),",",2)
+45 SET NEWENTRY=0
+46 DO EN^AGEDWC(PARDFN,PARDT,NEWENTRY,AGINSREC)
+47 KILL PARDFN,PARDT,NEWENTRY
End DoDot:2
+48 IF AGTYPE="G"
Begin DoDot:2
+49 SET PARDFN=$PIECE($PIECE(AGINSREC,U,11),",")
+50 ;S PARDT=$P($P(AGINSREC,U,11),",",3)
+51 ;S PARFIL=$P($P(AGINSREC,U,11),",",2)
+52 SET PARDT=$PIECE($PIECE(AGINSREC,U,11),",",2)
+53 SET PARFIL=$PIECE($PIECE(AGINSREC,U,11),",",3)
+54 SET NEWENTRY=0
+55 DO EN^AGEDGUAR(PARDFN,PARFIL,PARDT,NEWENTRY,AGINSREC)
+56 KILL PARDFN,PARFIL,PARDT,NEWENTRY
End DoDot:2
End DoDot:1
+57 IF $DATA(AGTOUT)!$DATA(DTOUT)
QUIT
+58 KILL AGINSNN,AGSELECT
+59 DO ^AGINS
+60 IF $DATA(^AUPNICP("C",DFN))
KILL AGCAT
DO LOADCAT^AGCAT
+61 QUIT
