Routine: BARPMUP1

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

 ; *********************************************************************

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

 ; *********************************************************************

FINDBILL ;

 K BARCNT,BARBILLS

 N BAR3PAT,BAR3DOS

 S DUZ(2)=0

 F  S DUZ(2)=$O(^ABMDBILL(DUZ(2)))  Q:'+DUZ(2)  D LOOP3P

 ; *********************************************************************

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

 ; *********************************************************************

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

 ; *********************************************************************

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."

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

BARPMUP1.m