PSAVER1 ;BIR/JMB-Verify Invoices - CONT'D ;7/23/97
;;3.0;DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**33,60,65,71,78**;10/24/97;Build 4
;This routine allows the user to edit processed invoices by selecting
;the invoice's line item number. If there are no errors after editing
;the line item is verified.
;
;References to global ^DIC(51.5 are covered by IA #1931
;References to global ^PSDRUG( are covered by IA #2095
;
EDIT W @IOF,!?18,"<<< EDIT INVOICES TO BE VERIFIED SCREEN >>>",!!?2,"Choose the invoices from the list you want to edit.",!,PSASLN
S (PSA,PSACNT,PSASTOP)=0,PSATMP="" F S PSA=+$O(PSAEDIT(PSA)) Q:'PSA D Q:PSASTOP
.I $Y+5>IOSL D HEADER Q:PSASTOP
.S PSAIEN=$P(PSAEDIT(PSA),"^"),PSAIEN1=$P(PSAEDIT(PSA),"^",2),PSAORD=$P(^PSD(58.811,PSAIEN,0),"^")
.S PSAINV=$P(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^"),PSAINVDT=+$P(^(0),"^",2),PSACNT=PSACNT+1
.W !?2,PSA_".",?6,"Order#: "_PSAORD_" Invoice#: "_PSAINV_" Invoice Date: "_$$FMTE^XLFDT(PSAINVDT)
K PSASTOP W !,PSASLN
S DIR(0)="LO^1:"_PSACNT,DIR("A")="Select invoices to edit",DIR("?",1)="Enter the number to the left of the invoice",DIR("?")="data to be verified or a range of numbers.",DIR("??")="^D SELHELP^PSAVER"
W ! D ^DIR K DIR Q:$G(DIRUT)
S PSASEL=Y
;
SEL ;Select line items to be edit
K PSAVBKG S PSATMP=""
F PSAPC=1:1 S PSA=$P(PSASEL,",",PSAPC) Q:'PSA D CORR Q:PSAOUT
I $O(PSAVBKG(0)) D
.;K ZTSAVE S ZTDESC="Drug Acct. - Verify Prime Vendor Invoices",ZTIO="",ZTDTH=$H,ZTRTN="^PSAVER6",ZTSAVE("PSAVBKG(")="" D ^%ZTLOAD
.D ^PSAVER6
Q
;
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,!?18,"<<< EDIT INVOICES TO BE VERIFIED SCREEN >>>",!!,PSASLN
Q
;
CORR N PSASEL1 S PSASEL1=PSASEL N PSASEL ;;<*65 RJS
I $D(^PSD(58.811,"ASTAT","L")) D LCKCHK^PSAVER4
S PSAIEN=$P(PSAEDIT(PSA),"^"),PSAIEN1=$P(PSAEDIT(PSA),"^",2),PSASEL=PSA ;;*65 RJS>
S PSAMSG="" D VERLOCK^PSAVER4 ; <== PSA*3*60 (RJS-VMP)
I $L(PSAMSG) D Q
.D HDR W !,?5,PSAMSG,! S DIR(0)="E" D ^DIR K DIR S PSASEL=PSASEL1 K PSALOCK(PSA),PSASEL1
S PSAIN=^PSD(58.811,PSAIEN,1,PSAIEN1,0),PSAINV=$P(^(0),"^"),PSAINVDT=$P(^(0),"^",2),PSAORD=$P(^PSD(58.811,PSAIEN,0),"^")
D HDR,RECD^PSAVER2 D:PSAOUT
.I PSAOUT D VERUNLCK^PSAVER4 W !,"** The invoice's status has not been changed to Verified!"
I $G(PSAOUT)!$G(DUOUT) S PSAOUT=0,PSASEL=PSASEL1 K PSALOCK(PSA),PSASEL1 Q
S PSALOC=+$P(PSAIN,"^",5),PSAMV=+$P(PSAIN,"^",12)
I PSALOC!($P(PSAIN,"^",8)="S")!($P(PSAIN,"^",8)="N") D Q:PSAOUT
.D SITES^PSAUTL1 S PSALOCN=$S($G(PSALOC)'>0:"UNKNOWN",1:$P(^PSD(58.8,PSALOC,0),"^"))_PSACOMB
.W:$L(PSALOCN)>76 !!,$P(PSALOCN,"(IP)",1)_"(IP)",!?17,$P(PSALOCN,"(IP)",2) W:$L(PSALOCN)<77 !!,PSALOCN
.S DR=4 D PHARM^PSAVER2
I PSAMV!($P(PSAIN,"^",8)="S")!($P(PSAIN,"^",8)="A") W !!,$P($G(^PSD(58.8,PSAMV,0)),"^") S DR=13 D PHARM^PSAVER2
I X="" D VERUNLCK^PSAVER4 W !,"** The invoice's status has not been changed to Verified!" S PSAOUT=0,PSASEL=PSASEL1 K PSALOCK(PSA),PSASEL1 Q
;
LINES F W ! S DIC="^PSD(58.811,"_PSAIEN_",1,"_PSAIEN1_",1,",DA(2)=PSAIEN,DA(1)=PSAIEN1,DIC(0)="QAEMZ",DIC("A")="Select Line#: " D ^DIC K DIC D Q:PSAOUT
.I $G(DTOUT)!($G(DUOUT))!(Y<1) S PSAOUT=1 Q
.S PSALINE=+Y,PSALINEN=$P(Y,"^",2)
.I '$D(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0)) W !,"Invalid line number." Q
.S PSADATA=^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0),PSASUP=0
.S PSANDC=$P(PSADATA,"^",11),PSAVSN=$P(PSADATA,"^",12),PSALOC=$S(+$P(PSADATA,"^",10):+$P(PSAIN,"^",12),1:+$P(PSAIN,"^",5))
VIEW .D HDR,VERDISP^PSAUTL4 W PSASLN,!
.W "1. Drug",!,"2. Quantity Received",!,"3. Order Unit",!,"4. Dispense Units per Order Unit",! S PSACHO=4
.I $P($G(^PSD(58.8,PSALOC,0)),"^",14) W "5. Stock Level",!,"6. Reorder Level",! S PSACHO=6
.S DIR(0)="LO^1:"_PSACHO,DIR("A")="Edit fields",DIR("?")="Enter the number(s) of the data to be edited" S DIR("??")="^D DDQOR^PSAVER3"
.D ^DIR K DIR I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q
.Q:Y="" S PSAFLDS=Y,PSASET=0 D HDR,VERDISP^PSAUTL4 W PSASLN
FIELDS .F PSAPCF=1:1 S PSAFLD=$P(PSAFLDS,",",PSAPCF) Q:'PSAFLD!(PSAOUT) D
..I PSAFLD=1 D ASKDRUG^PSAVER2 Q
..I PSAFLD=2 D QTY^PSAVER2 Q
..I PSAFLD=3 D OU^PSAVER2 Q
..I PSAFLD=4,'PSASET S PSA50IEN=PSADRG D DUOU^PSAVER2 Q
..I PSAFLD=5 D STOCK^PSAVER2 Q
..I PSAFLD=6 D REORDER^PSAVER2
;<== PSA*3*60 (RJS-VMP)
;Determines if the invoice's status should be changed to verified. If
;so, the status is changed and the new drugs to the location is listed.
W ! S DIR(0)="Y",DIR("A")="Do you want to change the invoice's status to Verified",DIR("?",1)="Enter YES to change the invoice's status to Verified.",DIR("?")="Enter NO to keep the invoice's status as Processed."
S DIR("??")="^D CHGYN^PSAVER1" D ^DIR K DIR ;D:'Y VERUNLCK^PSAVER4
I $G(DIRUT)!('Y) D VERUNLCK^PSAVER4 W !,"** The invoice's status has not been changed to Verified!" S (PSAOUT,PSACHG)=0,PSASEL=PSASEL1 K PSALOCK(PSA),PSASEL1 Q
S PSACHG=Y,PSAVBKG(PSAIEN,PSAIEN1)=""
;==> PSA*3*60 (RJS-VMP)
;Looks to see if all line items are processed.
PROCESS S (PSACS,PSAERR,PSALINE,PSALINES,PSALNCNT,PSALNSU,PSAOUT,PSASUP)=0
S PSAIN=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,0)),PSAORD=$P($G(^PSD(58.811,PSAIEN,0)),"^")
F S PSALINE=$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE)) Q:'PSALINE!(PSAOUT) D
.S PSADATA=^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0),PSALNERR=0,PSALNCNT=PSALNCNT+1
.D SETLINE^PSAVER3 I PSAOUT D VERUNLCK^PSAVER4 W !,"** The invoice's status has not been changed to Verified!" S (PSAOUT,PSACHG)=0,PSASEL=PSASEL1 K PSALOCK(PSA),PSASEL1 Q
.S:'+$G(PSALNERR) PSALINES=PSALINES+1 S PSADATA=^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0)
.S:+$P(PSADATA,"^",10) PSACS=PSACS+1
;
CHECK I PSALNCNT'=PSALINES D Q
.K PSAHOLD(PSALOC,PSAIEN,PSAIEN1) W !!,"** The invoice has not been placed in a Verified status!"
.D END^PSAPROC D:+$G(PSAERR) PRINT^PSAVER3
.D VERUNLCK^PSAVER4 S PSASEL=PSASEL1 K PSALOCK(PSA),PSASEL1,PSAVBKG(PSAIEN,PSAIEN1) Q ;;<*65 RJS>
I +PSALNCNT,PSALNCNT=PSACS D
.S $P(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^",8)="A" W !,"All drugs on the invoice are marked as a controlled substance."
.D:'+$P($G(^PSD(58.811,PSAIEN,1,PSAIEN1,0)),"^",12) MASTER^PSAVER5
I PSACS,PSALNCNT'=PSACS S $P(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^",8)="S" D:'$P($G(^PSD(58.811,PSAIEN,1,PSAIEN1,0)),"^",5) GETLOC^PSAVER5
I 'PSACS S $P(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^",8)="N" D:'$P($G(^PSD(58.811,PSAIEN,1,PSAIEN1,0)),"^",5) GETLOC^PSAVER5
I +PSALNCNT,PSALNCNT=PSALINES D Q
.D CHG
.I PSALNCNT=PSASUP S $P(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^",13)=1 Q
.S $P(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^",13)=0
D END^PSAPROC D:+$G(PSAERR) PRINT^PSAVER3
Q
;<== PSA*3*60 (RJS-VMP)
CHG D STATUS^PSAVER3,NEWDRUG
W !!,"The invoice status has been changed to Verified!"
S PSARTN1=1
Q
;
NEWDRUG ;If this invoice will add new drugs to location/vault, store in an
;array the location/vault and drug name to be printed later.
K PSALND,PSALN0,PSALNP,PSALNV
S PSALINE=0,PSAPHARM=+$P($G(^PSD(58.811,PSAIEN,1,PSAIEN1,0)),"^",5),PSAMV=$P($G(^(0)),"^",12)
Q:'PSALOC
F S PSALINE=$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE)) Q:'PSALINE D
.S PSALN0=+$P($G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0)),"^",2),PSALOC=$S($P($G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0)),"^",10):PSAMV,1:PSAPHARM)
.I $O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"D",0)) D
..S PSADJ=$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"D",0))
..Q:'$D(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0))
..S PSALNP=+$P(PSADJ,"^",2),PSALNV=+$P(PSADJ,"^",6)
.S PSADD=$S($G(PSALNV):PSALNV,$G(PSALNP):PSALNP,PSALN0:PSALN0,1:0)
.I PSADD,'$D(^PSD(58.8,PSALOC,1,PSADD,0)) S PSANEWD(PSALOC,$S($P($G(^PSDRUG(PSADD,0)),"^")'="":$P($G(^PSDRUG(PSADD,0)),"^"),1:"UNKNOWN"))=PSADD
Q
;
HDR ;Header for screen that displays invoice data to be edited.
W @IOF,!?18,"<<< EDIT INVOICES TO BE VERIFIED SCREEN >>>"
W !!,"Order#: "_PSAORD_" Invoice#: "_PSAINV_" Invoice Date: "_$$FMTE^XLFDT(PSAINVDT),!,PSASLN,!
Q
;
CHGYN ;Extended help for 'Do you want to change the invoice's status to Verified'
W !?5,"Enter YES if the invoice is completely correct. You will not be able",!?5,"to edit it again."
W !!?5,"Enter NO if you need to edit the invoice again. You can edit it again",!?5,"by selecting the Verify Orders option."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSAVER1 8340 printed Sep 23, 2025@19:27:04 Page 2
PSAVER1 ;BIR/JMB-Verify Invoices - CONT'D ;7/23/97
+1 ;;3.0;DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**33,60,65,71,78**;10/24/97;Build 4
+2 ;This routine allows the user to edit processed invoices by selecting
+3 ;the invoice's line item number. If there are no errors after editing
+4 ;the line item is verified.
+5 ;
+6 ;References to global ^DIC(51.5 are covered by IA #1931
+7 ;References to global ^PSDRUG( are covered by IA #2095
+8 ;
EDIT WRITE @IOF,!?18,"<<< EDIT INVOICES TO BE VERIFIED SCREEN >>>",!!?2,"Choose the invoices from the list you want to edit.",!,PSASLN
+1 SET (PSA,PSACNT,PSASTOP)=0
SET PSATMP=""
FOR
SET PSA=+$ORDER(PSAEDIT(PSA))
if 'PSA
QUIT
Begin DoDot:1
+2 IF $Y+5>IOSL
DO HEADER
if PSASTOP
QUIT
+3 SET PSAIEN=$PIECE(PSAEDIT(PSA),"^")
SET PSAIEN1=$PIECE(PSAEDIT(PSA),"^",2)
SET PSAORD=$PIECE(^PSD(58.811,PSAIEN,0),"^")
+4 SET PSAINV=$PIECE(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^")
SET PSAINVDT=+$PIECE(^(0),"^",2)
SET PSACNT=PSACNT+1
+5 WRITE !?2,PSA_".",?6,"Order#: "_PSAORD_" Invoice#: "_PSAINV_" Invoice Date: "_$$FMTE^XLFDT(PSAINVDT)
End DoDot:1
if PSASTOP
QUIT
+6 KILL PSASTOP
WRITE !,PSASLN
+7 SET DIR(0)="LO^1:"_PSACNT
SET DIR("A")="Select invoices to edit"
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 SELHELP^PSAVER"
+8 WRITE !
DO ^DIR
KILL DIR
if $GET(DIRUT)
QUIT
+9 SET PSASEL=Y
+10 ;
SEL ;Select line items to be edit
+1 KILL PSAVBKG
SET PSATMP=""
+2 FOR PSAPC=1:1
SET PSA=$PIECE(PSASEL,",",PSAPC)
if 'PSA
QUIT
DO CORR
if PSAOUT
QUIT
+3 IF $ORDER(PSAVBKG(0))
Begin DoDot:1
+4 ;K ZTSAVE S ZTDESC="Drug Acct. - Verify Prime Vendor Invoices",ZTIO="",ZTDTH=$H,ZTRTN="^PSAVER6",ZTSAVE("PSAVBKG(")="" D ^%ZTLOAD
+5 DO ^PSAVER6
End DoDot:1
+6 QUIT
+7 ;
+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,!?18,"<<< EDIT INVOICES TO BE VERIFIED SCREEN >>>",!!,PSASLN
+4 QUIT
+5 ;
CORR ;;<*65 RJS
NEW PSASEL1
SET PSASEL1=PSASEL
NEW PSASEL
+1 IF $DATA(^PSD(58.811,"ASTAT","L"))
DO LCKCHK^PSAVER4
+2 ;;*65 RJS>
SET PSAIEN=$PIECE(PSAEDIT(PSA),"^")
SET PSAIEN1=$PIECE(PSAEDIT(PSA),"^",2)
SET PSASEL=PSA
+3 ; <== PSA*3*60 (RJS-VMP)
SET PSAMSG=""
DO VERLOCK^PSAVER4
+4 IF $LENGTH(PSAMSG)
Begin DoDot:1
+5 DO HDR
WRITE !,?5,PSAMSG,!
SET DIR(0)="E"
DO ^DIR
KILL DIR
SET PSASEL=PSASEL1
KILL PSALOCK(PSA),PSASEL1
End DoDot:1
QUIT
+6 SET PSAIN=^PSD(58.811,PSAIEN,1,PSAIEN1,0)
SET PSAINV=$PIECE(^(0),"^")
SET PSAINVDT=$PIECE(^(0),"^",2)
SET PSAORD=$PIECE(^PSD(58.811,PSAIEN,0),"^")
+7 DO HDR
DO RECD^PSAVER2
if PSAOUT
Begin DoDot:1
+8 IF PSAOUT
DO VERUNLCK^PSAVER4
WRITE !,"** The invoice's status has not been changed to Verified!"
End DoDot:1
+9 IF $GET(PSAOUT)!$GET(DUOUT)
SET PSAOUT=0
SET PSASEL=PSASEL1
KILL PSALOCK(PSA),PSASEL1
QUIT
+10 SET PSALOC=+$PIECE(PSAIN,"^",5)
SET PSAMV=+$PIECE(PSAIN,"^",12)
+11 IF PSALOC!($PIECE(PSAIN,"^",8)="S")!($PIECE(PSAIN,"^",8)="N")
Begin DoDot:1
+12 DO SITES^PSAUTL1
SET PSALOCN=$SELECT($GET(PSALOC)'>0:"UNKNOWN",1:$PIECE(^PSD(58.8,PSALOC,0),"^"))_PSACOMB
+13 if $LENGTH(PSALOCN)>76
WRITE !!,$PIECE(PSALOCN,"(IP)",1)_"(IP)",!?17,$PIECE(PSALOCN,"(IP)",2)
if $LENGTH(PSALOCN)<77
WRITE !!,PSALOCN
+14 SET DR=4
DO PHARM^PSAVER2
End DoDot:1
if PSAOUT
QUIT
+15 IF PSAMV!($PIECE(PSAIN,"^",8)="S")!($PIECE(PSAIN,"^",8)="A")
WRITE !!,$PIECE($GET(^PSD(58.8,PSAMV,0)),"^")
SET DR=13
DO PHARM^PSAVER2
+16 IF X=""
DO VERUNLCK^PSAVER4
WRITE !,"** The invoice's status has not been changed to Verified!"
SET PSAOUT=0
SET PSASEL=PSASEL1
KILL PSALOCK(PSA),PSASEL1
QUIT
+17 ;
LINES FOR
WRITE !
SET DIC="^PSD(58.811,"_PSAIEN_",1,"_PSAIEN1_",1,"
SET DA(2)=PSAIEN
SET DA(1)=PSAIEN1
SET DIC(0)="QAEMZ"
SET DIC("A")="Select Line#: "
DO ^DIC
KILL DIC
Begin DoDot:1
+1 IF $GET(DTOUT)!($GET(DUOUT))!(Y<1)
SET PSAOUT=1
QUIT
+2 SET PSALINE=+Y
SET PSALINEN=$PIECE(Y,"^",2)
+3 IF '$DATA(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0))
WRITE !,"Invalid line number."
QUIT
+4 SET PSADATA=^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0)
SET PSASUP=0
+5 SET PSANDC=$PIECE(PSADATA,"^",11)
SET PSAVSN=$PIECE(PSADATA,"^",12)
SET PSALOC=$SELECT(+$PIECE(PSADATA,"^",10):+$PIECE(PSAIN,"^",12),1:+$PIECE(PSAIN,"^",5))
VIEW DO HDR
DO VERDISP^PSAUTL4
WRITE PSASLN,!
+1 WRITE "1. Drug",!,"2. Quantity Received",!,"3. Order Unit",!,"4. Dispense Units per Order Unit",!
SET PSACHO=4
+2 IF $PIECE($GET(^PSD(58.8,PSALOC,0)),"^",14)
WRITE "5. Stock Level",!,"6. Reorder Level",!
SET PSACHO=6
+3 SET DIR(0)="LO^1:"_PSACHO
SET DIR("A")="Edit fields"
SET DIR("?")="Enter the number(s) of the data to be edited"
SET DIR("??")="^D DDQOR^PSAVER3"
+4 DO ^DIR
KILL DIR
IF $GET(DTOUT)!($GET(DUOUT))
SET PSAOUT=1
QUIT
+5 if Y=""
QUIT
SET PSAFLDS=Y
SET PSASET=0
DO HDR
DO VERDISP^PSAUTL4
WRITE PSASLN
FIELDS FOR PSAPCF=1:1
SET PSAFLD=$PIECE(PSAFLDS,",",PSAPCF)
if 'PSAFLD!(PSAOUT)
QUIT
Begin DoDot:2
+1 IF PSAFLD=1
DO ASKDRUG^PSAVER2
QUIT
+2 IF PSAFLD=2
DO QTY^PSAVER2
QUIT
+3 IF PSAFLD=3
DO OU^PSAVER2
QUIT
+4 IF PSAFLD=4
IF 'PSASET
SET PSA50IEN=PSADRG
DO DUOU^PSAVER2
QUIT
+5 IF PSAFLD=5
DO STOCK^PSAVER2
QUIT
+6 IF PSAFLD=6
DO REORDER^PSAVER2
End DoDot:2
End DoDot:1
if PSAOUT
QUIT
+7 ;<== PSA*3*60 (RJS-VMP)
+8 ;Determines if the invoice's status should be changed to verified. If
+9 ;so, the status is changed and the new drugs to the location is listed.
+10 WRITE !
SET DIR(0)="Y"
SET DIR("A")="Do you want to change the invoice's status to Verified"
SET DIR("?",1)="Enter YES to change the invoice's status to Verified."
SET DIR("?")="Enter NO to keep the invoice's status as Processed."
+11 ;D:'Y VERUNLCK^PSAVER4
SET DIR("??")="^D CHGYN^PSAVER1"
DO ^DIR
KILL DIR
+12 IF $GET(DIRUT)!('Y)
DO VERUNLCK^PSAVER4
WRITE !,"** The invoice's status has not been changed to Verified!"
SET (PSAOUT,PSACHG)=0
SET PSASEL=PSASEL1
KILL PSALOCK(PSA),PSASEL1
QUIT
+13 SET PSACHG=Y
SET PSAVBKG(PSAIEN,PSAIEN1)=""
+14 ;==> PSA*3*60 (RJS-VMP)
+15 ;Looks to see if all line items are processed.
PROCESS SET (PSACS,PSAERR,PSALINE,PSALINES,PSALNCNT,PSALNSU,PSAOUT,PSASUP)=0
+1 SET PSAIN=$GET(^PSD(58.811,PSAIEN,1,PSAIEN1,0))
SET PSAORD=$PIECE($GET(^PSD(58.811,PSAIEN,0)),"^")
+2 FOR
SET PSALINE=$ORDER(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE))
if 'PSALINE!(PSAOUT)
QUIT
Begin DoDot:1
+3 SET PSADATA=^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0)
SET PSALNERR=0
SET PSALNCNT=PSALNCNT+1
+4 DO SETLINE^PSAVER3
IF PSAOUT
DO VERUNLCK^PSAVER4
WRITE !,"** The invoice's status has not been changed to Verified!"
SET (PSAOUT,PSACHG)=0
SET PSASEL=PSASEL1
KILL PSALOCK(PSA),PSASEL1
QUIT
+5 if '+$GET(PSALNERR)
SET PSALINES=PSALINES+1
SET PSADATA=^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0)
+6 if +$PIECE(PSADATA,"^",10)
SET PSACS=PSACS+1
End DoDot:1
+7 ;
CHECK IF PSALNCNT'=PSALINES
Begin DoDot:1
+1 KILL PSAHOLD(PSALOC,PSAIEN,PSAIEN1)
WRITE !!,"** The invoice has not been placed in a Verified status!"
+2 DO END^PSAPROC
if +$GET(PSAERR)
DO PRINT^PSAVER3
+3 ;;<*65 RJS>
DO VERUNLCK^PSAVER4
SET PSASEL=PSASEL1
KILL PSALOCK(PSA),PSASEL1,PSAVBKG(PSAIEN,PSAIEN1)
QUIT
End DoDot:1
QUIT
+4 IF +PSALNCNT
IF PSALNCNT=PSACS
Begin DoDot:1
+5 SET $PIECE(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^",8)="A"
WRITE !,"All drugs on the invoice are marked as a controlled substance."
+6 if '+$PIECE($GET(^PSD(58.811,PSAIEN,1,PSAIEN1,0)),"^",12)
DO MASTER^PSAVER5
End DoDot:1
+7 IF PSACS
IF PSALNCNT'=PSACS
SET $PIECE(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^",8)="S"
if '$PIECE($GET(^PSD(58.811,PSAIEN,1,PSAIEN1,0)),"^",5)
DO GETLOC^PSAVER5
+8 IF 'PSACS
SET $PIECE(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^",8)="N"
if '$PIECE($GET(^PSD(58.811,PSAIEN,1,PSAIEN1,0)),"^",5)
DO GETLOC^PSAVER5
+9 IF +PSALNCNT
IF PSALNCNT=PSALINES
Begin DoDot:1
+10 DO CHG
+11 IF PSALNCNT=PSASUP
SET $PIECE(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^",13)=1
QUIT
+12 SET $PIECE(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^",13)=0
End DoDot:1
QUIT
+13 DO END^PSAPROC
if +$GET(PSAERR)
DO PRINT^PSAVER3
+14 QUIT
+15 ;<== PSA*3*60 (RJS-VMP)
CHG DO STATUS^PSAVER3
DO NEWDRUG
+1 WRITE !!,"The invoice status has been changed to Verified!"
+2 SET PSARTN1=1
+3 QUIT
+4 ;
NEWDRUG ;If this invoice will add new drugs to location/vault, store in an
+1 ;array the location/vault and drug name to be printed later.
+2 KILL PSALND,PSALN0,PSALNP,PSALNV
+3 SET PSALINE=0
SET PSAPHARM=+$PIECE($GET(^PSD(58.811,PSAIEN,1,PSAIEN1,0)),"^",5)
SET PSAMV=$PIECE($GET(^(0)),"^",12)
+4 if 'PSALOC
QUIT
+5 FOR
SET PSALINE=$ORDER(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE))
if 'PSALINE
QUIT
Begin DoDot:1
+6 SET PSALN0=+$PIECE($GET(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0)),"^",2)
SET PSALOC=$SELECT($PIECE($GET(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0)),"^",10):PSAMV,1:PSAPHARM)
+7 IF $ORDER(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"D",0))
Begin DoDot:2
+8 SET PSADJ=$ORDER(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"D",0))
+9 if '$DATA(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0))
QUIT
+10 SET PSALNP=+$PIECE(PSADJ,"^",2)
SET PSALNV=+$PIECE(PSADJ,"^",6)
End DoDot:2
+11 SET PSADD=$SELECT($GET(PSALNV):PSALNV,$GET(PSALNP):PSALNP,PSALN0:PSALN0,1:0)
+12 IF PSADD
IF '$DATA(^PSD(58.8,PSALOC,1,PSADD,0))
SET PSANEWD(PSALOC,$SELECT($PIECE($GET(^PSDRUG(PSADD,0)),"^")'="":$PIECE($GET(^PSDRUG(PSADD,0)),"^"),1:"UNKNOWN"))=PSADD
End DoDot:1
+13 QUIT
+14 ;
HDR ;Header for screen that displays invoice data to be edited.
+1 WRITE @IOF,!?18,"<<< EDIT INVOICES TO BE VERIFIED SCREEN >>>"
+2 WRITE !!,"Order#: "_PSAORD_" Invoice#: "_PSAINV_" Invoice Date: "_$$FMTE^XLFDT(PSAINVDT),!,PSASLN,!
+3 QUIT
+4 ;
CHGYN ;Extended help for 'Do you want to change the invoice's status to Verified'
+1 WRITE !?5,"Enter YES if the invoice is completely correct. You will not be able",!?5,"to edit it again."
+2 WRITE !!?5,"Enter NO if you need to edit the invoice again. You can edit it again",!?5,"by selecting the Verify Orders option."
+3 QUIT
