ABPAOC1 ;MERGE ^ABPVDATA TO ^ABPVGLOB-PART 2; [ 03/16/91 10:35 AM ]
;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
B0 W !!,*7,"NOT AN ENTRY POINT!!!" Q
;
B1 S CT=0,ICT=$P(X3,"^",7),ICT=ICT*2
U IO(0) W !!,?5,"<<<< Please Standby - Transfering PRIVATE INSURANCE Data >>>>",!
S ^ASMPITMP(ZSITE,0)=$P(X3,"^",4,5)_"^"_$P(X3,"^",7)_"^"_$P(X3,"^",6)_"^"_$P(X3,"^",2,3)
F I=1:1 U IO R X G END:$E(X,1,2)="**" U IO R X1,X2,X3 D S9A I +EFLG>0 G END1
S9A S RTYP=$P(X1,"^",1) G:RTYP'="ABP1" RTYPERR
S CT=CT+1,^ASMPITMP(ZSITE,CT)=X1
S RTYP=$P(X3,"^",1) G:RTYP'="ABP2" RTYPERR
S CT=CT+1,^ASMPITMP(ZSITE,CT)=X3 Q
RTYPERR U IO(0) W *7,!,"<<< RECORD TYPE ERROR AT RECORD #",CT+1," ....JOB TERMINATED >>>" S EFLG=EFLG+1 Q
END I +CT'=+ICT D TERROR S EFLG=EFLG+1 G END1
;
TXFER1 S CDT=$P(^ABPVGLOB(0),"^",1),NDT=$P(^ASMPITMP(ZSITE,0),"^",1)
I NDT<CDT S $P(^ABPVGLOB(0),"^",1)=NDT
S CDT=$P(^ABPVGLOB(0),"^",2),NDT=$P(^ASMPITMP(ZSITE,0),"^",2)
I NDT>CDT S $P(^ABPVGLOB(0),"^",2)=NDT
S $P(^ABPVGLOB(0),"^",5)=ZSITE
I '$D(^ABPVGLOB(ZSITE,0)) D G NXTR
.S $P(^ABPVGLOB(0),"^",3)=$P(^ABPVGLOB(0),"^",3)+1
.S ^ABPVGLOB(ZSITE,0)=^ASMPITMP(ZSITE,0),(R,RC,RCT)=0
.S TCNT=$P(^ABPVGLOB(ZSITE,0),"^",3),$P(^(0),"^",4)=TCNT*2 K TCNT
S CDT=$P(^ABPVGLOB(ZSITE,0),"^",1),NDT=$P(^ASMPITMP(ZSITE,0),"^",1)
I NDT<CDT S $P(^ABPVGLOB(ZSITE,0),"^",1)=NDT
S CDT=$P(^ABPVGLOB(ZSITE,0),"^",2),NDT=$P(^ASMPITMP(ZSITE,0),"^",2)
I NDT>CDT S $P(^ABPVGLOB(ZSITE,0),"^",2)=NDT
S $P(^ABPVGLOB(ZSITE,0),"^",4)=$P(^ASMPITMP(ZSITE,0),"^",4)
S CDT=$P(^ABPVGLOB(ZSITE,0),"^",6),NDT=$P(^ASMPITMP(ZSITE,0),"^",6)
I NDT>CDT S $P(^ABPVGLOB(ZSITE,0),"^",2)=NDT
S R=0,RC=0,RCT=$P(^ABPVGLOB(ZSITE,0),"^",3)
NXTR S R=$O(^ASMPITMP(ZSITE,R)) G TXSUM:+R=0
S RC=RC+1,RCT=RCT+1,^ABPVGLOB(ZSITE,RCT)=^ASMPITMP(ZSITE,R) G NXTR
TXSUM U IO(0) W !!,?12,"A total of ",(RC/2)," PRIVATE INSURANCE records "
U IO(0) W "were MERGED.",!?12,"A total of ",RC," nodes were "
U IO(0) W "processed.",!
S ^ABPVGLOB("COUNT")=^ABPVGLOB("COUNT")+RC
S $P(^ABPVGLOB(0),"^",4)=^ABPVGLOB("COUNT")
S $P(^ABPVGLOB(ZSITE,0),"^",3)=RCT
D ENDK
;
POST F I=0:0 D Q:+%>0
.W *7,!!,"SHALL I POST THESE RECORDS NOW"
.S %=2 D YN^DICN
I +%=2 Q
CONT G A0^ABPAOP0
;
ENDK U IO(0) X ^%ZIS("C")
K CT,CTFI,CTPD,CTPIG,CTV,CTVS,RC,RTYP,ASITE,TX2,TX3,X2,X3,X,Y,ZTOT
K ZTYPE,ZSITE,X1,%MT,AUOK,DUOUT,DLOUT,DTOUT,G,I,ZOPT,R,RCT,NDT,EMSG
Q
;
END1 S AUOK=1 U IO(0) W !!,?20,"No PRIVATE INSURANCE Data Transferred",! G ENDK
;
TERROR U IO(0) W *7,!!,?10,"An Error has been detected while reading these records.",!!,"Please notify you supervisor.",! Q
ABPAOC1 ;MERGE ^ABPVDATA TO ^ABPVGLOB-PART 2; [ 03/16/91 10:35 AM ]
+1 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
B0 WRITE !!,*7,"NOT AN ENTRY POINT!!!"
QUIT
+1 ;
B1 SET CT=0
SET ICT=$PIECE(X3,"^",7)
SET ICT=ICT*2
+1 USE IO(0)
WRITE !!,?5,"<<<< Please Standby - Transfering PRIVATE INSURANCE Data >>>>",!
+2 SET ^ASMPITMP(ZSITE,0)=$PIECE(X3,"^",4,5)_"^"_$PIECE(X3,"^",7)_"^"_$PIECE(X3,"^",6)_"^"_$PIECE(X3,"^",2,3)
+3 FOR I=1:1
USE IO
READ X
IF $EXTRACT(X,1,2)="**"
GOTO END
USE IO
READ X1,X2,X3
DO S9A
IF +EFLG>0
GOTO END1
S9A SET RTYP=$PIECE(X1,"^",1)
IF RTYP'="ABP1"
GOTO RTYPERR
+1 SET CT=CT+1
SET ^ASMPITMP(ZSITE,CT)=X1
+2 SET RTYP=$PIECE(X3,"^",1)
IF RTYP'="ABP2"
GOTO RTYPERR
+3 SET CT=CT+1
SET ^ASMPITMP(ZSITE,CT)=X3
QUIT
RTYPERR USE IO(0)
WRITE *7,!,"<<< RECORD TYPE ERROR AT RECORD #",CT+1," ....JOB TERMINATED >>>"
SET EFLG=EFLG+1
QUIT
END IF +CT'=+ICT
DO TERROR
SET EFLG=EFLG+1
GOTO END1
+1 ;
TXFER1 SET CDT=$PIECE(^ABPVGLOB(0),"^",1)
SET NDT=$PIECE(^ASMPITMP(ZSITE,0),"^",1)
+1 IF NDT<CDT
SET $PIECE(^ABPVGLOB(0),"^",1)=NDT
+2 SET CDT=$PIECE(^ABPVGLOB(0),"^",2)
SET NDT=$PIECE(^ASMPITMP(ZSITE,0),"^",2)
+3 IF NDT>CDT
SET $PIECE(^ABPVGLOB(0),"^",2)=NDT
+4 SET $PIECE(^ABPVGLOB(0),"^",5)=ZSITE
+5 IF '$DATA(^ABPVGLOB(ZSITE,0))
Begin DoDot:1
+6 SET $PIECE(^ABPVGLOB(0),"^",3)=$PIECE(^ABPVGLOB(0),"^",3)+1
+7 SET ^ABPVGLOB(ZSITE,0)=^ASMPITMP(ZSITE,0)
SET (R,RC,RCT)=0
+8 SET TCNT=$PIECE(^ABPVGLOB(ZSITE,0),"^",3)
SET $PIECE(^(0),"^",4)=TCNT*2
KILL TCNT
End DoDot:1
GOTO NXTR
+9 SET CDT=$PIECE(^ABPVGLOB(ZSITE,0),"^",1)
SET NDT=$PIECE(^ASMPITMP(ZSITE,0),"^",1)
+10 IF NDT<CDT
SET $PIECE(^ABPVGLOB(ZSITE,0),"^",1)=NDT
+11 SET CDT=$PIECE(^ABPVGLOB(ZSITE,0),"^",2)
SET NDT=$PIECE(^ASMPITMP(ZSITE,0),"^",2)
+12 IF NDT>CDT
SET $PIECE(^ABPVGLOB(ZSITE,0),"^",2)=NDT
+13 SET $PIECE(^ABPVGLOB(ZSITE,0),"^",4)=$PIECE(^ASMPITMP(ZSITE,0),"^",4)
+14 SET CDT=$PIECE(^ABPVGLOB(ZSITE,0),"^",6)
SET NDT=$PIECE(^ASMPITMP(ZSITE,0),"^",6)
+15 IF NDT>CDT
SET $PIECE(^ABPVGLOB(ZSITE,0),"^",2)=NDT
+16 SET R=0
SET RC=0
SET RCT=$PIECE(^ABPVGLOB(ZSITE,0),"^",3)
NXTR SET R=$ORDER(^ASMPITMP(ZSITE,R))
IF +R=0
GOTO TXSUM
+1 SET RC=RC+1
SET RCT=RCT+1
SET ^ABPVGLOB(ZSITE,RCT)=^ASMPITMP(ZSITE,R)
GOTO NXTR
TXSUM USE IO(0)
WRITE !!,?12,"A total of ",(RC/2)," PRIVATE INSURANCE records "
+1 USE IO(0)
WRITE "were MERGED.",!?12,"A total of ",RC," nodes were "
+2 USE IO(0)
WRITE "processed.",!
+3 SET ^ABPVGLOB("COUNT")=^ABPVGLOB("COUNT")+RC
+4 SET $PIECE(^ABPVGLOB(0),"^",4)=^ABPVGLOB("COUNT")
+5 SET $PIECE(^ABPVGLOB(ZSITE,0),"^",3)=RCT
+6 DO ENDK
+7 ;
POST FOR I=0:0
Begin DoDot:1
+1 WRITE *7,!!,"SHALL I POST THESE RECORDS NOW"
+2 SET %=2
DO YN^DICN
End DoDot:1
IF +%>0
QUIT
+3 IF +%=2
QUIT
CONT GOTO A0^ABPAOP0
+1 ;
ENDK USE IO(0)
XECUTE ^%ZIS("C")
+1 KILL CT,CTFI,CTPD,CTPIG,CTV,CTVS,RC,RTYP,ASITE,TX2,TX3,X2,X3,X,Y,ZTOT
+2 KILL ZTYPE,ZSITE,X1,%MT,AUOK,DUOUT,DLOUT,DTOUT,G,I,ZOPT,R,RCT,NDT,EMSG
+3 QUIT
+4 ;
END1 SET AUOK=1
USE IO(0)
WRITE !!,?20,"No PRIVATE INSURANCE Data Transferred",!
GOTO ENDK
+1 ;
TERROR USE IO(0)
WRITE *7,!!,?10,"An Error has been detected while reading these records.",!!,"Please notify you supervisor.",!
QUIT
