BARPMUP1 ; IHS/SD/LSL - MANUAL UPLOAD PROCESS JAN 15,1997 ;
;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
;
; IHS/SD/LSL - 12/12/02 - V1.7 - NHA-0601-180049
; Find the right bill in 3PB.
;
; *********************************************************************
;** Manual upload process for a single 3p bill
; *********************************************************************
;
ONE ;EP
N DIC,BARDA,BARSTAT
; -------------------------------
;
SELSAT ; checking for satellite selection
K BARQUIT
W !,"Please pick the satellite you wish to load",!
S DIC=$$DIC^XBDIQ1(90052.05)
S DA(1)=DUZ(2)
S DIC(0)="AEQMZ"
D ^DIC
I Y'>0 W !,"NONE PICKED",! Q
S BARDUZ2=DUZ(2)
F D SELSATE Q:$D(DIRUT)
S DUZ(2)=BARDUZ2
K BARDUZ2
Q
; *********************************************************************
;
SELSATE ;
N BARBILLS,BAR3PBIL,BARCNT,BAR3PAT,BASR3DOS,Y
W !!
K DIR
S DIR("A")="Select 3P Bill: "
S DIR(0)="FA^2:8"
D ^DIR
Q:$D(DIRUT)
S BAR3PBIL=Y
D FINDBILL
I '$D(BARBILLS) W " Bill not found in 3PB." Q
I +$G(BARCNT)>1 D CHOOSE
Q:'+$G(BARCNT)
S Y=$P(BARBILLS(BARCNT),U,2)
S DUZ(2)=$P(BARBILLS(BARCNT),U)
D L2 Q:+Y<0
Q
; *********************************************************************
;
FINDBILL ;
K BARCNT,BARBILLS
N BAR3PAT,BAR3DOS
S DUZ(2)=0
F S DUZ(2)=$O(^ABMDBILL(DUZ(2))) Q:'+DUZ(2) D LOOP3P
Q
; *********************************************************************
;
LOOP3P ;
S DIC="^ABMDBILL(DUZ(2),"
S DIC(0)="XZ"
S X=BAR3PBIL
K DD,DO
D ^DIC
Q:Y<0
S BAR3PAT=$$GET1^DIQ(9002274.4,+Y,.05)
S BAR3DOS=$$SDT^BARDUTL($P($G(^ABMDBILL(DUZ(2),+Y,7)),U))
S BARCNT=$G(BARCNT)+1
S BARBILLS(BARCNT)=DUZ(2)_U_+Y_U_Y(0,0)_U_BAR3PAT_U_BAR3DOS
Q
; *********************************************************************
;
CHOOSE ;
K BARCNT
W !!,"The system has found more than one matching bill in 3PB.",!
S BAR1=0
F S BAR1=$O(BARBILLS(BAR1)) Q:'+BAR1 D
. S BARD=BARBILLS(BAR1)
. S BARCNT2=BAR1
. W !,BAR1,?5,$P(BARD,U,3),?30,$E($P(BARD,U,4),1,30),?62,$P(BARD,U,5)
K DIR
S DIR("A")="Please select one (enter the line #): "
S DIR(0)="NA^1:BARCNT2"
D ^DIR
Q:$D(DIRUT)
S BARCNT=Y
Q
; *********************************************************************
;
L2 ;
W !
S Y(0)=$G(^ABMDBILL(DUZ(2),Y,0))
S DA=+Y
S ABMA("BLNM")=$P(Y(0),U)
S ABMA("PTNM")=$P(Y(0),U,5)
S ABMA("VSLC")=$P(Y(0),U,3)
D BLNM^ABMAPASS
S BARBLNM=ABMA("BLNM")
W !,BARBLNM,!
K DIR
S DIR("A")=" Correct"
S DIR("B")="YES"
S DIR(0)="Y"
D ^DIR
K DIR
Q:Y'=1
; -------------------------------
;
; always reload A/R Bill items from 3P
I $D(^BARBL(BARDUZ2,"B",BARBLNM)) D Q:Y'=1
.W !!,*7,"This bill has already been uploaded to A/R!"
.W !,*7,"Do you really want to Reload it from 3P? "
.W !!
.S DIR("B")="YES"
.S DIR(0)="Y"
.D ^DIR
.K DIR
S BARSTAT=$$GET1^DIQ(9002274.4,DA,.04)
W !!,"Uploading "_BARBLNM_" ..."
D EXT^ABMAPASS
W "Done."
Q
BARPMUP1 ; IHS/SD/LSL - MANUAL UPLOAD PROCESS JAN 15,1997 ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
+2 ;
+3 ; IHS/SD/LSL - 12/12/02 - V1.7 - NHA-0601-180049
+4 ; Find the right bill in 3PB.
+5 ;
+6 ; *********************************************************************
+7 ;** Manual upload process for a single 3p bill
+8 ; *********************************************************************
+9 ;
ONE ;EP
+1 NEW DIC,BARDA,BARSTAT
+2 ; -------------------------------
+3 ;
SELSAT ; checking for satellite selection
+1 KILL BARQUIT
+2 WRITE !,"Please pick the satellite you wish to load",!
+3 SET DIC=$$DIC^XBDIQ1(90052.05)
+4 SET DA(1)=DUZ(2)
+5 SET DIC(0)="AEQMZ"
+6 DO ^DIC
+7 IF Y'>0
WRITE !,"NONE PICKED",!
QUIT
+8 SET BARDUZ2=DUZ(2)
+9 FOR
DO SELSATE
IF $DATA(DIRUT)
QUIT
+10 SET DUZ(2)=BARDUZ2
+11 KILL BARDUZ2
+12 QUIT
+13 ; *********************************************************************
+14 ;
SELSATE ;
+1 NEW BARBILLS,BAR3PBIL,BARCNT,BAR3PAT,BASR3DOS,Y
+2 WRITE !!
+3 KILL DIR
+4 SET DIR("A")="Select 3P Bill: "
+5 SET DIR(0)="FA^2:8"
+6 DO ^DIR
+7 IF $DATA(DIRUT)
QUIT
+8 SET BAR3PBIL=Y
+9 DO FINDBILL
+10 IF '$DATA(BARBILLS)
WRITE " Bill not found in 3PB."
QUIT
+11 IF +$GET(BARCNT)>1
DO CHOOSE
+12 IF '+$GET(BARCNT)
QUIT
+13 SET Y=$PIECE(BARBILLS(BARCNT),U,2)
+14 SET DUZ(2)=$PIECE(BARBILLS(BARCNT),U)
+15 DO L2
IF +Y<0
QUIT
+16 QUIT
+17 ; *********************************************************************
+18 ;
FINDBILL ;
+1 KILL BARCNT,BARBILLS
+2 NEW BAR3PAT,BAR3DOS
+3 SET DUZ(2)=0
+4 FOR
SET DUZ(2)=$ORDER(^ABMDBILL(DUZ(2)))
IF '+DUZ(2)
QUIT
DO LOOP3P
+5 QUIT
+6 ; *********************************************************************
+7 ;
LOOP3P ;
+1 SET DIC="^ABMDBILL(DUZ(2),"
+2 SET DIC(0)="XZ"
+3 SET X=BAR3PBIL
+4 KILL DD,DO
+5 DO ^DIC
+6 IF Y<0
QUIT
+7 SET BAR3PAT=$$GET1^DIQ(9002274.4,+Y,.05)
+8 SET BAR3DOS=$$SDT^BARDUTL($PIECE($GET(^ABMDBILL(DUZ(2),+Y,7)),U))
+9 SET BARCNT=$GET(BARCNT)+1
+10 SET BARBILLS(BARCNT)=DUZ(2)_U_+Y_U_Y(0,0)_U_BAR3PAT_U_BAR3DOS
+11 QUIT
+12 ; *********************************************************************
+13 ;
CHOOSE ;
+1 KILL BARCNT
+2 WRITE !!,"The system has found more than one matching bill in 3PB.",!
+3 SET BAR1=0
+4 FOR
SET BAR1=$ORDER(BARBILLS(BAR1))
IF '+BAR1
QUIT
Begin DoDot:1
+5 SET BARD=BARBILLS(BAR1)
+6 SET BARCNT2=BAR1
+7 WRITE !,BAR1,?5,$PIECE(BARD,U,3),?30,$EXTRACT($PIECE(BARD,U,4),1,30),?62,$PIECE(BARD,U,5)
End DoDot:1
+8 KILL DIR
+9 SET DIR("A")="Please select one (enter the line #): "
+10 SET DIR(0)="NA^1:BARCNT2"
+11 DO ^DIR
+12 IF $DATA(DIRUT)
QUIT
+13 SET BARCNT=Y
+14 QUIT
+15 ; *********************************************************************
+16 ;
L2 ;
+1 WRITE !
+2 SET Y(0)=$GET(^ABMDBILL(DUZ(2),Y,0))
+3 SET DA=+Y
+4 SET ABMA("BLNM")=$PIECE(Y(0),U)
+5 SET ABMA("PTNM")=$PIECE(Y(0),U,5)
+6 SET ABMA("VSLC")=$PIECE(Y(0),U,3)
+7 DO BLNM^ABMAPASS
+8 SET BARBLNM=ABMA("BLNM")
+9 WRITE !,BARBLNM,!
+10 KILL DIR
+11 SET DIR("A")=" Correct"
+12 SET DIR("B")="YES"
+13 SET DIR(0)="Y"
+14 DO ^DIR
+15 KILL DIR
+16 IF Y'=1
QUIT
+17 ; -------------------------------
+18 ;
+19 ; always reload A/R Bill items from 3P
+20 IF $DATA(^BARBL(BARDUZ2,"B",BARBLNM))
Begin DoDot:1
+21 WRITE !!,*7,"This bill has already been uploaded to A/R!"
+22 WRITE !,*7,"Do you really want to Reload it from 3P? "
+23 WRITE !!
+24 SET DIR("B")="YES"
+25 SET DIR(0)="Y"
+26 DO ^DIR
+27 KILL DIR
End DoDot:1
IF Y'=1
QUIT
+28 SET BARSTAT=$$GET1^DIQ(9002274.4,DA,.04)
+29 WRITE !!,"Uploading "_BARBLNM_" ..."
+30 DO EXT^ABMAPASS
+31 WRITE "Done."
+32 QUIT
