source: FOIAVistA/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAORDP.m@ 1310

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

initial load of FOIAVistA 6/30/08 version
File size: 8.6 KB
Line 
1PSAORDP ;BIR/JMB-Print Orders ;9/19/97
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**7**; 10/24/97
3 ;This routine selects the orders, invoices, or invoice status to be
4 ;printed from the DRUG ACCOUNTABILITY ORDERS. It calls PSAORDP1 to
5 ;print processed invoices and ^PSAUP4 to print unprocessed invoices.
6 ;
7 I '$D(^XUSEC("PSA ORDERS",DUZ)) W !,"You do not hold the key to enter the option." Q
8START W !! S DIR(0)="S^O:Order Number;I:Invoice Number;S:Invoice Status",DIR("A")="Print by Order#, Invoice#, or Invoice Status",DIR("B")="O",DIR("??")="^D SELHELP^PSAORDP" D ^DIR K DIR
9 Q:$G(DIRUT) S PSAPRT=Y,PSAOUT=0
10 D:PSAPRT="O" ORDER D:PSAPRT="I" INVOICE D:PSAPRT="S" STATUS G:PSAOUT EXIT
11 I PSAPRT="O"!(PSAPRT="I"),$O(PSAORD(""))="" G EXIT
12 W ! S %ZIS="Q" D ^%ZIS G:POP EXIT
13 I $D(IO("Q")) D G EXIT
14 .S ZTDESC="Drug Acct. - Print Prime Vendor Invoices",ZTRTN="DQ^PSAORDP"
15 .F PSASAVE="PSAINV","PSAPRT","PSASTA" S:$D(@PSASAVE) ZTSAVE(PSASAVE)=""
16 .S ZTSAVE("PSAORD(")="" D ^%ZTLOAD
17 ;
18DQ S PSAOUT=0
19 I PSAPRT="O" D PRTORD G EXIT
20 I PSAPRT="I" D PRTINV G EXIT
21 D:PSAPRT="S" PRTSTA
22 ;
23EXIT W:$E(IOST,1,2)="C-" @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" K IO("Q")
24 K %,%ZIS,DA,DIC,DTOUT,DUOUT,PSA,PSAAECST,PSABY,PSACIEN,PSACNT,PSACTRL,PSACTRLH,PSADATA,PSADEC,PSADJDRG,PSADJSUP,PSADLN,PSADONE,PSADRG,PSADS
25 K PSAECOST,PSAEND,PSAFIN,PSAFIRST,PSAFPG,PSAICOST,PSAIECST,PSAIN,PSAINV,PSAINVB,PSAINVBH,PSAINVH,PSALINE,PSANDC,PSAORD,PSAORDB,PSAOUT,PSAPAGE,PSAPC,PSAPRT,PSARUN
26 K PSAS,PSASAVE,PSASLN,PSASS,PSAST,PSASTA,PSASUB,PSATOT,PSAXCNT,X,ZTDESC,ZTRTN,ZTSAVE
27 Q
28 ;
29INVOICE ;Prompts for order and invoice
30 K PSAORD S (PSACNT,PSADONE,PSAFIN,PSAXCNT)=0,PSASLN="",$P(PSASLN,"-",80)=""
31 F W !,PSASLN S DIR(0)="FO^1:22",DIR("A")="Select ORDER NUMBER",DIR("?")="Enter the order number of the invoice to be printed",DIR("??")="^D ORDIHELP^PSAORDP" D ^DIR K DIR D Q:PSAOUT!(PSAFIN)
32 .S PSAORDB=Y I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q
33 .I PSAORDB="" S PSAFIN=1 Q
34 .Q:PSAORDB=" "
35 .;In 58.811
36 .I $O(^PSD(58.811,"B",PSAORDB,0)) S PSAORD=+$O(^PSD(58.811,"B",PSAORDB,0)),PSAINVB="" D
37 ..F S PSAINVB=$O(^PSD(58.811,PSAORD,1,"B",PSAINVB)) Q:PSAINVB="" S PSACNT=PSACNT+1,(PSAINV,PSAINVH)=$O(^PSD(58.811,PSAORD,1,"B",PSAINVB,0)),PSAINVBH=PSAINVB
38 .;In XTMP
39 .Q:PSAOUT S (PSACTRL,PSADONE)=0
40 .F S PSACTRL=$O(^XTMP("PSAPV",PSACTRL)) Q:PSACTRL=""!(PSADONE) D
41 ..I $P($G(^XTMP("PSAPV",PSACTRL,"IN")),"^",4)=PSAORDB S PSAXCNT=PSAXCNT+1,(PSAINVH,PSAINVB)=$P(^("IN"),"^",2),PSACTRLH=PSACTRL,PSA(PSAORDB,PSAINVB,PSACTRL)=""
42 .Q:PSAOUT
43 .I PSACNT,'PSAXCNT D Q
44 ..I PSACNT=1 W !,"Invoice# "_PSAINVBH S PSAORD(PSAORDB,PSAORD)=PSAINVH Q
45 ..D:PSACNT>1 INV
46 .I 'PSACNT,PSAXCNT D Q
47 ..I PSAXCNT=1 W !,"Invoice# "_PSAINVH S PSAORD(PSAORDB,0)=PSAINVH_"~"_PSACTRLH,PSACTRL=PSACTRLH Q
48 ..D:PSAXCNT>1 INVXTMP
49 .I PSACNT,PSAXCNT D INVBOTH Q
50 .I '$D(PSAORD(PSAORDB)) W !,PSAORDB_" is an invalid order number."
51 Q
52 ;
53INV ;Select invoice from 58.811
54 S (PSACNT,PSADONE)=0
55 F S DA(1)=PSAORD,DIC="^PSD(58.811,"_DA(1)_",1,",DIC("A")="Select INVOICE NUMBER: ",DIC(0)="AEMZQ",DA(1)=PSAORD D ^DIC K DIC D Q:PSAOUT!(PSADONE)
56 .I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q
57 .I Y=-1 S PSADONE=1 Q
58 .I 'PSACNT S PSAORD(PSAORDB,PSAORD)=+Y,PSACNT=1 Q
59 .I PSACNT S PSAORD(PSAORDB,PSAORD)=PSAORD(PSAORDB,PSAORD)_","_+Y
60 Q
61 ;
62INVXTMP ;Select invoice from XTMP
63 S (PSAXCNT,PSADONE)=0,PSAFIRST=1
64 F S DIR(0)="FO^1:22",DIR("A")="Select INVOICE NUMBER" D ^DIR K DIR D Q:PSAOUT!(PSADONE)
65 .I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q
66 .I Y="" S PSADONE=1 Q
67 .Q:Y=" " S PSAINV=Y
68 .I 'PSAXCNT S PSAORD(PSAORDB,0)=Y_"~"_PSACTRLH,PSAXCNT=1 Q
69 .I PSAXCNT S PSAORD(PSAORDB,0)=PSAORD(PSAORDB,0)_","_Y Q
70 Q
71 ;
72INVBOTH ;Select invoice from XTMP & 58.811
73 S (PSADONE)=0
74 F S DIR(0)="FO^1:22",DIR("A")="Select INVOICE NUMBER" D ^DIR K DIR D Q:PSAOUT!(PSADONE)
75 .I $G(DTOUT)!($G(DUOUT)) S PSAXCNT=1 Q
76 .Q:Y=" "
77 .I Y="" S PSADONE=1 Q
78 .S PSAINVB=Y,PSAINV=$O(^PSD(58.811,PSAORD,1,"B",PSAINVB,0))
79 .I PSAINV S:$D(PSAORD(PSAORDB,PSAORD)) PSAORD(PSAORDB,PSAORD)=PSAORD(PSAORDB,PSAORD)_","_PSAINV S:'$D(PSAORD(PSAORDB,PSAORD)) PSAORD(PSAORDB,PSAORD)=PSAINV Q
80 .I $D(PSA(PSAORDB,PSAINVB)) S PSACTRL=$O(PSA(PSAORDB,PSAINVB,0)) I PSACTRL'="" S:$D(PSAORD(PSAORDB,0)) PSAORD(PSAORDB,0)=PSAORD(PSAORDB,0)_","_PSAINVB_"~"_PSACTRL S:'$D(PSAORD(PSAORDB,0)) PSAORD(PSAORDB,0)=PSAINVB_"~"_PSACTRL Q
81 .W !,PSAINVB_" is an invalid invoice number."
82 Q
83 ;
84PRTINV ;Loops thru orders & invoices to print invoices
85 S PSAORDB="" F S PSAORDB=$O(PSAORD(PSAORDB)) Q:PSAORDB=""!(PSAOUT) D
86 .S PSAORD="" F S PSAORD=$O(PSAORD(PSAORDB,PSAORD)) Q:PSAORD=""!(PSAOUT) D
87 ..F PSAPC=1:1 S PSAINV=$P(PSAORD(PSAORDB,PSAORD),",",PSAPC) Q:PSAINV=""!(PSAOUT) D
88 ...I PSAORD D ^PSAORDP1 Q
89 ...;DAVEB (PSA*3*7)
90 ...S PSACTRL=$P(PSAINV,"~",2),PSAINV=$P(PSAINV,"~"),IOM=80
91 ...I $D(PSA(PSAORDB,$P(PSAINV,"~"))) S PSAINV=$P(PSAINV,"~"),PSACTRL=$O(PSA(PSAORDB,PSAINV,0))
92 ...D NOW^%DTC S Y=% D DD^%DT S PSARUN=$E(Y,1,18),PSAPAGE=1,$P(PSASLN,"-",80)="",$P(PSADLN,"=",80)="",PSADJDRG=0,PSAFPG=1
93 ...D START^PSAUP4
94 Q
95 ;
96ORDER ;Select order
97 K PSAORD S PSADONE=0
98 F W ! S DIR(0)="FO^1:22",DIR("A")="Select ORDER NUMBER",DIR("?")="Enter the number of the order to be printed",DIR("??")="^D ORDHELP^PSAORDP" D ^DIR K DIR D Q:PSAOUT!(PSADONE)
99 .I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q
100 .Q:X=" "
101 .I X="" S PSADONE=1 Q
102 .I $O(^PSD(58.811,"B",Y,0)) S PSAORD(Y,+$O(^PSD(58.811,"B",Y,0)))=""
103 .S PSACTRL=0 F S PSACTRL=$O(^XTMP("PSAPV",PSACTRL)) Q:PSACTRL=""!(PSADONE) I $P($G(^XTMP("PSAPV",PSACTRL,"IN")),"^",4)=Y S PSAORD(Y,0)="",PSADONE=1
104 .S PSADONE=0
105 .I '$D(PSAORD(X)) W !,Y_" is an invalid order number."
106 Q
107 ;
108PRTORD ;Loops thru invoices to print all for one order
109 S PSAORDB="" F S PSAORDB=$O(PSAORD(PSAORDB)) Q:PSAORDB=""!(PSAOUT) D
110 .S PSAORD="" F S PSAORD=$O(PSAORD(PSAORDB,PSAORD)) Q:PSAORD=""!(PSAOUT) D
111 ..I 'PSAORD S PSACTRL=0 F S PSACTRL=$O(^XTMP("PSAPV",PSACTRL)) Q:PSACTRL=""!(PSAOUT) D
112 ...Q:$P($G(^XTMP("PSAPV",PSACTRL,"IN")),"^",4)'=PSAORDB
113 ...D NOW^%DTC S Y=% D DD^%DT S PSARUN=$E(Y,1,18),PSAPAGE=1,$P(PSASLN,"-",80)="",$P(PSADLN,"=",80)="",PSADJDRG=0,PSAFPG=1
114 ...S PSAINV=$P($G(^XTMP("PSAPV",PSACTRL,"IN")),"^",2) D START^PSAUP4
115 ..I PSAORD S PSAINVB="" F S PSAINVB=$O(^PSD(58.811,PSAORD,1,"B",PSAINVB)) Q:PSAINVB=""!(PSAOUT) S PSAINV=$O(^PSD(58.811,PSAORD,1,"B",PSAINVB,0)) D ^PSAORDP1
116 G EXIT
117 ;
118STATUS ;Select status
119 W ! S DIR(0)="SOB^U:Unprocessed;P:Processed",DIR("A")="Select Unprocessed or Processed Invoice Status",DIR("??")="^D STATHELP^PSAORDP"
120 D ^DIR K DIR I $G(DIRUT) S PSAOUT=1 Q
121 S PSASTA=Y
122 I PSASTA="P",'$O(^PSD(58.811,"ASTAT","P",0)) W !!,"There are no invoices with the status of Processed." G STATUS
123 I PSASTA="U" D G:'PSACNT STATUS
124 .S (PSACNT,PSACTRL)=0 F S PSACTRL=$O(^XTMP("PSAPV",PSACTRL)) Q:PSACTRL=""!(PSACNT) I $D(^XTMP("PSAPV",PSACTRL,"IN")),$P(^("IN"),"^",8)'="P" S PSACNT=1
125 .I 'PSACNT W !!,"There are no invoices with the status of Unprocessed."
126 Q
127 ;
128PRTSTA ;Sets up printing & prints Unprocessed invoices
129 G:PSASTA="P" PROCESS
130 S PSACTRL=0 F S PSACTRL=$O(^XTMP("PSAPV",PSACTRL)) Q:PSACTRL=""!(PSAOUT) D
131 .Q:$P($G(^XTMP("PSAPV",PSACTRL,"IN")),"^",8)="P"
132 .S IOM=80 D NOW^%DTC S Y=% D DD^%DT S PSARUN=$E(Y,1,18),PSAPAGE=1,$P(PSASLN,"-",80)="",$P(PSADLN,"=",80)="",PSADJDRG=0,PSAFPG=1
133 .D START^PSAUP4
134 Q
135 ;
136PROCESS ;Prints Processed invoices
137 ;S PSAORDB="" F S PSAORDB=$O(^PSD(58.811,"AORD",PSAORDB)) Q:PSAORDB=""!(PSAOUT) D
138 ;.S PSAINVB="" F S PSAINVB=$O(^PSD(58.811,"AORD",PSAORDB,PSAINVB)) Q:PSAINVB=""!(PSAOUT) D
139 ;..S PSAORD=0 F S PSAORD=$O(^PSD(58.811,"AORD",PSAORDB,PSAINVB,PSAORD)) Q:'PSAORD!(PSAOUT) D
140 ;...S PSAINV=0 F S PSAINV=$O(^PSD(58.811,"AORD",PSAORDB,PSAINVB,PSAORD,PSAINV)) Q:'PSAINV!(PSAOUT) D ^PSAORDP1
141 S PSAORD=0 F S PSAORD=$O(^PSD(58.811,"ASTAT","P",PSAORD)) Q:'PSAORD!(PSAOUT) D
142 .S PSAINV=0 F S PSAINV=$O(^PSD(58.811,"ASTAT","P",PSAORD,PSAINV)) Q:'PSAINV!(PSAOUT) D
143 ..S PSAORDB=$P($G(^PSD(58.811,PSAORD,0)),"^"),PSAINVB=$P($G(^PSD(58.811,PSAORD,1,PSAINV,0)),"^") Q:PSAORDB=""!(PSAINVB="") D ^PSAORDP1
144 G EXIT
145 ;
146ORDHELP ;Extended help to Select Order
147 W !?5,"Enter the order number assigned to the order to be print."
148 Q
149ORDIHELP ;Extended help to Select Invoice's Order
150 W !?5,"Enter the invoice's order number to be print. The invoice number ",!?5,"prompt will follow."
151 Q
152SELHELP ;Extended help to Print by Order#, Invoice#, or Invoice Status
153 W !?5,"To print all invoices for a specific order, select Order Number.",!?5,"To print a specific invoice, select Invoice Number. To print all"
154 W !?5,"invoices with an unprocessed or processed status, select Invoice",!?5,"Status."
155 Q
156STATHELP ;Extended help for Enter Status
157 W !?5,"Enter U to print all uploaded invoices that have not been processed.",!?5,"Enter P to print all processed invoices that have not been verified."
158 Q
Note: See TracBrowser for help on using the repository browser.