source: FOIAVistA/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAVER4.m@ 1611

Last change on this file since 1611 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 3.4 KB
Line 
1PSAVER4 ;;BIR/JMB-Verify Invoices - CONT'D ;9/8/97
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**15,60**; 10/24/97;Build 4
3 ;This routine prints the report of new drugs that will be added to
4 ;each pharmacy location or master vault.
5 ;
6 ;Asks & prints all invoices the user can verify.
7 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"
8 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."
9 K IO("Q") S %ZIS="Q" W !
10 D ^%ZIS I POP W !,"NO DEVICE SELECTED OR OUTPUT PRINTED!" Q
11 I $D(IO("Q")) D G QUIT
12 .N ZTSAVE,ZTIO,ZTRTN,ZTSAVE,ZTDTH,ZTSK
13 .S ZTDESC="Drug Acct. - Print New Drugs",ZTDTH=$H,ZTRTN="PRINT^PSAVER4"
14 .S ZTSAVE("PSANEWD(")="" D ^%ZTLOAD
15 ;
16PRINT ;Sends invoices to printer
17 S (PSALOC,PSAOUT)=0,PSAPG=1,PSADLN="",$P(PSADLN,"=",80)="",PSASLN="",$P(PSASLN,"-",80)=""
18 F S PSALOC=+$O(PSANEWD(PSALOC)) Q:'PSALOC!(PSAOUT) S PSADRGN=1 D HDR Q:PSAOUT D Q:PSAOUT
19 .F S PSADRGN=$O(PSANEWD(PSALOC,PSADRGN)) Q:PSADRGN=""!(PSAOUT) D:$Y+5>IOSL HDR Q:PSAOUT W !,PSADRGN,!,PSASLN,!
20 D:$E(IOST,1,2)="C-"&('PSAOUT) END^PSAPROC W:$E(IOST)'="C" @IOF
21 K PSANEWD(PSALOC)
22QUIT D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" K IO("Q")
23 Q
24 ;
25HDR ;Prints the header to the New Drug Report on the screen & paper.
26 I $E(IOST,1,2)="C-" D:PSAPG'=1 END^PSAPROC Q:PSAOUT W @IOF,!?28,"<<< NEW DRUG REPORT >>>"
27 I $E(IOST)'="C" W:PSAPG'=1 @IOF W !?20,"DRUG ACCOUNTABILITY/INVENTORY INTERFACE",!?28,"<<< NEW DRUG REPORT >>>",?72,"Page "_PSAPG
28 I $P($G(^PSD(58.8,PSALOC,0)),"^",2)="M" W !?34,"MASTER VAULT",!!,$P($G(^PSD(58.8,PSALOC,0)),"^")
29 I $P($G(^PSD(58.8,PSALOC,0)),"^",2)="P" D
30 .D SITES^PSAUTL1 S PSALOCN=$P(^PSD(58.8,PSALOC,0),"^")_PSACOMB
31 .W !?31,"PHARMACY LOCATION",!!
32 .W:$L(PSALOCN)>76 $P(PSALOCN,"(IP)",1)_"(IP)",!?17,$P(PSALOCN,"(IP)",2) W:$L(PSALOCN)<77 PSALOCN
33 W !,PSADLN S PSAPG=PSAPG+1
34 Q
35 ;
36VERLOCK ;==> PSA*3*60 (RJS-VMP)Sets invoice's status to Verifying
37 N DIC,DA,DR,DIE
38 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
39 .S PSAMSG="**This Invoice is currently being Verified by another user"
40 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
41 .S PSAMSG="**This Invoice has already been Verified by another user"
42 F L +^PSD(58.811,PSAIEN,1,PSAIEN1,0):0 I Q:$T
43 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
44 .S DA=PSAIEN1,DA(1)=PSAIEN,DIE="^PSD(58.811,"_DA(1)_",1,",DR="2///L;12////^S X="_DUZ
45 .D ^DIE
46 .S PSALOCK(PSA)=PSAIEN_"^"_PSAIEN1
47 .I PSATMP S PSATMP=PSATMP_","_PSA
48 .I 'PSATMP S PSATMP=PSA
49 L -^PSD(58.811,PSAIEN,1,PSAIEN1,0)
50 Q
51 ;
52VERUNLCK ; VERIFY CANCELED RESET INVOICE TO PROCESSED
53 N Y,PSAPC S PSACNT=0 F PSAPC=1:1 S PSA=+$P(PSASEL,",",PSAPC) Q:'PSA D
54 .S PSAIEN=$P(PSALOCK(PSA),"^"),PSAIEN1=$P(PSALOCK(PSA),"^",2)
55 .I $D(^PSD(58.811,"ASTAT","L",PSAIEN,PSAIEN1)) D
56 ..N DIC,DA,DR,DIE
57 ..F L +^PSD(58.811,PSAIEN,1,PSAIEN1,0):0 I Q
58 ..S DA=PSAIEN1,DA(1)=PSAIEN,DIE="^PSD(58.811,"_DA(1)_",1,",DR="2///P;12////@" D ^DIE
59 ..L -^PSD(58.811,PSAIEN,1,PSAIEN1,0)
60 Q ;<== PSA*3*?? (RJS-VMP)
Note: See TracBrowser for help on using the repository browser.