ABPAOC0 ;MERGE ^ABPVDATA TO ^ABPVGLOB-PART 1; [ 03/16/91 10:35 AM ]
;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
A S ZOPT="NOKC"
K ABPA("HD") S ABPA("HD",1)=ABPATLE
S ABPA("HD",2)="MERGE FACILITY CLAIM DATA AT AREA OFFICE"
D ^ABPAHD W ! S IO(0)=$I,EFLG=0
AA I $E(^%ZOSF("OS"),1,3)="MSM" D ^ABPAOC0A I +EFLG>0 D G END1^ABPAOC1
.W !!,EMSG
I $E(^%ZOSF("OS"),1,3)'="MSM" D I +EFLG>0 G END1^ABPAOC1
.S IOP=47 D ^%ZIS K IOP I IO="" D
..W !,"<<< DEVICE NOT AVAILABLE >>>",!,"JOB TERMINATED"
..S EFLG=EFLG+1
A0 S EFLG=0
I $E(^%ZOSF("OS"),1,3)'="MSM" U IO X ^%ZOSF("MAGTAPE") W @(%MT("REW"))
READ U IO R X,X1,X2,X3
S G=$P($P(X2,"(",1),"^",2)
I G'="ABPVDATA" U IO(0) W !!,*7,?10,"File DOES NOT Contain PRIVATE INSURANCE Data -- JOB CANCELLED" G END1^ABPAOC1
CHECK I $D(^ABPVGLOB("COUNT"))=0 K Y D G CHECK:$D(DQOUT) I ($D(DFOUT))!($D(DUOUT))!(Y="")!(Y?1"N".E) S EFLG=EFLG+1 G END1^ABPAOC1
.U IO(0) W !!,?10,"Are You Sure All Data was POSTED to the Area files? NO// " D SBRS I ($D(DFOUT))!($D(DUOUT))!(Y="")!(Y?1"N".E) Q
.I Y="YES" D Q
..K ^ABPVGLOB
..S ^ABPVGLOB("COUNT")=0,^ABPVGLOB(0)="9999999^0^0^0^^0"
.W !!,*7,"Enter Explicitly 'YES' or 'NO'" S DQOUT=""
S X=+X3,DIC="^AUTTLOC(",DIC(0)="",D="C" D IX^DIC
I +Y<0 S D="CTOO" D IX^DIC
I +Y<0 U IO(0) W *7,!,"FACILITY CODE LOOK-UP ERROR ON CODE '",X,"'" G END1^ABPAOC1
S ZSITE=X
I '$D(ZOPT) G B0
U IO(0) W !!,*7,?12,"File Contains PRIVATE INSURANCE Data -- As listed Below: ",!
U IO(0) W !,?10,"FACILITY CODE = ",?40,$P(X3,"^",1)
W !,?10,"FACILITY NAME = ",?40,$P(X3,"^",2)
W !,?10,"DATE EXPORT CREATED = " S Y=$P(X3,"^",3) X ^DD("DD") W ?40,Y
W !,?10,"BEGINNING CLAIM DATE = " S Y=$P(X3,"^",4) X ^DD("DD") W ?40,Y
W !,?10,"ENDING CLAIM DATE = " S Y=$P(X3,"^",5) X ^DD("DD") W ?40,Y
W !,?10,"NUMBER OF CLAIM RECORDS = ",?40,$P(X3,"^",7),!
I '$D(^ABPVGLOB(ZSITE,0)) D G END1^ABPAOC1:'$T G B0
.R !!,"Press the [RETURN] key to continue... ",X:DTIME
W !!,*7,?10,"Data Already on File for this Facility",!
W ?10,"Do you want to merge this File (Y/N) N// " D SBRS
G:$D(DLOUT)!($D(DUOUT)) END1^ABPAOC1 G B0:"Yy"[Y G END1^ABPAOC1:"Nn"[Y
B0 K ^ASMPITMP
G B1^ABPAOC1
;
SBRS K DFOUT,DTOUT,DUOUT,DQOUT,DLOUT R Y:DTIME I '$T W *7 R Y:5 G SBRS:Y="." I '$T S (DTOUT,Y)="" Q
S:Y="/.," (DFOUT,Y)="" S:Y="" DLOUT="" S:Y="^" (DUOUT,Y)="" S:Y?1"?".E!(Y["^") DQOUT=""
Q
ABPAOC0 ;MERGE ^ABPVDATA TO ^ABPVGLOB-PART 1; [ 03/16/91 10:35 AM ]
+1 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
A SET ZOPT="NOKC"
+1 KILL ABPA("HD")
SET ABPA("HD",1)=ABPATLE
+2 SET ABPA("HD",2)="MERGE FACILITY CLAIM DATA AT AREA OFFICE"
+3 DO ^ABPAHD
WRITE !
SET IO(0)=$IO
SET EFLG=0
AA IF $EXTRACT(^%ZOSF("OS"),1,3)="MSM"
DO ^ABPAOC0A
IF +EFLG>0
Begin DoDot:1
+1 WRITE !!,EMSG
End DoDot:1
GOTO END1^ABPAOC1
+2 IF $EXTRACT(^%ZOSF("OS"),1,3)'="MSM"
Begin DoDot:1
+3 SET IOP=47
DO ^%ZIS
KILL IOP
IF IO=""
Begin DoDot:2
+4 WRITE !,"<<< DEVICE NOT AVAILABLE >>>",!,"JOB TERMINATED"
+5 SET EFLG=EFLG+1
End DoDot:2
End DoDot:1
IF +EFLG>0
GOTO END1^ABPAOC1
A0 SET EFLG=0
+1 IF $EXTRACT(^%ZOSF("OS"),1,3)'="MSM"
USE IO
XECUTE ^%ZOSF("MAGTAPE")
WRITE @(%MT("REW"))
READ USE IO
READ X,X1,X2,X3
+1 SET G=$PIECE($PIECE(X2,"(",1),"^",2)
+2 IF G'="ABPVDATA"
USE IO(0)
WRITE !!,*7,?10,"File DOES NOT Contain PRIVATE INSURANCE Data -- JOB CANCELLED"
GOTO END1^ABPAOC1
CHECK IF $DATA(^ABPVGLOB("COUNT"))=0
KILL Y
Begin DoDot:1
+1 USE IO(0)
WRITE !!,?10,"Are You Sure All Data was POSTED to the Area files? NO// "
DO SBRS
IF ($DATA(DFOUT))!($DATA(DUOUT))!(Y="")!(Y?1"N".E)
QUIT
+2 IF Y="YES"
Begin DoDot:2
+3 KILL ^ABPVGLOB
+4 SET ^ABPVGLOB("COUNT")=0
SET ^ABPVGLOB(0)="9999999^0^0^0^^0"
End DoDot:2
QUIT
+5 WRITE !!,*7,"Enter Explicitly 'YES' or 'NO'"
SET DQOUT=""
End DoDot:1
IF $DATA(DQOUT)
GOTO CHECK
IF ($DATA(DFOUT))!($DATA(DUOUT))!(Y="")!(Y?1"N".E)
SET EFLG=EFLG+1
GOTO END1^ABPAOC1
+6 SET X=+X3
SET DIC="^AUTTLOC("
SET DIC(0)=""
SET D="C"
DO IX^DIC
+7 IF +Y<0
SET D="CTOO"
DO IX^DIC
+8 IF +Y<0
USE IO(0)
WRITE *7,!,"FACILITY CODE LOOK-UP ERROR ON CODE '",X,"'"
GOTO END1^ABPAOC1
+9 SET ZSITE=X
+10 IF '$DATA(ZOPT)
GOTO B0
+11 USE IO(0)
WRITE !!,*7,?12,"File Contains PRIVATE INSURANCE Data -- As listed Below: ",!
+12 USE IO(0)
WRITE !,?10,"FACILITY CODE = ",?40,$PIECE(X3,"^",1)
+13 WRITE !,?10,"FACILITY NAME = ",?40,$PIECE(X3,"^",2)
+14 WRITE !,?10,"DATE EXPORT CREATED = "
SET Y=$PIECE(X3,"^",3)
XECUTE ^DD("DD")
WRITE ?40,Y
+15 WRITE !,?10,"BEGINNING CLAIM DATE = "
SET Y=$PIECE(X3,"^",4)
XECUTE ^DD("DD")
WRITE ?40,Y
+16 WRITE !,?10,"ENDING CLAIM DATE = "
SET Y=$PIECE(X3,"^",5)
XECUTE ^DD("DD")
WRITE ?40,Y
+17 WRITE !,?10,"NUMBER OF CLAIM RECORDS = ",?40,$PIECE(X3,"^",7),!
+18 IF '$DATA(^ABPVGLOB(ZSITE,0))
Begin DoDot:1
+19 READ !!,"Press the [RETURN] key to continue... ",X:DTIME
End DoDot:1
IF '$TEST
GOTO END1^ABPAOC1
GOTO B0
+20 WRITE !!,*7,?10,"Data Already on File for this Facility",!
+21 WRITE ?10,"Do you want to merge this File (Y/N) N// "
DO SBRS
+22 IF $DATA(DLOUT)!($DATA(DUOUT))
GOTO END1^ABPAOC1
IF "Yy"[Y
GOTO B0
IF "Nn"[Y
GOTO END1^ABPAOC1
B0 KILL ^ASMPITMP
+1 GOTO B1^ABPAOC1
+2 ;
SBRS KILL DFOUT,DTOUT,DUOUT,DQOUT,DLOUT
READ Y:DTIME
IF '$TEST
WRITE *7
READ Y:5
IF Y="."
GOTO SBRS
IF '$TEST
SET (DTOUT,Y)=""
QUIT
+1 IF Y="/.,"
SET (DFOUT,Y)=""
IF Y=""
SET DLOUT=""
IF Y="^"
SET (DUOUT,Y)=""
IF Y?1"?".E!(Y["^")
SET DQOUT=""
+2 QUIT
