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

PSAORDP.m

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