PSAVER ;BIR/JMB-Verify Invoices ;9/6/97
 ;;3.0;DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**60,65,71,78**;10/24/97;Build 4
 ;This routine allows the user to verify processed invoices. The entire
 ;invoice may be verified with/without editing. After verification, the
 ;pharmacy location or master vault balances are incremented during a
 ;background job (PSAVER5).
 ;
 I '$D(^XUSEC("PSA ORDERS",DUZ)) W !,"You do not hold the key to enter the option." Q
 I $D(^PSD(58.811,"ASTAT","L")) D LCKCHK^PSAVER4
 I '$D(^PSD(58.811,"ASTAT","P")) W !!,"There are no invoices that need to be verified." H 1 Q
 ;
 ;Creates a list of invoices that can be verified by the user. If the
 ;invoice contains at least one item marked as a controlled substance,
 ;the user must have the pharmacist key before it can be verified.
 S (PSACNT,PSAIEN,PSASUP)=0
 F  S PSAIEN=+$O(^PSD(58.811,"ASTAT","P",PSAIEN)) Q:'PSAIEN  D
 .Q:'$D(^PSD(58.811,PSAIEN,0))
 .S PSAIEN1=0 F  S PSAIEN1=+$O(^PSD(58.811,"ASTAT","P",PSAIEN,PSAIEN1)) Q:'PSAIEN1  D
 ..Q:'$D(^PSD(58.811,PSAIEN,1,PSAIEN1,0))
 ..I $P(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^",10)'=DUZ,$P(^(0),"^",8)="N"!(($P(^(0),"^",8)="S"!($P(^(0),"^",8)="A"))&($D(^XUSEC("PSJ RPHARM",DUZ)))) S PSACNT=PSACNT+1,PSAVER(PSACNT)=PSAIEN_"^"_PSAIEN1
 I 'PSACNT D  H 1 G EXIT
 .W !!,"There is at least one invoice that needs to be verified. However, invoices",!,"cannot be verified by the same person who processed them and a pharmacist",!,"must verify invoices that contain a drug marked as a controlled substance."
 .W !!,"There are no invoices you can verify because the invoice(s) meet one of the",!,"above conditions."
 ;
ESIG D SIG^XUSESIG G:X1="" EXIT S PSAOUT=0
 ;
PRINT ;Asks & prints all invoices the user can verify.
 W ! S DIR(0)="Y",DIR("B")="N",DIR("A")="Print processed invoices",DIR("?",1)="Enter YES to print all invoices you can verify then begin verification.",DIR("?")="Enter NO to bypass printing the invoices and begin verification."
 S DIR("??")="^D PRINTYN^PSAVER"
 D ^DIR K DIR G:$G(DIRUT) EXIT G:'Y ENTIRE
 W ! S %ZIS="Q" D ^%ZIS G:POP ENTIRE
 I $D(IO("Q")) D  G ENTIRE
 .K ZTSAVE
 .S ZTDESC="Drug Acct. - Print Prime Vendor Invoices",ZTDTH=$H,ZTRTN="PRTINV^PSAVER",ZTSAVE("PSAVER(")="" D ^%ZTLOAD
 D PRTINV
 ;
ENTIRE ;Displays a list of all invoices the user can select to be verified.
 S PSASLN="",$P(PSASLN,"-",80)="",PSADLN="",$P(PSADLN,"=",80)=""
 W @IOF,!?21,"<<< VERIFY ENTIRE INVOICE SCREEN >>>"
 W !!?2,"If there are no corrections, you can change the invoices' status",!?2,"to ""Verified"" by selecting them from the list. If you do have"
 W !?2,"corrections, press the return key then a second list will be",!?2,"displayed. You will be able to choose the invoices from that list",!?2,"and enter corrections.",!!?2,"Choose the invoices from the list you want to verify.",!,PSADLN
 S (PSA,PSACNT,PSASTOP)=0
 F  S PSA=+$O(PSAVER(PSA)) Q:'PSA  D  Q:PSASTOP
 .I $Y+5>IOSL D HDR Q:PSASTOP
 .S PSAIEN=$P(PSAVER(PSA),"^"),PSAIEN1=$P(PSAVER(PSA),"^",2),PSAORD=$P(^PSD(58.811,PSAIEN,0),"^"),PSAINV=$P(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^"),PSAINVDT=+$P(^(0),"^",2),PSACNT=PSACNT+1
 .W !?(3-$L(PSA)),PSA_".  Order#: "_PSAORD_"  Invoice#: "_PSAINV_"  Invoice Date: "_$$FMTE^XLFDT(PSAINVDT)
 K PSASTOP W !,PSADLN
 S DIR(0)="LO^1:"_PSACNT,DIR("A")="Select invoices to verify",DIR("?",1)="Enter the number to the left of the invoice",DIR("?")="data to be verified or a range of numbers.",DIR("??")="^D SEL^PSAVER"
 W ! D ^DIR K DIR G:$G(DTOUT)!($G(DUOUT)) EXIT
 I Y="",$D(^PSD(58.811,"ASTAT","L")) D LCKCHK^PSAVER4,LOAD G EDIT
 I Y="",'$D(^PSD(58.811,"ASTAT","L")) D LOAD G EDIT
 S PSASEL=Y
 ;
OKAY ;Verifies correct invoices were selected.
 W @IOF,!?21,"<<< VERIFY ENTIRE INVOICE SCREEN >>>",!,PSADLN,!
 S PSACNT=0,PSATMP="" F PSAPC=1:1 S PSA=+$P(PSASEL,",",PSAPC) Q:'PSA  D
 .S PSAIEN=$P(PSAVER(PSA),"^"),PSAIEN1=$P(PSAVER(PSA),"^",2)
 .Q:'$D(^PSD(58.811,PSAIEN,1,PSAIEN1,0))
 .S PSAIN=^PSD(58.811,PSAIEN,1,PSAIEN1,0)
 .S PSAORD=$P(^PSD(58.811,PSAIEN,0),"^"),PSAINV=$P(PSAIN,"^"),PSAINVDT=+$P(PSAIN,"^",2),PSACNT=PSACNT+1
 .W !?(3-$L(PSACNT)),PSACNT_".  Order#: "_PSAORD_"  Invoice#: "_PSAINV_"  Invoice Date: "_$$FMTE^XLFDT(PSAINVDT)
 .I +$P(PSAIN,"^",5) D
 ..S PSALOC=+$P(PSAIN,"^",5) D SITES^PSAUTL1 S PSALOCN=$P(^PSD(58.8,PSALOC,0),"^")_PSACOMB
 ..W:$L(PSALOCN)>76 !?6,$P(PSALOCN,"(IP)",1)_"(IP)",!?23,$P(PSALOCN,"(IP)",2) W:$L(PSALOCN)<77 !?6,PSALOCN
 .I +$P(PSAIN,"^",12) W !?6,"MASTER VAULT: "_$P(^PSD(58.8,+$P(PSAIN,"^",12),0),"^")
 .W !
 .S PSAMSG="" D VERLOCK^PSAVER4 ; <== PSA*3*60 (RJS-VMP)
 .W:$L(PSAMSG) ?5,PSAMSG,!
 I PSASEL'=PSATMP S PSASEL=PSATMP K PSATMP
 I PSASEL="" S DIR(0)="E" D ^DIR G:$G(DIRUT) EXIT G ENTIRE
 S DIR(0)="Y",DIR("B")="N",DIR("A")="Are you sure "_$S(PSACNT=1:"this invoice's",1:"these invoices'")_" status should be changed to Verified"
 S DIR("?",1)="Enter YES if the list contains invoices with no corrections.",DIR("?",2)="Enter NO if the list contains at least one invoice you do not",DIR("?")="want to verify.",DIR("??")="^D VERIFY^PSAVER"
 D ^DIR K DIR D:'Y VERUNLCK^PSAVER4 G:$G(DIRUT) EXIT G:'Y ENTIRE ; <== PSA*3*60 (RJS-VMP)
 ;
 ;Send entire invoices to be verified in background, delete these
 ;invoices from the list, then create a new list of remaining invoices
 ;to be verified.
BKGJOB K PSAVBKG W ! F PSAPC=1:1 S PSA=+$P(PSASEL,",",PSAPC) Q:'PSA!(PSAOUT)  D
 .S PSAIEN=$P(PSAVER(PSA),"^"),PSAIEN1=$P(PSAVER(PSA),"^",2),PSASUP=0
 .Q:'$D(^PSD(58.811,PSAIEN,1,PSAIEN1,0))!('$D(^PSD(58.811,PSAIEN,0)))
 .S (PSACS,PSAERR,PSALINE,PSALNCNT,PSALNERR,PSALNSU)=0
 .S PSAIN=^PSD(58.811,PSAIEN,1,PSAIEN1,0),PSAINV=$P(PSAIN,"^"),PSAORD=$P(^PSD(58.811,PSAIEN,0),"^")
 .F  S PSALINE=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE)) Q:'PSALINE!(PSAOUT)  D
 ..Q:'$D(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0))
 ..S PSADATA=^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0),PSALNCNT=PSALNCNT+1
 ..S PSALOC=$S(+$P(PSADATA,"^",10):$P(PSAIN,"^",12),1:$P(PSAIN,"^",5))
 ..W "." D SETLINE^PSAVER3
 .Q:PSAOUT
 .I '$O(PSANOVER(PSAIEN,PSAIEN1,0)) D  Q
 ..S PSAVBKG(PSAIEN,PSAIEN1)="" K PSAVER(PSA) D STATUS^PSAVER3
 ..I '+$P(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^",13),$P($G(^PSD(58.8,+$P(PSAIN,"^",5),0)),"^",14)!($P($G(^PSD(58.8,+$P(PSAIN,"^",12),0)),"^",14)) D NEWDRUG^PSAVER1 I 1 ;*50
 ..W !,"   Order# "_PSAORD_" Invoice# "_PSAINV_"'s status has been changed to Verified!"
 .H 1 I $O(PSANOVER(PSAIEN,PSAIEN1,0)) D
 ..W !,"** Order# "_PSAORD_" Invoice# "_PSAINV_"'s status has not been changed to Verified."
 ..S PSAERR=0,PSAVER(PSA)=PSAIEN_"^"_PSAIEN1
 ..D PRINT^PSAVER3
 ..N PSATMP S PSATMP=PSASEL ;;<*65 RJS
 ..N PSASEL S PSASEL=PSA
 ..D VERUNLCK^PSAVER4  ;;*65 RJS>
 ..S PSAOUT=0
 ;
 ;If the invoices selected are error free, send them to the background
 ;job to complete the invoice and increment inventory.
 I $D(^PSD(58.811,"ASTAT","L")) D LCKCHK^PSAVER4
 D LOAD
 I $O(PSAVBKG(0)) D
 . K ZTSAVE S ZTDESC="Drug Acct. - Verify Prime Vendor Invoices",ZTIO="",ZTDTH=$H,ZTRTN="^PSAVER6",ZTSAVE("PSASEL")="",ZTSAVE("PSAVBKG(")="" D ^%ZTLOAD Q:$G(POP)
 ;D ^PSAVER6
 K PSAVBKG G:'$O(PSAEDIT(0)) EXIT
EDIT S PSARTN1=0
 D EDIT^PSAVER1
 ;
EXIT I $O(PSANEWD(0)) D ^PSAVER4 S PSARTN1=0
 I $G(PSARTN1) D END^PSAPROC
 K %ZIS,DA,DD,DIC,DIE,DIK,DIR,DIRUT,DO,DR,DTOUT,DUOUT,PSA,PSA10,PSAGAIN,PSA50IEN,PSAA,PSABEFOR,PSACHG,PSACHO,PSACNT,PSACOMB,PSACS,PSACSLN,PSACTRL
 K PSADATA,PSADD,PSADJ,PSADJD,PSADJFLD,PSADJN,PSADJO,PSADJOP,PSADJOV,PSADJP,PSADJPP,PSADJPV,PSADJQ,PSADJQP,PSADJQV,PSADJSUP,PSADLN,PSADRG
 K PSADRGN,PSADUOU,PSAEDIT,PSAERR,PSAFLD,PSAFLDS,PSAHOLD,PSAIEN,PSAIEN1,PSAIN,PSAINV,PSAINVDT,PSAISIT,PSAISITN,PSAKK,PSAL,PSALEN,PSALINE,PSALINEN
 K PSALINES,PSALN,PSALN0,PSALNCNT,PSALND,PSALNERR,PSALNP,PSALNSU,PSALNV,PSALOAD,PSALOC,PSALOCA,PSALOCN,PSAMENU,PSAMV,PSAMVA,PSAMVIEN,PSAMVN,PSAN10,PSANAME,PSANDC,PSANEW,PSANEWD
 K PSANO,PSANODE,PSANOVER,PSANUM,PSAONE,PSAONEMV,PSAORD,PSAORDU,PSAPHARM,PSAPRICE,PSAOSIT,PSAOSITN,PSAOU,PSAOUT,PSAPC,PSAPCF,PSAPCL,PSAPG,PSAPRINT,PSAQTY,PSALOCK,PSAMSG
 K PSAREA,PSAREC,PSARECD,PSAREORD,PSASAVE,PSASEL,PSASET,PSASLN,PSASTOCK,PSASUB,PSASUP,PSASUPP,PSATAB,PSATEMP,PSAUPC,PSAVAULT,PSAVBKG,PSAVER,PSAVSN,PSAOU,PSATMP,PSALCK
 K PSASS,X,X1,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,PSARTN1
 Q
 ;
HDR ;Header with screen hold
 S PSASS=21-$Y F PSAKK=1:1:PSASS W !
 S DIR(0)="E" D ^DIR K DIR I $G(DIRUT) S PSASTOP=1 Q
 W @IOF,!?21,"<<< VERIFY ENTIRE INVOICE SCREEN >>>",!!,PSADLN
 Q
LOAD ;Loads invoices to be edited into an array
 K PSAEDIT S (PSALOAD,PSACNT)=0
 F  S PSALOAD=+$O(PSAVER(PSALOAD)) Q:'PSALOAD  S PSACNT=PSACNT+1,PSAEDIT(PSACNT)=PSAVER(PSALOAD)
 K PSAVER
 Q
 ;
PRTINV ;Sends invoices to printer
 S (PSA,PSAOUT)=0 F  S PSA=+$O(PSAVER(PSA)) Q:'PSA!(PSAOUT)  D
 .S PSAORD=$P(PSAVER(PSA),"^"),PSAINV=$P(PSAVER(PSA),"^",2) D ^PSAORDP1
 D ^%ZISC
 Q
 ;
SEL ;Extended help to 'Select invoices'
 W !?5,"Enter the number to the left of the invoice data that you want to verify.",!?5,"The invoices' statuses will be changed to Verified."
 Q
SELHELP ;Extended help for 'Select invoices to verify'
 W !?5,"Enter the number to the left of the invoice data you want to verify.",!?5,"The line items will be displayed for you to select the ones you want"
 W !?5,"to correct."
 Q
PRINTYN ;Extended help for 'Print invoices?'
 W !?5,"Enter YES to print all of the processed invoices you can verify.",!?5,"Enter NO to bypass printing the invoices and continue with verification."
 Q
VERIFY ;Extended help for 'Are you sure...'
 W !!?5,"Enter YES if the list contains invoices to be verified.",!!?5,"Enter NO if the list contains at least one invoice that should not be"
 W !?5,"verified. You will be returned to the original list so you can choose",!?5,"the invoices to be verified again."
 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSAVER   9794     printed  Sep 23, 2025@19:27:03                                                                                                                                                                                                      Page 2
PSAVER    ;BIR/JMB-Verify Invoices ;9/6/97
 +1       ;;3.0;DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**60,65,71,78**;10/24/97;Build 4
 +2       ;This routine allows the user to verify processed invoices. The entire
 +3       ;invoice may be verified with/without editing. After verification, the
 +4       ;pharmacy location or master vault balances are incremented during a
 +5       ;background job (PSAVER5).
 +6       ;
 +7        IF '$DATA(^XUSEC("PSA ORDERS",DUZ))
               WRITE !,"You do not hold the key to enter the option."
               QUIT 
 +8        IF $DATA(^PSD(58.811,"ASTAT","L"))
               DO LCKCHK^PSAVER4
 +9        IF '$DATA(^PSD(58.811,"ASTAT","P"))
               WRITE !!,"There are no invoices that need to be verified."
               HANG 1
               QUIT 
 +10      ;
 +11      ;Creates a list of invoices that can be verified by the user. If the
 +12      ;invoice contains at least one item marked as a controlled substance,
 +13      ;the user must have the pharmacist key before it can be verified.
 +14       SET (PSACNT,PSAIEN,PSASUP)=0
 +15       FOR 
               SET PSAIEN=+$ORDER(^PSD(58.811,"ASTAT","P",PSAIEN))
               if 'PSAIEN
                   QUIT 
               Begin DoDot:1
 +16               if '$DATA(^PSD(58.811,PSAIEN,0))
                       QUIT 
 +17               SET PSAIEN1=0
                   FOR 
                       SET PSAIEN1=+$ORDER(^PSD(58.811,"ASTAT","P",PSAIEN,PSAIEN1))
                       if 'PSAIEN1
                           QUIT 
                       Begin DoDot:2
 +18                       if '$DATA(^PSD(58.811,PSAIEN,1,PSAIEN1,0))
                               QUIT 
 +19                       IF $PIECE(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^",10)'=DUZ
                               IF $PIECE(^(0),"^",8)="N"!(($PIECE(^(0),"^",8)="S"!($PIECE(^(0),"^",8)="A"))&($DATA(^XUSEC("PSJ RPHARM",DUZ))))
                                   SET PSACNT=PSACNT+1
                                   SET PSAVER(PSACNT)=PSAIEN_"^"_PSAIEN1
                       End DoDot:2
               End DoDot:1
 +20       IF 'PSACNT
               Begin DoDot:1
 +21               WRITE !!,"There is at least one invoice that needs to be verified. However, invoices",!,"cannot be verified by the same person who processed them and a pharmacist",!,"must verify invoices that contain a drug marked as a controlled subst
ance."
 +22               WRITE !!,"There are no invoices you can verify because the invoice(s) meet one of the",!,"above conditions."
               End DoDot:1
               HANG 1
               GOTO EXIT
 +23      ;
ESIG       DO SIG^XUSESIG
           if X1=""
               GOTO EXIT
           SET PSAOUT=0
 +1       ;
PRINT     ;Asks & prints all invoices the user can verify.
 +1        WRITE !
           SET DIR(0)="Y"
           SET DIR("B")="N"
           SET DIR("A")="Print processed invoices"
           SET DIR("?",1)="Enter YES to print all invoices you can verify then begin verification."
           SET DIR("?")="Enter NO to bypass printing the invoices and begin verification."
 +2        SET DIR("??")="^D PRINTYN^PSAVER"
 +3        DO ^DIR
           KILL DIR
           if $GET(DIRUT)
               GOTO EXIT
           if 'Y
               GOTO ENTIRE
 +4        WRITE !
           SET %ZIS="Q"
           DO ^%ZIS
           if POP
               GOTO ENTIRE
 +5        IF $DATA(IO("Q"))
               Begin DoDot:1
 +6                KILL ZTSAVE
 +7                SET ZTDESC="Drug Acct. - Print Prime Vendor Invoices"
                   SET ZTDTH=$HOROLOG
                   SET ZTRTN="PRTINV^PSAVER"
                   SET ZTSAVE("PSAVER(")=""
                   DO ^%ZTLOAD
               End DoDot:1
               GOTO ENTIRE
 +8        DO PRTINV
 +9       ;
ENTIRE    ;Displays a list of all invoices the user can select to be verified.
 +1        SET PSASLN=""
           SET $PIECE(PSASLN,"-",80)=""
           SET PSADLN=""
           SET $PIECE(PSADLN,"=",80)=""
 +2        WRITE @IOF,!?21,"<<< VERIFY ENTIRE INVOICE SCREEN >>>"
 +3        WRITE !!?2,"If there are no corrections, you can change the invoices' status",!?2,"to ""Verified"" by selecting them from the list. If you do have"
 +4        WRITE !?2,"corrections, press the return key then a second list will be",!?2,"displayed. You will be able to choose the invoices from that list",!?2,"and enter corrections.",!!?2,"Choose the invoices from the list you want to verify.",!,PSADLN
 +5        SET (PSA,PSACNT,PSASTOP)=0
 +6        FOR 
               SET PSA=+$ORDER(PSAVER(PSA))
               if 'PSA
                   QUIT 
               Begin DoDot:1
 +7                IF $Y+5>IOSL
                       DO HDR
                       if PSASTOP
                           QUIT 
 +8                SET PSAIEN=$PIECE(PSAVER(PSA),"^")
                   SET PSAIEN1=$PIECE(PSAVER(PSA),"^",2)
                   SET PSAORD=$PIECE(^PSD(58.811,PSAIEN,0),"^")
                   SET PSAINV=$PIECE(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^")
                   SET PSAINVDT=+$PIECE(^(0),"^",2)
                   SET PSACNT=PSACNT+1
 +9                WRITE !?(3-$LENGTH(PSA)),PSA_".  Order#: "_PSAORD_"  Invoice#: "_PSAINV_"  Invoice Date: "_$$FMTE^XLFDT(PSAINVDT)
               End DoDot:1
               if PSASTOP
                   QUIT 
 +10       KILL PSASTOP
           WRITE !,PSADLN
 +11       SET DIR(0)="LO^1:"_PSACNT
           SET DIR("A")="Select invoices to verify"
           SET DIR("?",1)="Enter the number to the left of the invoice"
           SET DIR("?")="data to be verified or a range of numbers."
           SET DIR("??")="^D SEL^PSAVER"
 +12       WRITE !
           DO ^DIR
           KILL DIR
           if $GET(DTOUT)!($GET(DUOUT))
               GOTO EXIT
 +13       IF Y=""
               IF $DATA(^PSD(58.811,"ASTAT","L"))
                   DO LCKCHK^PSAVER4
                   DO LOAD
                   GOTO EDIT
 +14       IF Y=""
               IF '$DATA(^PSD(58.811,"ASTAT","L"))
                   DO LOAD
                   GOTO EDIT
 +15       SET PSASEL=Y
 +16      ;
OKAY      ;Verifies correct invoices were selected.
 +1        WRITE @IOF,!?21,"<<< VERIFY ENTIRE INVOICE SCREEN >>>",!,PSADLN,!
 +2        SET PSACNT=0
           SET PSATMP=""
           FOR PSAPC=1:1
               SET PSA=+$PIECE(PSASEL,",",PSAPC)
               if 'PSA
                   QUIT 
               Begin DoDot:1
 +3                SET PSAIEN=$PIECE(PSAVER(PSA),"^")
                   SET PSAIEN1=$PIECE(PSAVER(PSA),"^",2)
 +4                if '$DATA(^PSD(58.811,PSAIEN,1,PSAIEN1,0))
                       QUIT 
 +5                SET PSAIN=^PSD(58.811,PSAIEN,1,PSAIEN1,0)
 +6                SET PSAORD=$PIECE(^PSD(58.811,PSAIEN,0),"^")
                   SET PSAINV=$PIECE(PSAIN,"^")
                   SET PSAINVDT=+$PIECE(PSAIN,"^",2)
                   SET PSACNT=PSACNT+1
 +7                WRITE !?(3-$LENGTH(PSACNT)),PSACNT_".  Order#: "_PSAORD_"  Invoice#: "_PSAINV_"  Invoice Date: "_$$FMTE^XLFDT(PSAINVDT)
 +8                IF +$PIECE(PSAIN,"^",5)
                       Begin DoDot:2
 +9                        SET PSALOC=+$PIECE(PSAIN,"^",5)
                           DO SITES^PSAUTL1
                           SET PSALOCN=$PIECE(^PSD(58.8,PSALOC,0),"^")_PSACOMB
 +10                       if $LENGTH(PSALOCN)>76
                               WRITE !?6,$PIECE(PSALOCN,"(IP)",1)_"(IP)",!?23,$PIECE(PSALOCN,"(IP)",2)
                           if $LENGTH(PSALOCN)<77
                               WRITE !?6,PSALOCN
                       End DoDot:2
 +11               IF +$PIECE(PSAIN,"^",12)
                       WRITE !?6,"MASTER VAULT: "_$PIECE(^PSD(58.8,+$PIECE(PSAIN,"^",12),0),"^")
 +12               WRITE !
 +13      ; <== PSA*3*60 (RJS-VMP)
                   SET PSAMSG=""
                   DO VERLOCK^PSAVER4
 +14               if $LENGTH(PSAMSG)
                       WRITE ?5,PSAMSG,!
               End DoDot:1
 +15       IF PSASEL'=PSATMP
               SET PSASEL=PSATMP
               KILL PSATMP
 +16       IF PSASEL=""
               SET DIR(0)="E"
               DO ^DIR
               if $GET(DIRUT)
                   GOTO EXIT
               GOTO ENTIRE
 +17       SET DIR(0)="Y"
           SET DIR("B")="N"
           SET DIR("A")="Are you sure "_$SELECT(PSACNT=1:"this invoice's",1:"these invoices'")_" status should be changed to Verified"
 +18       SET DIR("?",1)="Enter YES if the list contains invoices with no corrections."
           SET DIR("?",2)="Enter NO if the list contains at least one invoice you do not"
           SET DIR("?")="want to verify."
           SET DIR("??")="^D VERIFY^PSAVER"
 +19      ; <== PSA*3*60 (RJS-VMP)
           DO ^DIR
           KILL DIR
           if 'Y
               DO VERUNLCK^PSAVER4
           if $GET(DIRUT)
               GOTO EXIT
           if 'Y
               GOTO ENTIRE
 +20      ;
 +21      ;Send entire invoices to be verified in background, delete these
 +22      ;invoices from the list, then create a new list of remaining invoices
 +23      ;to be verified.
BKGJOB     KILL PSAVBKG
           WRITE !
           FOR PSAPC=1:1
               SET PSA=+$PIECE(PSASEL,",",PSAPC)
               if 'PSA!(PSAOUT)
                   QUIT 
               Begin DoDot:1
 +1                SET PSAIEN=$PIECE(PSAVER(PSA),"^")
                   SET PSAIEN1=$PIECE(PSAVER(PSA),"^",2)
                   SET PSASUP=0
 +2                if '$DATA(^PSD(58.811,PSAIEN,1,PSAIEN1,0))!('$DATA(^PSD(58.811,PSAIEN,0)))
                       QUIT 
 +3                SET (PSACS,PSAERR,PSALINE,PSALNCNT,PSALNERR,PSALNSU)=0
 +4                SET PSAIN=^PSD(58.811,PSAIEN,1,PSAIEN1,0)
                   SET PSAINV=$PIECE(PSAIN,"^")
                   SET PSAORD=$PIECE(^PSD(58.811,PSAIEN,0),"^")
 +5                FOR 
                       SET PSALINE=+$ORDER(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE))
                       if 'PSALINE!(PSAOUT)
                           QUIT 
                       Begin DoDot:2
 +6                        if '$DATA(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0))
                               QUIT 
 +7                        SET PSADATA=^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0)
                           SET PSALNCNT=PSALNCNT+1
 +8                        SET PSALOC=$SELECT(+$PIECE(PSADATA,"^",10):$PIECE(PSAIN,"^",12),1:$PIECE(PSAIN,"^",5))
 +9                        WRITE "."
                           DO SETLINE^PSAVER3
                       End DoDot:2
 +10               if PSAOUT
                       QUIT 
 +11               IF '$ORDER(PSANOVER(PSAIEN,PSAIEN1,0))
                       Begin DoDot:2
 +12                       SET PSAVBKG(PSAIEN,PSAIEN1)=""
                           KILL PSAVER(PSA)
                           DO STATUS^PSAVER3
 +13      ;*50
                           IF '+$PIECE(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^",13)
                               IF $PIECE($GET(^PSD(58.8,+$PIECE(PSAIN,"^",5),0)),"^",14)!($PIECE($GET(^PSD(58.8,+$PIECE(PSAIN,"^",12),0)),"^",14))
                                   DO NEWDRUG^PSAVER1
                                   IF 1
 +14                       WRITE !,"   Order# "_PSAORD_" Invoice# "_PSAINV_"'s status has been changed to Verified!"
                       End DoDot:2
                       QUIT 
 +15               HANG 1
                   IF $ORDER(PSANOVER(PSAIEN,PSAIEN1,0))
                       Begin DoDot:2
 +16                       WRITE !,"** Order# "_PSAORD_" Invoice# "_PSAINV_"'s status has not been changed to Verified."
 +17                       SET PSAERR=0
                           SET PSAVER(PSA)=PSAIEN_"^"_PSAIEN1
 +18                       DO PRINT^PSAVER3
 +19      ;;<*65 RJS
                           NEW PSATMP
                           SET PSATMP=PSASEL
 +20                       NEW PSASEL
                           SET PSASEL=PSA
 +21      ;;*65 RJS>
                           DO VERUNLCK^PSAVER4
 +22                       SET PSAOUT=0
                       End DoDot:2
               End DoDot:1
 +23      ;
 +24      ;If the invoices selected are error free, send them to the background
 +25      ;job to complete the invoice and increment inventory.
 +26       IF $DATA(^PSD(58.811,"ASTAT","L"))
               DO LCKCHK^PSAVER4
 +27       DO LOAD
 +28       IF $ORDER(PSAVBKG(0))
               Begin DoDot:1
 +29               KILL ZTSAVE
                   SET ZTDESC="Drug Acct. - Verify Prime Vendor Invoices"
                   SET ZTIO=""
                   SET ZTDTH=$HOROLOG
                   SET ZTRTN="^PSAVER6"
                   SET ZTSAVE("PSASEL")=""
                   SET ZTSAVE("PSAVBKG(")=""
                   DO ^%ZTLOAD
                   if $GET(POP)
                       QUIT 
               End DoDot:1
 +30      ;D ^PSAVER6
 +31       KILL PSAVBKG
           if '$ORDER(PSAEDIT(0))
               GOTO EXIT
EDIT       SET PSARTN1=0
 +1        DO EDIT^PSAVER1
 +2       ;
EXIT       IF $ORDER(PSANEWD(0))
               DO ^PSAVER4
               SET PSARTN1=0
 +1        IF $GET(PSARTN1)
               DO END^PSAPROC
 +2        KILL %ZIS,DA,DD,DIC,DIE,DIK,DIR,DIRUT,DO,DR,DTOUT,DUOUT,PSA,PSA10,PSAGAIN,PSA50IEN,PSAA,PSABEFOR,PSACHG,PSACHO,PSACNT,PSACOMB,PSACS,PSACSLN,PSACTRL
 +3        KILL PSADATA,PSADD,PSADJ,PSADJD,PSADJFLD,PSADJN,PSADJO,PSADJOP,PSADJOV,PSADJP,PSADJPP,PSADJPV,PSADJQ,PSADJQP,PSADJQV,PSADJSUP,PSADLN,PSADRG
 +4        KILL PSADRGN,PSADUOU,PSAEDIT,PSAERR,PSAFLD,PSAFLDS,PSAHOLD,PSAIEN,PSAIEN1,PSAIN,PSAINV,PSAINVDT,PSAISIT,PSAISITN,PSAKK,PSAL,PSALEN,PSALINE,PSALINEN
 +5        KILL PSALINES,PSALN,PSALN0,PSALNCNT,PSALND,PSALNERR,PSALNP,PSALNSU,PSALNV,PSALOAD,PSALOC,PSALOCA,PSALOCN,PSAMENU,PSAMV,PSAMVA,PSAMVIEN,PSAMVN,PSAN10,PSANAME,PSANDC,PSANEW,PSANEWD
 +6        KILL PSANO,PSANODE,PSANOVER,PSANUM,PSAONE,PSAONEMV,PSAORD,PSAORDU,PSAPHARM,PSAPRICE,PSAOSIT,PSAOSITN,PSAOU,PSAOUT,PSAPC,PSAPCF,PSAPCL,PSAPG,PSAPRINT,PSAQTY,PSALOCK,PSAMSG
 +7        KILL PSAREA,PSAREC,PSARECD,PSAREORD,PSASAVE,PSASEL,PSASET,PSASLN,PSASTOCK,PSASUB,PSASUP,PSASUPP,PSATAB,PSATEMP,PSAUPC,PSAVAULT,PSAVBKG,PSAVER,PSAVSN,PSAOU,PSATMP,PSALCK
 +8        KILL PSASS,X,X1,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,PSARTN1
 +9        QUIT 
 +10      ;
HDR       ;Header with screen hold
 +1        SET PSASS=21-$Y
           FOR PSAKK=1:1:PSASS
               WRITE !
 +2        SET DIR(0)="E"
           DO ^DIR
           KILL DIR
           IF $GET(DIRUT)
               SET PSASTOP=1
               QUIT 
 +3        WRITE @IOF,!?21,"<<< VERIFY ENTIRE INVOICE SCREEN >>>",!!,PSADLN
 +4        QUIT 
LOAD      ;Loads invoices to be edited into an array
 +1        KILL PSAEDIT
           SET (PSALOAD,PSACNT)=0
 +2        FOR 
               SET PSALOAD=+$ORDER(PSAVER(PSALOAD))
               if 'PSALOAD
                   QUIT 
               SET PSACNT=PSACNT+1
               SET PSAEDIT(PSACNT)=PSAVER(PSALOAD)
 +3        KILL PSAVER
 +4        QUIT 
 +5       ;
PRTINV    ;Sends invoices to printer
 +1        SET (PSA,PSAOUT)=0
           FOR 
               SET PSA=+$ORDER(PSAVER(PSA))
               if 'PSA!(PSAOUT)
                   QUIT 
               Begin DoDot:1
 +2                SET PSAORD=$PIECE(PSAVER(PSA),"^")
                   SET PSAINV=$PIECE(PSAVER(PSA),"^",2)
                   DO ^PSAORDP1
               End DoDot:1
 +3        DO ^%ZISC
 +4        QUIT 
 +5       ;
SEL       ;Extended help to 'Select invoices'
 +1        WRITE !?5,"Enter the number to the left of the invoice data that you want to verify.",!?5,"The invoices' statuses will be changed to Verified."
 +2        QUIT 
SELHELP   ;Extended help for 'Select invoices to verify'
 +1        WRITE !?5,"Enter the number to the left of the invoice data you want to verify.",!?5,"The line items will be displayed for you to select the ones you want"
 +2        WRITE !?5,"to correct."
 +3        QUIT 
PRINTYN   ;Extended help for 'Print invoices?'
 +1        WRITE !?5,"Enter YES to print all of the processed invoices you can verify.",!?5,"Enter NO to bypass printing the invoices and continue with verification."
 +2        QUIT 
VERIFY    ;Extended help for 'Are you sure...'
 +1        WRITE !!?5,"Enter YES if the list contains invoices to be verified.",!!?5,"Enter NO if the list contains at least one invoice that should not be"
 +2        WRITE !?5,"verified. You will be returned to the original list so you can choose",!?5,"the invoices to be verified again."
 +3        QUIT