- 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
