- 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 Jan 18, 2025@02:52:18 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