159 lines
8.6 KiB
Mathematica
159 lines
8.6 KiB
Mathematica
PSAORDP ;BIR/JMB-Print Orders ;9/19/97
|
|
;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**7**; 10/24/97
|
|
;This routine selects the orders, invoices, or invoice status to be
|
|
;printed from the DRUG ACCOUNTABILITY ORDERS. It calls PSAORDP1 to
|
|
;print processed invoices and ^PSAUP4 to print unprocessed invoices.
|
|
;
|
|
I '$D(^XUSEC("PSA ORDERS",DUZ)) W !,"You do not hold the key to enter the option." Q
|
|
START 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
|
|
Q:$G(DIRUT) S PSAPRT=Y,PSAOUT=0
|
|
D:PSAPRT="O" ORDER D:PSAPRT="I" INVOICE D:PSAPRT="S" STATUS G:PSAOUT EXIT
|
|
I PSAPRT="O"!(PSAPRT="I"),$O(PSAORD(""))="" G EXIT
|
|
W ! S %ZIS="Q" D ^%ZIS G:POP EXIT
|
|
I $D(IO("Q")) D G EXIT
|
|
.S ZTDESC="Drug Acct. - Print Prime Vendor Invoices",ZTRTN="DQ^PSAORDP"
|
|
.F PSASAVE="PSAINV","PSAPRT","PSASTA" S:$D(@PSASAVE) ZTSAVE(PSASAVE)=""
|
|
.S ZTSAVE("PSAORD(")="" D ^%ZTLOAD
|
|
;
|
|
DQ S PSAOUT=0
|
|
I PSAPRT="O" D PRTORD G EXIT
|
|
I PSAPRT="I" D PRTINV G EXIT
|
|
D:PSAPRT="S" PRTSTA
|
|
;
|
|
EXIT W:$E(IOST,1,2)="C-" @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" K IO("Q")
|
|
K %,%ZIS,DA,DIC,DTOUT,DUOUT,PSA,PSAAECST,PSABY,PSACIEN,PSACNT,PSACTRL,PSACTRLH,PSADATA,PSADEC,PSADJDRG,PSADJSUP,PSADLN,PSADONE,PSADRG,PSADS
|
|
K PSAECOST,PSAEND,PSAFIN,PSAFIRST,PSAFPG,PSAICOST,PSAIECST,PSAIN,PSAINV,PSAINVB,PSAINVBH,PSAINVH,PSALINE,PSANDC,PSAORD,PSAORDB,PSAOUT,PSAPAGE,PSAPC,PSAPRT,PSARUN
|
|
K PSAS,PSASAVE,PSASLN,PSASS,PSAST,PSASTA,PSASUB,PSATOT,PSAXCNT,X,ZTDESC,ZTRTN,ZTSAVE
|
|
Q
|
|
;
|
|
INVOICE ;Prompts for order and invoice
|
|
K PSAORD S (PSACNT,PSADONE,PSAFIN,PSAXCNT)=0,PSASLN="",$P(PSASLN,"-",80)=""
|
|
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)
|
|
.S PSAORDB=Y I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q
|
|
.I PSAORDB="" S PSAFIN=1 Q
|
|
.Q:PSAORDB=" "
|
|
.;In 58.811
|
|
.I $O(^PSD(58.811,"B",PSAORDB,0)) S PSAORD=+$O(^PSD(58.811,"B",PSAORDB,0)),PSAINVB="" D
|
|
..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
|
|
.;In XTMP
|
|
.Q:PSAOUT S (PSACTRL,PSADONE)=0
|
|
.F S PSACTRL=$O(^XTMP("PSAPV",PSACTRL)) Q:PSACTRL=""!(PSADONE) D
|
|
..I $P($G(^XTMP("PSAPV",PSACTRL,"IN")),"^",4)=PSAORDB S PSAXCNT=PSAXCNT+1,(PSAINVH,PSAINVB)=$P(^("IN"),"^",2),PSACTRLH=PSACTRL,PSA(PSAORDB,PSAINVB,PSACTRL)=""
|
|
.Q:PSAOUT
|
|
.I PSACNT,'PSAXCNT D Q
|
|
..I PSACNT=1 W !,"Invoice# "_PSAINVBH S PSAORD(PSAORDB,PSAORD)=PSAINVH Q
|
|
..D:PSACNT>1 INV
|
|
.I 'PSACNT,PSAXCNT D Q
|
|
..I PSAXCNT=1 W !,"Invoice# "_PSAINVH S PSAORD(PSAORDB,0)=PSAINVH_"~"_PSACTRLH,PSACTRL=PSACTRLH Q
|
|
..D:PSAXCNT>1 INVXTMP
|
|
.I PSACNT,PSAXCNT D INVBOTH Q
|
|
.I '$D(PSAORD(PSAORDB)) W !,PSAORDB_" is an invalid order number."
|
|
Q
|
|
;
|
|
INV ;Select invoice from 58.811
|
|
S (PSACNT,PSADONE)=0
|
|
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)
|
|
.I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q
|
|
.I Y=-1 S PSADONE=1 Q
|
|
.I 'PSACNT S PSAORD(PSAORDB,PSAORD)=+Y,PSACNT=1 Q
|
|
.I PSACNT S PSAORD(PSAORDB,PSAORD)=PSAORD(PSAORDB,PSAORD)_","_+Y
|
|
Q
|
|
;
|
|
INVXTMP ;Select invoice from XTMP
|
|
S (PSAXCNT,PSADONE)=0,PSAFIRST=1
|
|
F S DIR(0)="FO^1:22",DIR("A")="Select INVOICE NUMBER" D ^DIR K DIR D Q:PSAOUT!(PSADONE)
|
|
.I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q
|
|
.I Y="" S PSADONE=1 Q
|
|
.Q:Y=" " S PSAINV=Y
|
|
.I 'PSAXCNT S PSAORD(PSAORDB,0)=Y_"~"_PSACTRLH,PSAXCNT=1 Q
|
|
.I PSAXCNT S PSAORD(PSAORDB,0)=PSAORD(PSAORDB,0)_","_Y Q
|
|
Q
|
|
;
|
|
INVBOTH ;Select invoice from XTMP & 58.811
|
|
S (PSADONE)=0
|
|
F S DIR(0)="FO^1:22",DIR("A")="Select INVOICE NUMBER" D ^DIR K DIR D Q:PSAOUT!(PSADONE)
|
|
.I $G(DTOUT)!($G(DUOUT)) S PSAXCNT=1 Q
|
|
.Q:Y=" "
|
|
.I Y="" S PSADONE=1 Q
|
|
.S PSAINVB=Y,PSAINV=$O(^PSD(58.811,PSAORD,1,"B",PSAINVB,0))
|
|
.I PSAINV S:$D(PSAORD(PSAORDB,PSAORD)) PSAORD(PSAORDB,PSAORD)=PSAORD(PSAORDB,PSAORD)_","_PSAINV S:'$D(PSAORD(PSAORDB,PSAORD)) PSAORD(PSAORDB,PSAORD)=PSAINV Q
|
|
.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
|
|
.W !,PSAINVB_" is an invalid invoice number."
|
|
Q
|
|
;
|
|
PRTINV ;Loops thru orders & invoices to print invoices
|
|
S PSAORDB="" F S PSAORDB=$O(PSAORD(PSAORDB)) Q:PSAORDB=""!(PSAOUT) D
|
|
.S PSAORD="" F S PSAORD=$O(PSAORD(PSAORDB,PSAORD)) Q:PSAORD=""!(PSAOUT) D
|
|
..F PSAPC=1:1 S PSAINV=$P(PSAORD(PSAORDB,PSAORD),",",PSAPC) Q:PSAINV=""!(PSAOUT) D
|
|
...I PSAORD D ^PSAORDP1 Q
|
|
...;DAVEB (PSA*3*7)
|
|
...S PSACTRL=$P(PSAINV,"~",2),PSAINV=$P(PSAINV,"~"),IOM=80
|
|
...I $D(PSA(PSAORDB,$P(PSAINV,"~"))) S PSAINV=$P(PSAINV,"~"),PSACTRL=$O(PSA(PSAORDB,PSAINV,0))
|
|
...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
|
|
...D START^PSAUP4
|
|
Q
|
|
;
|
|
ORDER ;Select order
|
|
K PSAORD S PSADONE=0
|
|
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)
|
|
.I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q
|
|
.Q:X=" "
|
|
.I X="" S PSADONE=1 Q
|
|
.I $O(^PSD(58.811,"B",Y,0)) S PSAORD(Y,+$O(^PSD(58.811,"B",Y,0)))=""
|
|
.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
|
|
.S PSADONE=0
|
|
.I '$D(PSAORD(X)) W !,Y_" is an invalid order number."
|
|
Q
|
|
;
|
|
PRTORD ;Loops thru invoices to print all for one order
|
|
S PSAORDB="" F S PSAORDB=$O(PSAORD(PSAORDB)) Q:PSAORDB=""!(PSAOUT) D
|
|
.S PSAORD="" F S PSAORD=$O(PSAORD(PSAORDB,PSAORD)) Q:PSAORD=""!(PSAOUT) D
|
|
..I 'PSAORD S PSACTRL=0 F S PSACTRL=$O(^XTMP("PSAPV",PSACTRL)) Q:PSACTRL=""!(PSAOUT) D
|
|
...Q:$P($G(^XTMP("PSAPV",PSACTRL,"IN")),"^",4)'=PSAORDB
|
|
...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
|
|
...S PSAINV=$P($G(^XTMP("PSAPV",PSACTRL,"IN")),"^",2) D START^PSAUP4
|
|
..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
|
|
G EXIT
|
|
;
|
|
STATUS ;Select status
|
|
W ! S DIR(0)="SOB^U:Unprocessed;P:Processed",DIR("A")="Select Unprocessed or Processed Invoice Status",DIR("??")="^D STATHELP^PSAORDP"
|
|
D ^DIR K DIR I $G(DIRUT) S PSAOUT=1 Q
|
|
S PSASTA=Y
|
|
I PSASTA="P",'$O(^PSD(58.811,"ASTAT","P",0)) W !!,"There are no invoices with the status of Processed." G STATUS
|
|
I PSASTA="U" D G:'PSACNT STATUS
|
|
.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
|
|
.I 'PSACNT W !!,"There are no invoices with the status of Unprocessed."
|
|
Q
|
|
;
|
|
PRTSTA ;Sets up printing & prints Unprocessed invoices
|
|
G:PSASTA="P" PROCESS
|
|
S PSACTRL=0 F S PSACTRL=$O(^XTMP("PSAPV",PSACTRL)) Q:PSACTRL=""!(PSAOUT) D
|
|
.Q:$P($G(^XTMP("PSAPV",PSACTRL,"IN")),"^",8)="P"
|
|
.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
|
|
.D START^PSAUP4
|
|
Q
|
|
;
|
|
PROCESS ;Prints Processed invoices
|
|
;S PSAORDB="" F S PSAORDB=$O(^PSD(58.811,"AORD",PSAORDB)) Q:PSAORDB=""!(PSAOUT) D
|
|
;.S PSAINVB="" F S PSAINVB=$O(^PSD(58.811,"AORD",PSAORDB,PSAINVB)) Q:PSAINVB=""!(PSAOUT) D
|
|
;..S PSAORD=0 F S PSAORD=$O(^PSD(58.811,"AORD",PSAORDB,PSAINVB,PSAORD)) Q:'PSAORD!(PSAOUT) D
|
|
;...S PSAINV=0 F S PSAINV=$O(^PSD(58.811,"AORD",PSAORDB,PSAINVB,PSAORD,PSAINV)) Q:'PSAINV!(PSAOUT) D ^PSAORDP1
|
|
S PSAORD=0 F S PSAORD=$O(^PSD(58.811,"ASTAT","P",PSAORD)) Q:'PSAORD!(PSAOUT) D
|
|
.S PSAINV=0 F S PSAINV=$O(^PSD(58.811,"ASTAT","P",PSAORD,PSAINV)) Q:'PSAINV!(PSAOUT) D
|
|
..S PSAORDB=$P($G(^PSD(58.811,PSAORD,0)),"^"),PSAINVB=$P($G(^PSD(58.811,PSAORD,1,PSAINV,0)),"^") Q:PSAORDB=""!(PSAINVB="") D ^PSAORDP1
|
|
G EXIT
|
|
;
|
|
ORDHELP ;Extended help to Select Order
|
|
W !?5,"Enter the order number assigned to the order to be print."
|
|
Q
|
|
ORDIHELP ;Extended help to Select Invoice's Order
|
|
W !?5,"Enter the invoice's order number to be print. The invoice number ",!?5,"prompt will follow."
|
|
Q
|
|
SELHELP ;Extended help to Print by Order#, Invoice#, or Invoice Status
|
|
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"
|
|
W !?5,"invoices with an unprocessed or processed status, select Invoice",!?5,"Status."
|
|
Q
|
|
STATHELP ;Extended help for Enter Status
|
|
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."
|
|
Q
|