ABPAOP1 ;POST FACILITY DATA TO AREA DATABASE;[ 07/25/91 11:29 AM ]
;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
A0 Q ;;NOT AN ENTRY POINT
;--------------------------------------------------------------------
A11 ;PROCEDURE TO PROCESS INSURER INFORMATION
S R=$O(^ABPVGLOB(LOC,R))
I +R=0 G GLOBERR
S XXX=^ABPVGLOB(LOC,R)
I $P(XXX,"^",1)'="ABP2" G GLOBERR
S INSNAME=$P(XX,"^",13),INSZIP=$P(XX,"^",17)
S FOUND=0 I $D(^AUTNINS("B",INSNAME))=10 D
.S RR=0 F I=0:0 D Q:(+RR=0)!(FOUND)
..S RR=$O(^AUTNINS("B",INSNAME,RR)) Q:+RR=0
..Q:$D(^AUTNINS(+RR,0))'=1
..I INSZIP=$P(^AUTNINS(+RR,0),"^",5) S INSDFN=RR,FOUND=1
I 'FOUND D
.S P3=$P(^AUTNINS(0),"^",3)
.F I=P3:1 S INSDFN=I Q:$D(^AUTNINS(I,0))'=1
.S $P(^AUTNINS(0),"^",3)=INSDFN
.S $P(^AUTNINS(0),"^",4)=$P(^AUTNINS(0),"^",4)+1
.S $P(^AUTNINS(INSDFN,0),"^",1)=INSNAME
.S $P(^AUTNINS(INSDFN,0),"^",5)=$P(XX,"^",17)
.S NVCNT=NVCNT+1,ZVCNT=ZVCNT+1 I ZVCNT#20=0 D UPDATE^ABPAOP4
.I $D(^ABPAPOST(1,"F",LOCCD,"I",0))'=1 D
..S ^ABPAPOST(1,"F",LOCCD,"I",0)="^9002270.611PA^^0"
.I $D(^ABPAPOST(1,"F",LOCCD,"I",INSDFN,0))'=1 D
..S ^ABPAPOST(1,"F",LOCCD,"I",INSDFN,0)=INSDFN
..S ^ABPAPOST(1,"F",LOCCD,"I","B",INSDFN,INSDFN)=""
..S $P(^ABPAPOST(1,"F",LOCCD,"I",0),"^",3)=INSDFN
..S NEWVAL=+$P(^ABPAPOST(1,"F",LOCCD,"I",0),"^",4)+1
..S $P(^ABPAPOST(1,"F",LOCCD,"I",0),"^",4)=NEWVAL
F I=1,2,3,5 S $P(^AUTNINS(INSDFN,0),"^",I+1)=$P(XX,"^",I+13)
S $P(^AUTNINS(INSDFN,0),"^",9)=$P(XX,"^",19)
I $P(XXX,"^",6)'="" D
.F I=2:1:6 S $P(^AUTNINS(INSDFN,1),"^",I-1)=$P(XXX,"^",I)
K DIK,DA S DIK="^AUTNINS(",DA=INSDFN D IX1^DIK
;--------------------------------------------------------------------
D A1^ABPAOP2 ;;SET INSURER MAILING LABEL FILE ENTRY
A15 ;CHECK LAST NAME AND FIRST INITIAL
S NAME=$P(XX,"^",2),LNAME=$P(NAME,",",1),FINIT=$E($P(NAME,",",2),1,1)
S FAC=$P(XX,"^",3),FACDFN=0,FACDFN=$O(^AUTTLOC("C",FAC,FACDFN))
I +FACDFN<1 W !,?10,"INVALID LOCATION CODE IN RECORD # ",R
S HRN=$P(XX,"^",4)
S ABPVDFN=0,ABPVDFN=$O(^ABPVAO("G",FACDFN,HRN,ABPVDFN))
I ABPVDFN<1 G A16^ABPAOP3
S ZNAME=$P(^ABPVAO(ABPVDFN,0),"^",1),ZLNAME=$P(ZNAME,",",1),ZFINIT=$E($P(ZNAME,",",2),1,1)
I (ZLNAME'=LNAME)!(ZFINIT'=FINIT) G A15B
G A17^ABPAOP3
A15B G A17^ABPAOP3 ;; !,?5,"LAST NAME & FIRST INITIAL OF THIS FAC & CHART # DON'T MATCH",!,?7,"FACILITY NAME =",?25,NAME,!,?7,"AREA NAME = ",?25,ZNAME,!,?20,"NAME INFORMATION NOT UPDATED AT AREA" G A17^ABPAOP3
GLOBERR U IO(0) W *7,!!,"--- ERROR DETECTED IN GLOBAL ""^ABPVGLOB"" ---"
G XIT^ABPAOP4
ABPAOP1 ;POST FACILITY DATA TO AREA DATABASE;[ 07/25/91 11:29 AM ]
+1 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
A0 ;;NOT AN ENTRY POINT
QUIT
+1 ;--------------------------------------------------------------------
A11 ;PROCEDURE TO PROCESS INSURER INFORMATION
+1 SET R=$ORDER(^ABPVGLOB(LOC,R))
+2 IF +R=0
GOTO GLOBERR
+3 SET XXX=^ABPVGLOB(LOC,R)
+4 IF $PIECE(XXX,"^",1)'="ABP2"
GOTO GLOBERR
+5 SET INSNAME=$PIECE(XX,"^",13)
SET INSZIP=$PIECE(XX,"^",17)
+6 SET FOUND=0
IF $DATA(^AUTNINS("B",INSNAME))=10
Begin DoDot:1
+7 SET RR=0
FOR I=0:0
Begin DoDot:2
+8 SET RR=$ORDER(^AUTNINS("B",INSNAME,RR))
IF +RR=0
QUIT
+9 IF $DATA(^AUTNINS(+RR,0))'=1
QUIT
+10 IF INSZIP=$PIECE(^AUTNINS(+RR,0),"^",5)
SET INSDFN=RR
SET FOUND=1
End DoDot:2
IF (+RR=0)!(FOUND)
QUIT
End DoDot:1
+11 IF 'FOUND
Begin DoDot:1
+12 SET P3=$PIECE(^AUTNINS(0),"^",3)
+13 FOR I=P3:1
SET INSDFN=I
IF $DATA(^AUTNINS(I,0))'=1
QUIT
+14 SET $PIECE(^AUTNINS(0),"^",3)=INSDFN
+15 SET $PIECE(^AUTNINS(0),"^",4)=$PIECE(^AUTNINS(0),"^",4)+1
+16 SET $PIECE(^AUTNINS(INSDFN,0),"^",1)=INSNAME
+17 SET $PIECE(^AUTNINS(INSDFN,0),"^",5)=$PIECE(XX,"^",17)
+18 SET NVCNT=NVCNT+1
SET ZVCNT=ZVCNT+1
IF ZVCNT#20=0
DO UPDATE^ABPAOP4
+19 IF $DATA(^ABPAPOST(1,"F",LOCCD,"I",0))'=1
Begin DoDot:2
+20 SET ^ABPAPOST(1,"F",LOCCD,"I",0)="^9002270.611PA^^0"
End DoDot:2
+21 IF $DATA(^ABPAPOST(1,"F",LOCCD,"I",INSDFN,0))'=1
Begin DoDot:2
+22 SET ^ABPAPOST(1,"F",LOCCD,"I",INSDFN,0)=INSDFN
+23 SET ^ABPAPOST(1,"F",LOCCD,"I","B",INSDFN,INSDFN)=""
+24 SET $PIECE(^ABPAPOST(1,"F",LOCCD,"I",0),"^",3)=INSDFN
+25 SET NEWVAL=+$PIECE(^ABPAPOST(1,"F",LOCCD,"I",0),"^",4)+1
+26 SET $PIECE(^ABPAPOST(1,"F",LOCCD,"I",0),"^",4)=NEWVAL
End DoDot:2
End DoDot:1
+27 FOR I=1,2,3,5
SET $PIECE(^AUTNINS(INSDFN,0),"^",I+1)=$PIECE(XX,"^",I+13)
+28 SET $PIECE(^AUTNINS(INSDFN,0),"^",9)=$PIECE(XX,"^",19)
+29 IF $PIECE(XXX,"^",6)'=""
Begin DoDot:1
+30 FOR I=2:1:6
SET $PIECE(^AUTNINS(INSDFN,1),"^",I-1)=$PIECE(XXX,"^",I)
End DoDot:1
+31 KILL DIK,DA
SET DIK="^AUTNINS("
SET DA=INSDFN
DO IX1^DIK
+32 ;--------------------------------------------------------------------
+33 ;;SET INSURER MAILING LABEL FILE ENTRY
DO A1^ABPAOP2
A15 ;CHECK LAST NAME AND FIRST INITIAL
+1 SET NAME=$PIECE(XX,"^",2)
SET LNAME=$PIECE(NAME,",",1)
SET FINIT=$EXTRACT($PIECE(NAME,",",2),1,1)
+2 SET FAC=$PIECE(XX,"^",3)
SET FACDFN=0
SET FACDFN=$ORDER(^AUTTLOC("C",FAC,FACDFN))
+3 IF +FACDFN<1
WRITE !,?10,"INVALID LOCATION CODE IN RECORD # ",R
+4 SET HRN=$PIECE(XX,"^",4)
+5 SET ABPVDFN=0
SET ABPVDFN=$ORDER(^ABPVAO("G",FACDFN,HRN,ABPVDFN))
+6 IF ABPVDFN<1
GOTO A16^ABPAOP3
+7 SET ZNAME=$PIECE(^ABPVAO(ABPVDFN,0),"^",1)
SET ZLNAME=$PIECE(ZNAME,",",1)
SET ZFINIT=$EXTRACT($PIECE(ZNAME,",",2),1,1)
+8 IF (ZLNAME'=LNAME)!(ZFINIT'=FINIT)
GOTO A15B
+9 GOTO A17^ABPAOP3
A15B ;; !,?5,"LAST NAME & FIRST INITIAL OF THIS FAC & CHART # DON'T MATCH",!,?7,"FACILITY NAME =",?25,NAME,!,?7,"AREA NAME = ",?25,ZNAME,!,?20,"NAME INFORMATION NOT UPDATED AT AREA" G A17^ABPAOP3
GOTO A17^ABPAOP3
GLOBERR USE IO(0)
WRITE *7,!!,"--- ERROR DETECTED IN GLOBAL ""^ABPVGLOB"" ---"
+1 GOTO XIT^ABPAOP4
