PSAVER4 ;;BIR/JMB-Verify Invoices - CONT'D ;9/8/97
;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**15,60,71**; 10/24/97;Build 10
;This routine prints the report of new drugs that will be added to
;each pharmacy location or master vault.
;
;Asks & prints all invoices the user can verify.
W @IOF,!,"The verified invoices contain new drugs for the assigned pharmacy location.",!,"A report will print by pharmacy location listing the new drugs. Use the"
W !,"Balance Adjustment option to enter an adjustment that reflects the total",!,"dispense units on hand for each new drug.",!!,"It is suggested that you send the report to a print."
K IO("Q") S %ZIS="Q" W !
D ^%ZIS I POP W !,"NO DEVICE SELECTED OR OUTPUT PRINTED!" Q
I $D(IO("Q")) D G QUIT
.N ZTSAVE,ZTIO,ZTRTN,ZTSAVE,ZTDTH,ZTSK
.S ZTDESC="Drug Acct. - Print New Drugs",ZTDTH=$H,ZTRTN="PRINT^PSAVER4"
.S ZTSAVE("PSANEWD(")="" D ^%ZTLOAD
;
PRINT ;Sends invoices to printer
S (PSALOC,PSAOUT)=0,PSAPG=1,PSADLN="",$P(PSADLN,"=",80)="",PSASLN="",$P(PSASLN,"-",80)=""
F S PSALOC=+$O(PSANEWD(PSALOC)) Q:'PSALOC!(PSAOUT) S PSADRGN=1 D HDR Q:PSAOUT D Q:PSAOUT
.F S PSADRGN=$O(PSANEWD(PSALOC,PSADRGN)) Q:PSADRGN=""!(PSAOUT) D:$Y+5>IOSL HDR Q:PSAOUT W !,PSADRGN,!,PSASLN,!
D:$E(IOST,1,2)="C-"&('PSAOUT) END^PSAPROC W:$E(IOST)'="C" @IOF
K PSANEWD(PSALOC)
QUIT D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" K IO("Q")
Q
;
HDR ;Prints the header to the New Drug Report on the screen & paper.
I $E(IOST,1,2)="C-" D:PSAPG'=1 END^PSAPROC Q:PSAOUT W @IOF,!?28,"<<< NEW DRUG REPORT >>>"
I $E(IOST)'="C" W:PSAPG'=1 @IOF W !?20,"DRUG ACCOUNTABILITY/INVENTORY INTERFACE",!?28,"<<< NEW DRUG REPORT >>>",?72,"Page "_PSAPG
I $P($G(^PSD(58.8,PSALOC,0)),"^",2)="M" W !?34,"MASTER VAULT",!!,$P($G(^PSD(58.8,PSALOC,0)),"^")
I $P($G(^PSD(58.8,PSALOC,0)),"^",2)="P" D
.D SITES^PSAUTL1 S PSALOCN=$P(^PSD(58.8,PSALOC,0),"^")_PSACOMB
.W !?31,"PHARMACY LOCATION",!!
.W:$L(PSALOCN)>76 $P(PSALOCN,"(IP)",1)_"(IP)",!?17,$P(PSALOCN,"(IP)",2) W:$L(PSALOCN)<77 PSALOCN
W !,PSADLN S PSAPG=PSAPG+1
Q
;
VERLOCK ;==> PSA*3*60 (RJS-VMP)Sets invoice's status to Verifying
N DIC,DA,DR,DIE
I '$D(^PSD(58.811,"ASTAT","V",PSAIEN,PSAIEN1)),'$D(^PSD(58.811,"ASTAT","P",PSAIEN,PSAIEN1)),$D(^PSD(58.811,"ASTAT","L",PSAIEN,PSAIEN1)) D Q
.S PSAMSG="**This Invoice is currently being Verified by another user"
I '$D(^PSD(58.811,"ASTAT","P",PSAIEN,PSAIEN1)),'$D(^PSD(58.811,"ASTAT","L",PSAIEN,PSAIEN1))&(($D(^PSD(58.811,"ASTAT","V",PSAIEN,PSAIEN1)))!($D(^PSD(58.811,"ASTAT","C",PSAIEN,PSAIEN1)))) D Q
.S PSAMSG="**This Invoice has already been Verified by another user"
F L +^PSD(58.811,PSAIEN,1,PSAIEN1,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
I '$D(^PSD(58.811,"ASTAT","L",PSAIEN,PSAIEN1)),'$D(^PSD(58.811,"ASTAT","V",PSAIEN,PSAIEN1)),$D(^PSD(58.811,"ASTAT","P",PSAIEN,PSAIEN1)) D
.S DA=PSAIEN1,DA(1)=PSAIEN,DIE="^PSD(58.811,"_DA(1)_",1,",DR="2///L;12////^S X="_DUZ
.D ^DIE
.S PSALOCK(PSA)=PSAIEN_"^"_PSAIEN1
.I PSATMP S PSATMP=PSATMP_","_PSA
.I 'PSATMP S PSATMP=PSA
L -^PSD(58.811,PSAIEN,1,PSAIEN1,0)
Q
;
VERUNLCK ; VERIFY CANCELED RESET INVOICE TO PROCESSED
N Y,PSAPC S PSACNT=0 F PSAPC=1:1 S PSA=+$P(PSASEL,",",PSAPC) Q:'PSA D
.S PSAIEN=$P(PSALOCK(PSA),"^"),PSAIEN1=$P(PSALOCK(PSA),"^",2)
.I $D(^PSD(58.811,"ASTAT","L",PSAIEN,PSAIEN1)) D
..N DIC,DA,DR,DIE
..F L +^PSD(58.811,PSAIEN,1,PSAIEN1,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
..S DA=PSAIEN1,DA(1)=PSAIEN,DIE="^PSD(58.811,"_DA(1)_",1,",DR="2///P;12////@" D ^DIE
..L -^PSD(58.811,PSAIEN,1,PSAIEN1,0)
Q ;<== PSA*3*?? (RJS-VMP)
;
LCKCHK ; CHECK FOR LOCKED INVOICES
I $D(^XTMP("PSALCK",DUZ)) D UNLCK ;; <*71 RJS >
N PSACT,PSACNT,PSAIEN,PSAIEN1,PSADUZ,PSASUP,PSALCHK,DUOUT S (PSACNT,PSAIEN)=0
F S PSAIEN=+$O(^PSD(58.811,"ASTAT","L",PSAIEN)) Q:'PSAIEN D
.Q:'$D(^PSD(58.811,PSAIEN,0))
.S PSAIEN1=0 F S PSAIEN1=+$O(^PSD(58.811,"ASTAT","L",PSAIEN,PSAIEN1)) Q:'PSAIEN1 D
..Q:'$D(^PSD(58.811,PSAIEN,1,PSAIEN1,0))!($P(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^",11)'=DUZ)
..S PSACNT=PSACNT+1,PSALCHK(PSACNT)=PSAIEN_"^"_PSAIEN1
Q:'$D(PSALCHK)
D MSG
S PSACT=0 F S PSACT=$O(PSALCHK(PSACT)) Q:'PSACT D
.S PSAIEN=$P(PSALCHK(PSACT),"^",1),PSAIEN1=$P(PSALCHK(PSACT),"^",2),PSACNT=PSACT
.W !,?3,PSACNT,".",?8,"Order#: ",$P(^PSD(58.811,PSAIEN,0),"^"),?35,"Invoice#: ",$P(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^")
W ! S DIR(0)="Y",DIR("A")="Do you want to reset the Order Status to PROCESSED",DIR("B")="NO" D ^DIR K DIR Q:'Y!($G(DUOUT))
I PSACNT=1 S PSAIEN=$P(PSALCHK(1),"^"),PSAIEN1=$P(PSALCHK(1),"^",2) D LCK1 Q
I PSACNT>1 D
.S DIR(0)="S^A:All;S:Selected"
.S DIR("A")="Which Orders"
.D ^DIR K DIR Q:'$D(Y)!($G(DUOUT))
I Y="S" D Q
.S DIR(0)="L^1:"_PSACNT D ^DIR K DIR Q:'Y!($G(DUOUT))
.N PSACNT,PSANUM,PSACNTR S PSANUM=Y K Y
.D LCK2 I $G(Y)=0 K Y Q
.F PSACNTR=1:1 S PSACNT=$P(PSANUM,",",PSACNTR) Q:'PSACNT D
..S PSAIEN=$P(PSALCHK(PSACNT),"^",1),PSAIEN1=$P(PSALCHK(PSACNT),"^",2) D LCK1
I Y="A" D
.D LCK2 I $G(Y)=0 K Y Q
.N PSACNT,PSACNTR
.S PSACNT=0 F S PSACNT=$O(PSALCHK(PSACNT)) Q:'PSACNT D
..S PSAIEN=$P(PSALCHK(PSACNT),"^",1),PSAIEN1=$P(PSALCHK(PSACNT),"^",2) D LCK1
Q
LCK1 ; RESET ORDER STATUS TO PROCESSED
W !,?5,"Order Status has been reset to PROCESSED for",!,?8,"Order#: ",$P(^PSD(58.811,PSAIEN,0),"^")," Invoice#: ",$P(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^")
N DIC,DA,DR,DIE
F L +^PSD(58.811,PSAIEN,1,PSAIEN1,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
S DA=PSAIEN1,DA(1)=PSAIEN,DIE="^PSD(58.811,"_DA(1)_",1,",DR="2///P;12////@" D ^DIE
L -^PSD(58.811,PSAIEN,1,PSAIEN1,0)
Q
LCK2 ; DOUBLE CHECK WITH USER BEFORE RESETTING INVOICE STATUS
S DIR(0)="Y",DIR("A")="Are you sure you want to change the Order Status to PROCESSED",DIR("B")="NO"
D ^DIR K DIR
Q
CLCK ; RESET ORDER STATUS TO COMPLETED <*71 RJS
W !,?5,"Order Status has been reset to COMPLETED for",!,?8,"Order#: ",$P(^PSD(58.811,PSAIEN,0),"^")," Invoice#: ",$P(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^"),!
N DIC,DA,DR,DIE
F L +^PSD(58.811,PSAIEN,1,PSAIEN1,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
S DA=PSAIEN1,DA(1)=PSAIEN,DIE="^PSD(58.811,"_DA(1)_",1,",DR="2///C" D ^DIE
L -^PSD(58.811,PSAIEN,1,PSAIEN1,0)
Q
UNLCK ; RESET ORDER STATUS TO PROCESSED
D MSG
N PSAIEN,PSAIEN1,DUOUT S PSAIEN=0
F S PSAIEN=$O(^XTMP("PSALCK",DUZ,PSAIEN)) Q:'PSAIEN D
.S PSAIEN1=0 F S PSAIEN1=$O(^XTMP("PSALCK",DUZ,PSAIEN,PSAIEN1)) Q:'PSAIEN1 D
..W !,?8,"Order#: ",$P(^PSD(58.811,PSAIEN,0),"^"),?35,"Invoice#: ",$P(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^"),?60,"LOCKED VERIFYING"
..N DIR
..S DIR(0)="S^P:RESET TO PROCESSED;C:MARK COMPLETED;S:SKIP"
..S DIR("A")="PROCESS OR COMPLETE"
..D ^DIR K DIR Q:'$D(Y)!($G(DUOUT))
..I Y="P" D LCK1 W ! Q
..I Y="C" D CLCK W ! Q
..I Y="S" W !!,?5,"Order#: ",$P(^PSD(58.811,PSAIEN,0),"^")," Invoice#: ",$P(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^")," HES BEEN SKIPPED",!
K ^XTMP("PSALCK",DUZ)
Q ;;*71 RJS >
MSG ; SHOW LOCK WARNING
W !!,?3,"The following Invoices currently have a status of LOCKED VERIFYING."
W !,?3,"These Invoices are either currently being Verified by you in another"
W !,?3,"session, or it may not have completed the Verify process correctly.",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSAVER4 7211 printed Sep 23, 2025@19:27:07 Page 2
PSAVER4 ;;BIR/JMB-Verify Invoices - CONT'D ;9/8/97
+1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**15,60,71**; 10/24/97;Build 10
+2 ;This routine prints the report of new drugs that will be added to
+3 ;each pharmacy location or master vault.
+4 ;
+5 ;Asks & prints all invoices the user can verify.
+6 WRITE @IOF,!,"The verified invoices contain new drugs for the assigned pharmacy location.",!,"A report will print by pharmacy location listing the new drugs. Use the"
+7 WRITE !,"Balance Adjustment option to enter an adjustment that reflects the total",!,"dispense units on hand for each new drug.",!!,"It is suggested that you send the report to a print."
+8 KILL IO("Q")
SET %ZIS="Q"
WRITE !
+9 DO ^%ZIS
IF POP
WRITE !,"NO DEVICE SELECTED OR OUTPUT PRINTED!"
QUIT
+10 IF $DATA(IO("Q"))
Begin DoDot:1
+11 NEW ZTSAVE,ZTIO,ZTRTN,ZTSAVE,ZTDTH,ZTSK
+12 SET ZTDESC="Drug Acct. - Print New Drugs"
SET ZTDTH=$HOROLOG
SET ZTRTN="PRINT^PSAVER4"
+13 SET ZTSAVE("PSANEWD(")=""
DO ^%ZTLOAD
End DoDot:1
GOTO QUIT
+14 ;
PRINT ;Sends invoices to printer
+1 SET (PSALOC,PSAOUT)=0
SET PSAPG=1
SET PSADLN=""
SET $PIECE(PSADLN,"=",80)=""
SET PSASLN=""
SET $PIECE(PSASLN,"-",80)=""
+2 FOR
SET PSALOC=+$ORDER(PSANEWD(PSALOC))
if 'PSALOC!(PSAOUT)
QUIT
SET PSADRGN=1
DO HDR
if PSAOUT
QUIT
Begin DoDot:1
+3 FOR
SET PSADRGN=$ORDER(PSANEWD(PSALOC,PSADRGN))
if PSADRGN=""!(PSAOUT)
QUIT
if $Y+5>IOSL
DO HDR
if PSAOUT
QUIT
WRITE !,PSADRGN,!,PSASLN,!
End DoDot:1
if PSAOUT
QUIT
+4 if $EXTRACT(IOST,1,2)="C-"&('PSAOUT)
DO END^PSAPROC
if $EXTRACT(IOST)'="C"
WRITE @IOF
+5 KILL PSANEWD(PSALOC)
QUIT DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
KILL IO("Q")
+1 QUIT
+2 ;
HDR ;Prints the header to the New Drug Report on the screen & paper.
+1 IF $EXTRACT(IOST,1,2)="C-"
if PSAPG'=1
DO END^PSAPROC
if PSAOUT
QUIT
WRITE @IOF,!?28,"<<< NEW DRUG REPORT >>>"
+2 IF $EXTRACT(IOST)'="C"
if PSAPG'=1
WRITE @IOF
WRITE !?20,"DRUG ACCOUNTABILITY/INVENTORY INTERFACE",!?28,"<<< NEW DRUG REPORT >>>",?72,"Page "_PSAPG
+3 IF $PIECE($GET(^PSD(58.8,PSALOC,0)),"^",2)="M"
WRITE !?34,"MASTER VAULT",!!,$PIECE($GET(^PSD(58.8,PSALOC,0)),"^")
+4 IF $PIECE($GET(^PSD(58.8,PSALOC,0)),"^",2)="P"
Begin DoDot:1
+5 DO SITES^PSAUTL1
SET PSALOCN=$PIECE(^PSD(58.8,PSALOC,0),"^")_PSACOMB
+6 WRITE !?31,"PHARMACY LOCATION",!!
+7 if $LENGTH(PSALOCN)>76
WRITE $PIECE(PSALOCN,"(IP)",1)_"(IP)",!?17,$PIECE(PSALOCN,"(IP)",2)
if $LENGTH(PSALOCN)<77
WRITE PSALOCN
End DoDot:1
+8 WRITE !,PSADLN
SET PSAPG=PSAPG+1
+9 QUIT
+10 ;
VERLOCK ;==> PSA*3*60 (RJS-VMP)Sets invoice's status to Verifying
+1 NEW DIC,DA,DR,DIE
+2 IF '$DATA(^PSD(58.811,"ASTAT","V",PSAIEN,PSAIEN1))
IF '$DATA(^PSD(58.811,"ASTAT","P",PSAIEN,PSAIEN1))
IF $DATA(^PSD(58.811,"ASTAT","L",PSAIEN,PSAIEN1))
Begin DoDot:1
+3 SET PSAMSG="**This Invoice is currently being Verified by another user"
End DoDot:1
QUIT
+4 IF '$DATA(^PSD(58.811,"ASTAT","P",PSAIEN,PSAIEN1))
IF '$DATA(^PSD(58.811,"ASTAT","L",PSAIEN,PSAIEN1))&(($DATA(^PSD(58.811,"ASTAT","V",PSAIEN,PSAIEN1)))!($DATA(^PSD(58.811,"ASTAT","C",PSAIEN,PSAIEN1))))
Begin DoDot:1
+5 SET PSAMSG="**This Invoice has already been Verified by another user"
End DoDot:1
QUIT
+6 FOR
LOCK +^PSD(58.811,PSAIEN,1,PSAIEN1,0):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
IF $TEST
QUIT
+7 IF '$DATA(^PSD(58.811,"ASTAT","L",PSAIEN,PSAIEN1))
IF '$DATA(^PSD(58.811,"ASTAT","V",PSAIEN,PSAIEN1))
IF $DATA(^PSD(58.811,"ASTAT","P",PSAIEN,PSAIEN1))
Begin DoDot:1
+8 SET DA=PSAIEN1
SET DA(1)=PSAIEN
SET DIE="^PSD(58.811,"_DA(1)_",1,"
SET DR="2///L;12////^S X="_DUZ
+9 DO ^DIE
+10 SET PSALOCK(PSA)=PSAIEN_"^"_PSAIEN1
+11 IF PSATMP
SET PSATMP=PSATMP_","_PSA
+12 IF 'PSATMP
SET PSATMP=PSA
End DoDot:1
+13 LOCK -^PSD(58.811,PSAIEN,1,PSAIEN1,0)
+14 QUIT
+15 ;
VERUNLCK ; VERIFY CANCELED RESET INVOICE TO PROCESSED
+1 NEW Y,PSAPC
SET PSACNT=0
FOR PSAPC=1:1
SET PSA=+$PIECE(PSASEL,",",PSAPC)
if 'PSA
QUIT
Begin DoDot:1
+2 SET PSAIEN=$PIECE(PSALOCK(PSA),"^")
SET PSAIEN1=$PIECE(PSALOCK(PSA),"^",2)
+3 IF $DATA(^PSD(58.811,"ASTAT","L",PSAIEN,PSAIEN1))
Begin DoDot:2
+4 NEW DIC,DA,DR,DIE
+5 FOR
LOCK +^PSD(58.811,PSAIEN,1,PSAIEN1,0):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
IF $TEST
QUIT
+6 SET DA=PSAIEN1
SET DA(1)=PSAIEN
SET DIE="^PSD(58.811,"_DA(1)_",1,"
SET DR="2///P;12////@"
DO ^DIE
+7 LOCK -^PSD(58.811,PSAIEN,1,PSAIEN1,0)
End DoDot:2
End DoDot:1
+8 ;<== PSA*3*?? (RJS-VMP)
QUIT
+9 ;
LCKCHK ; CHECK FOR LOCKED INVOICES
+1 ;; <*71 RJS >
IF $DATA(^XTMP("PSALCK",DUZ))
DO UNLCK
+2 NEW PSACT,PSACNT,PSAIEN,PSAIEN1,PSADUZ,PSASUP,PSALCHK,DUOUT
SET (PSACNT,PSAIEN)=0
+3 FOR
SET PSAIEN=+$ORDER(^PSD(58.811,"ASTAT","L",PSAIEN))
if 'PSAIEN
QUIT
Begin DoDot:1
+4 if '$DATA(^PSD(58.811,PSAIEN,0))
QUIT
+5 SET PSAIEN1=0
FOR
SET PSAIEN1=+$ORDER(^PSD(58.811,"ASTAT","L",PSAIEN,PSAIEN1))
if 'PSAIEN1
QUIT
Begin DoDot:2
+6 if '$DATA(^PSD(58.811,PSAIEN,1,PSAIEN1,0))!($PIECE(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^",11)'=DUZ)
QUIT
+7 SET PSACNT=PSACNT+1
SET PSALCHK(PSACNT)=PSAIEN_"^"_PSAIEN1
End DoDot:2
End DoDot:1
+8 if '$DATA(PSALCHK)
QUIT
+9 DO MSG
+10 SET PSACT=0
FOR
SET PSACT=$ORDER(PSALCHK(PSACT))
if 'PSACT
QUIT
Begin DoDot:1
+11 SET PSAIEN=$PIECE(PSALCHK(PSACT),"^",1)
SET PSAIEN1=$PIECE(PSALCHK(PSACT),"^",2)
SET PSACNT=PSACT
+12 WRITE !,?3,PSACNT,".",?8,"Order#: ",$PIECE(^PSD(58.811,PSAIEN,0),"^"),?35,"Invoice#: ",$PIECE(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^")
End DoDot:1
+13 WRITE !
SET DIR(0)="Y"
SET DIR("A")="Do you want to reset the Order Status to PROCESSED"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
if 'Y!($GET(DUOUT))
QUIT
+14 IF PSACNT=1
SET PSAIEN=$PIECE(PSALCHK(1),"^")
SET PSAIEN1=$PIECE(PSALCHK(1),"^",2)
DO LCK1
QUIT
+15 IF PSACNT>1
Begin DoDot:1
+16 SET DIR(0)="S^A:All;S:Selected"
+17 SET DIR("A")="Which Orders"
+18 DO ^DIR
KILL DIR
if '$DATA(Y)!($GET(DUOUT))
QUIT
End DoDot:1
+19 IF Y="S"
Begin DoDot:1
+20 SET DIR(0)="L^1:"_PSACNT
DO ^DIR
KILL DIR
if 'Y!($GET(DUOUT))
QUIT
+21 NEW PSACNT,PSANUM,PSACNTR
SET PSANUM=Y
KILL Y
+22 DO LCK2
IF $GET(Y)=0
KILL Y
QUIT
+23 FOR PSACNTR=1:1
SET PSACNT=$PIECE(PSANUM,",",PSACNTR)
if 'PSACNT
QUIT
Begin DoDot:2
+24 SET PSAIEN=$PIECE(PSALCHK(PSACNT),"^",1)
SET PSAIEN1=$PIECE(PSALCHK(PSACNT),"^",2)
DO LCK1
End DoDot:2
End DoDot:1
QUIT
+25 IF Y="A"
Begin DoDot:1
+26 DO LCK2
IF $GET(Y)=0
KILL Y
QUIT
+27 NEW PSACNT,PSACNTR
+28 SET PSACNT=0
FOR
SET PSACNT=$ORDER(PSALCHK(PSACNT))
if 'PSACNT
QUIT
Begin DoDot:2
+29 SET PSAIEN=$PIECE(PSALCHK(PSACNT),"^",1)
SET PSAIEN1=$PIECE(PSALCHK(PSACNT),"^",2)
DO LCK1
End DoDot:2
End DoDot:1
+30 QUIT
LCK1 ; RESET ORDER STATUS TO PROCESSED
+1 WRITE !,?5,"Order Status has been reset to PROCESSED for",!,?8,"Order#: ",$PIECE(^PSD(58.811,PSAIEN,0),"^")," Invoice#: ",$PIECE(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^")
+2 NEW DIC,DA,DR,DIE
+3 FOR
LOCK +^PSD(58.811,PSAIEN,1,PSAIEN1,0):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
IF $TEST
QUIT
+4 SET DA=PSAIEN1
SET DA(1)=PSAIEN
SET DIE="^PSD(58.811,"_DA(1)_",1,"
SET DR="2///P;12////@"
DO ^DIE
+5 LOCK -^PSD(58.811,PSAIEN,1,PSAIEN1,0)
+6 QUIT
LCK2 ; DOUBLE CHECK WITH USER BEFORE RESETTING INVOICE STATUS
+1 SET DIR(0)="Y"
SET DIR("A")="Are you sure you want to change the Order Status to PROCESSED"
SET DIR("B")="NO"
+2 DO ^DIR
KILL DIR
+3 QUIT
CLCK ; RESET ORDER STATUS TO COMPLETED <*71 RJS
+1 WRITE !,?5,"Order Status has been reset to COMPLETED for",!,?8,"Order#: ",$PIECE(^PSD(58.811,PSAIEN,0),"^")," Invoice#: ",$PIECE(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^"),!
+2 NEW DIC,DA,DR,DIE
+3 FOR
LOCK +^PSD(58.811,PSAIEN,1,PSAIEN1,0):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
IF $TEST
QUIT
+4 SET DA=PSAIEN1
SET DA(1)=PSAIEN
SET DIE="^PSD(58.811,"_DA(1)_",1,"
SET DR="2///C"
DO ^DIE
+5 LOCK -^PSD(58.811,PSAIEN,1,PSAIEN1,0)
+6 QUIT
UNLCK ; RESET ORDER STATUS TO PROCESSED
+1 DO MSG
+2 NEW PSAIEN,PSAIEN1,DUOUT
SET PSAIEN=0
+3 FOR
SET PSAIEN=$ORDER(^XTMP("PSALCK",DUZ,PSAIEN))
if 'PSAIEN
QUIT
Begin DoDot:1
+4 SET PSAIEN1=0
FOR
SET PSAIEN1=$ORDER(^XTMP("PSALCK",DUZ,PSAIEN,PSAIEN1))
if 'PSAIEN1
QUIT
Begin DoDot:2
+5 WRITE !,?8,"Order#: ",$PIECE(^PSD(58.811,PSAIEN,0),"^"),?35,"Invoice#: ",$PIECE(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^"),?60,"LOCKED VERIFYING"
+6 NEW DIR
+7 SET DIR(0)="S^P:RESET TO PROCESSED;C:MARK COMPLETED;S:SKIP"
+8 SET DIR("A")="PROCESS OR COMPLETE"
+9 DO ^DIR
KILL DIR
if '$DATA(Y)!($GET(DUOUT))
QUIT
+10 IF Y="P"
DO LCK1
WRITE !
QUIT
+11 IF Y="C"
DO CLCK
WRITE !
QUIT
+12 IF Y="S"
WRITE !!,?5,"Order#: ",$PIECE(^PSD(58.811,PSAIEN,0),"^")," Invoice#: ",$PIECE(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^")," HES BEEN SKIPPED",!
End DoDot:2
End DoDot:1
+13 KILL ^XTMP("PSALCK",DUZ)
+14 ;;*71 RJS >
QUIT
MSG ; SHOW LOCK WARNING
+1 WRITE !!,?3,"The following Invoices currently have a status of LOCKED VERIFYING."
+2 WRITE !,?3,"These Invoices are either currently being Verified by you in another"
+3 WRITE !,?3,"session, or it may not have completed the Verify process correctly.",!
+4 QUIT
