Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSAVER4

PSAVER4.m

Go to the documentation of this file.
  1. 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
  1. ;This routine prints the report of new drugs that will be added to
  1. ;each pharmacy location or master vault.
  1. ;
  1. ;Asks & prints all invoices the user can verify.
  1. 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"
  1. 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."
  1. K IO("Q") S %ZIS="Q" W !
  1. D ^%ZIS I POP W !,"NO DEVICE SELECTED OR OUTPUT PRINTED!" Q
  1. I $D(IO("Q")) D G QUIT
  1. .N ZTSAVE,ZTIO,ZTRTN,ZTSAVE,ZTDTH,ZTSK
  1. .S ZTDESC="Drug Acct. - Print New Drugs",ZTDTH=$H,ZTRTN="PRINT^PSAVER4"
  1. .S ZTSAVE("PSANEWD(")="" D ^%ZTLOAD
  1. ;
  1. PRINT ;Sends invoices to printer
  1. S (PSALOC,PSAOUT)=0,PSAPG=1,PSADLN="",$P(PSADLN,"=",80)="",PSASLN="",$P(PSASLN,"-",80)=""
  1. F S PSALOC=+$O(PSANEWD(PSALOC)) Q:'PSALOC!(PSAOUT) S PSADRGN=1 D HDR Q:PSAOUT D Q:PSAOUT
  1. .F S PSADRGN=$O(PSANEWD(PSALOC,PSADRGN)) Q:PSADRGN=""!(PSAOUT) D:$Y+5>IOSL HDR Q:PSAOUT W !,PSADRGN,!,PSASLN,!
  1. D:$E(IOST,1,2)="C-"&('PSAOUT) END^PSAPROC W:$E(IOST)'="C" @IOF
  1. K PSANEWD(PSALOC)
  1. QUIT D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" K IO("Q")
  1. Q
  1. ;
  1. HDR ;Prints the header to the New Drug Report on the screen & paper.
  1. I $E(IOST,1,2)="C-" D:PSAPG'=1 END^PSAPROC Q:PSAOUT W @IOF,!?28,"<<< NEW DRUG REPORT >>>"
  1. I $E(IOST)'="C" W:PSAPG'=1 @IOF W !?20,"DRUG ACCOUNTABILITY/INVENTORY INTERFACE",!?28,"<<< NEW DRUG REPORT >>>",?72,"Page "_PSAPG
  1. I $P($G(^PSD(58.8,PSALOC,0)),"^",2)="M" W !?34,"MASTER VAULT",!!,$P($G(^PSD(58.8,PSALOC,0)),"^")
  1. I $P($G(^PSD(58.8,PSALOC,0)),"^",2)="P" D
  1. .D SITES^PSAUTL1 S PSALOCN=$P(^PSD(58.8,PSALOC,0),"^")_PSACOMB
  1. .W !?31,"PHARMACY LOCATION",!!
  1. .W:$L(PSALOCN)>76 $P(PSALOCN,"(IP)",1)_"(IP)",!?17,$P(PSALOCN,"(IP)",2) W:$L(PSALOCN)<77 PSALOCN
  1. W !,PSADLN S PSAPG=PSAPG+1
  1. Q
  1. ;
  1. VERLOCK ;==> PSA*3*60 (RJS-VMP)Sets invoice's status to Verifying
  1. N DIC,DA,DR,DIE
  1. 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
  1. .S PSAMSG="**This Invoice is currently being Verified by another user"
  1. 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
  1. .S PSAMSG="**This Invoice has already been Verified by another user"
  1. F L +^PSD(58.811,PSAIEN,1,PSAIEN1,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
  1. 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
  1. .S DA=PSAIEN1,DA(1)=PSAIEN,DIE="^PSD(58.811,"_DA(1)_",1,",DR="2///L;12////^S X="_DUZ
  1. .D ^DIE
  1. .S PSALOCK(PSA)=PSAIEN_"^"_PSAIEN1
  1. .I PSATMP S PSATMP=PSATMP_","_PSA
  1. .I 'PSATMP S PSATMP=PSA
  1. L -^PSD(58.811,PSAIEN,1,PSAIEN1,0)
  1. Q
  1. ;
  1. VERUNLCK ; VERIFY CANCELED RESET INVOICE TO PROCESSED
  1. N Y,PSAPC S PSACNT=0 F PSAPC=1:1 S PSA=+$P(PSASEL,",",PSAPC) Q:'PSA D
  1. .S PSAIEN=$P(PSALOCK(PSA),"^"),PSAIEN1=$P(PSALOCK(PSA),"^",2)
  1. .I $D(^PSD(58.811,"ASTAT","L",PSAIEN,PSAIEN1)) D
  1. ..N DIC,DA,DR,DIE
  1. ..F L +^PSD(58.811,PSAIEN,1,PSAIEN1,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
  1. ..S DA=PSAIEN1,DA(1)=PSAIEN,DIE="^PSD(58.811,"_DA(1)_",1,",DR="2///P;12////@" D ^DIE
  1. ..L -^PSD(58.811,PSAIEN,1,PSAIEN1,0)
  1. Q ;<== PSA*3*?? (RJS-VMP)
  1. ;
  1. LCKCHK ; CHECK FOR LOCKED INVOICES
  1. I $D(^XTMP("PSALCK",DUZ)) D UNLCK ;; <*71 RJS >
  1. N PSACT,PSACNT,PSAIEN,PSAIEN1,PSADUZ,PSASUP,PSALCHK,DUOUT S (PSACNT,PSAIEN)=0
  1. F S PSAIEN=+$O(^PSD(58.811,"ASTAT","L",PSAIEN)) Q:'PSAIEN D
  1. .Q:'$D(^PSD(58.811,PSAIEN,0))
  1. .S PSAIEN1=0 F S PSAIEN1=+$O(^PSD(58.811,"ASTAT","L",PSAIEN,PSAIEN1)) Q:'PSAIEN1 D
  1. ..Q:'$D(^PSD(58.811,PSAIEN,1,PSAIEN1,0))!($P(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^",11)'=DUZ)
  1. ..S PSACNT=PSACNT+1,PSALCHK(PSACNT)=PSAIEN_"^"_PSAIEN1
  1. Q:'$D(PSALCHK)
  1. D MSG
  1. S PSACT=0 F S PSACT=$O(PSALCHK(PSACT)) Q:'PSACT D
  1. .S PSAIEN=$P(PSALCHK(PSACT),"^",1),PSAIEN1=$P(PSALCHK(PSACT),"^",2),PSACNT=PSACT
  1. .W !,?3,PSACNT,".",?8,"Order#: ",$P(^PSD(58.811,PSAIEN,0),"^"),?35,"Invoice#: ",$P(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^")
  1. 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))
  1. I PSACNT=1 S PSAIEN=$P(PSALCHK(1),"^"),PSAIEN1=$P(PSALCHK(1),"^",2) D LCK1 Q
  1. I PSACNT>1 D
  1. .S DIR(0)="S^A:All;S:Selected"
  1. .S DIR("A")="Which Orders"
  1. .D ^DIR K DIR Q:'$D(Y)!($G(DUOUT))
  1. I Y="S" D Q
  1. .S DIR(0)="L^1:"_PSACNT D ^DIR K DIR Q:'Y!($G(DUOUT))
  1. .N PSACNT,PSANUM,PSACNTR S PSANUM=Y K Y
  1. .D LCK2 I $G(Y)=0 K Y Q
  1. .F PSACNTR=1:1 S PSACNT=$P(PSANUM,",",PSACNTR) Q:'PSACNT D
  1. ..S PSAIEN=$P(PSALCHK(PSACNT),"^",1),PSAIEN1=$P(PSALCHK(PSACNT),"^",2) D LCK1
  1. I Y="A" D
  1. .D LCK2 I $G(Y)=0 K Y Q
  1. .N PSACNT,PSACNTR
  1. .S PSACNT=0 F S PSACNT=$O(PSALCHK(PSACNT)) Q:'PSACNT D
  1. ..S PSAIEN=$P(PSALCHK(PSACNT),"^",1),PSAIEN1=$P(PSALCHK(PSACNT),"^",2) D LCK1
  1. Q
  1. LCK1 ; RESET ORDER STATUS TO PROCESSED
  1. 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),"^")
  1. N DIC,DA,DR,DIE
  1. F L +^PSD(58.811,PSAIEN,1,PSAIEN1,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
  1. S DA=PSAIEN1,DA(1)=PSAIEN,DIE="^PSD(58.811,"_DA(1)_",1,",DR="2///P;12////@" D ^DIE
  1. L -^PSD(58.811,PSAIEN,1,PSAIEN1,0)
  1. Q
  1. LCK2 ; DOUBLE CHECK WITH USER BEFORE RESETTING INVOICE STATUS
  1. S DIR(0)="Y",DIR("A")="Are you sure you want to change the Order Status to PROCESSED",DIR("B")="NO"
  1. D ^DIR K DIR
  1. Q
  1. CLCK ; RESET ORDER STATUS TO COMPLETED <*71 RJS
  1. 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),"^"),!
  1. N DIC,DA,DR,DIE
  1. F L +^PSD(58.811,PSAIEN,1,PSAIEN1,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
  1. S DA=PSAIEN1,DA(1)=PSAIEN,DIE="^PSD(58.811,"_DA(1)_",1,",DR="2///C" D ^DIE
  1. L -^PSD(58.811,PSAIEN,1,PSAIEN1,0)
  1. Q
  1. UNLCK ; RESET ORDER STATUS TO PROCESSED
  1. D MSG
  1. N PSAIEN,PSAIEN1,DUOUT S PSAIEN=0
  1. F S PSAIEN=$O(^XTMP("PSALCK",DUZ,PSAIEN)) Q:'PSAIEN D
  1. .S PSAIEN1=0 F S PSAIEN1=$O(^XTMP("PSALCK",DUZ,PSAIEN,PSAIEN1)) Q:'PSAIEN1 D
  1. ..W !,?8,"Order#: ",$P(^PSD(58.811,PSAIEN,0),"^"),?35,"Invoice#: ",$P(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^"),?60,"LOCKED VERIFYING"
  1. ..N DIR
  1. ..S DIR(0)="S^P:RESET TO PROCESSED;C:MARK COMPLETED;S:SKIP"
  1. ..S DIR("A")="PROCESS OR COMPLETE"
  1. ..D ^DIR K DIR Q:'$D(Y)!($G(DUOUT))
  1. ..I Y="P" D LCK1 W ! Q
  1. ..I Y="C" D CLCK W ! Q
  1. ..I Y="S" W !!,?5,"Order#: ",$P(^PSD(58.811,PSAIEN,0),"^")," Invoice#: ",$P(^PSD(58.811,PSAIEN,1,PSAIEN1,0),"^")," HES BEEN SKIPPED",!
  1. K ^XTMP("PSALCK",DUZ)
  1. Q ;;*71 RJS >
  1. MSG ; SHOW LOCK WARNING
  1. W !!,?3,"The following Invoices currently have a status of LOCKED VERIFYING."
  1. W !,?3,"These Invoices are either currently being Verified by you in another"
  1. W !,?3,"session, or it may not have completed the Verify process correctly.",!
  1. Q