- 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
