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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSAORDP 8918 printed Sep 23, 2025@19:25:56 Page 2
PSAORDP ;BIR/JMB-Print Orders ;9/19/97
+1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**7**; 10/24/97
+2 ;This routine selects the orders, invoices, or invoice status to be
+3 ;printed from the DRUG ACCOUNTABILITY ORDERS. It calls PSAORDP1 to
+4 ;print processed invoices and ^PSAUP4 to print unprocessed invoices.
+5 ;
+6 IF '$DATA(^XUSEC("PSA ORDERS",DUZ))
WRITE !,"You do not hold the key to enter the option."
QUIT
START WRITE !!
SET DIR(0)="S^O:Order Number;I:Invoice Number;S:Invoice Status"
SET DIR("A")="Print by Order#, Invoice#, or Invoice Status"
SET DIR("B")="O"
SET DIR("??")="^D SELHELP^PSAORDP"
DO ^DIR
KILL DIR
+1 if $GET(DIRUT)
QUIT
SET PSAPRT=Y
SET PSAOUT=0
+2 if PSAPRT="O"
DO ORDER
if PSAPRT="I"
DO INVOICE
if PSAPRT="S"
DO STATUS
if PSAOUT
GOTO EXIT
+3 IF PSAPRT="O"!(PSAPRT="I")
IF $ORDER(PSAORD(""))=""
GOTO EXIT
+4 WRITE !
SET %ZIS="Q"
DO ^%ZIS
if POP
GOTO EXIT
+5 IF $DATA(IO("Q"))
Begin DoDot:1
+6 SET ZTDESC="Drug Acct. - Print Prime Vendor Invoices"
SET ZTRTN="DQ^PSAORDP"
+7 FOR PSASAVE="PSAINV","PSAPRT","PSASTA"
if $DATA(@PSASAVE)
SET ZTSAVE(PSASAVE)=""
+8 SET ZTSAVE("PSAORD(")=""
DO ^%ZTLOAD
End DoDot:1
GOTO EXIT
+9 ;
DQ SET PSAOUT=0
+1 IF PSAPRT="O"
DO PRTORD
GOTO EXIT
+2 IF PSAPRT="I"
DO PRTINV
GOTO EXIT
+3 if PSAPRT="S"
DO PRTSTA
+4 ;
EXIT if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
KILL IO("Q")
+1 KILL %,%ZIS,DA,DIC,DTOUT,DUOUT,PSA,PSAAECST,PSABY,PSACIEN,PSACNT,PSACTRL,PSACTRLH,PSADATA,PSADEC,PSADJDRG,PSADJSUP,PSADLN,PSADONE,PSADRG,PSADS
+2 KILL PSAECOST,PSAEND,PSAFIN,PSAFIRST,PSAFPG,PSAICOST,PSAIECST,PSAIN,PSAINV,PSAINVB,PSAINVBH,PSAINVH,PSALINE,PSANDC,PSAORD,PSAORDB,PSAOUT,PSAPAGE,PSAPC,PSAPRT,PSARUN
+3 KILL PSAS,PSASAVE,PSASLN,PSASS,PSAST,PSASTA,PSASUB,PSATOT,PSAXCNT,X,ZTDESC,ZTRTN,ZTSAVE
+4 QUIT
+5 ;
INVOICE ;Prompts for order and invoice
+1 KILL PSAORD
SET (PSACNT,PSADONE,PSAFIN,PSAXCNT)=0
SET PSASLN=""
SET $PIECE(PSASLN,"-",80)=""
+2 FOR
WRITE !,PSASLN
SET DIR(0)="FO^1:22"
SET DIR("A")="Select ORDER NUMBER"
SET DIR("?")="Enter the order number of the invoice to be printed"
SET DIR("??")="^D ORDIHELP^PSAORDP"
DO ^DIR
KILL DIR
Begin DoDot:1
+3 SET PSAORDB=Y
IF $GET(DTOUT)!($GET(DUOUT))
SET PSAOUT=1
QUIT
+4 IF PSAORDB=""
SET PSAFIN=1
QUIT
+5 if PSAORDB=" "
QUIT
+6 ;In 58.811
+7 IF $ORDER(^PSD(58.811,"B",PSAORDB,0))
SET PSAORD=+$ORDER(^PSD(58.811,"B",PSAORDB,0))
SET PSAINVB=""
Begin DoDot:2
+8 FOR
SET PSAINVB=$ORDER(^PSD(58.811,PSAORD,1,"B",PSAINVB))
if PSAINVB=""
QUIT
SET PSACNT=PSACNT+1
SET (PSAINV,PSAINVH)=$ORDER(^PSD(58.811,PSAORD,1,"B",PSAINVB,0))
SET PSAINVBH=PSAINVB
End DoDot:2
+9 ;In XTMP
+10 if PSAOUT
QUIT
SET (PSACTRL,PSADONE)=0
+11 FOR
SET PSACTRL=$ORDER(^XTMP("PSAPV",PSACTRL))
if PSACTRL=""!(PSADONE)
QUIT
Begin DoDot:2
+12 IF $PIECE($GET(^XTMP("PSAPV",PSACTRL,"IN")),"^",4)=PSAORDB
SET PSAXCNT=PSAXCNT+1
SET (PSAINVH,PSAINVB)=$PIECE(^("IN"),"^",2)
SET PSACTRLH=PSACTRL
SET PSA(PSAORDB,PSAINVB,PSACTRL)=""
End DoDot:2
+13 if PSAOUT
QUIT
+14 IF PSACNT
IF 'PSAXCNT
Begin DoDot:2
+15 IF PSACNT=1
WRITE !,"Invoice# "_PSAINVBH
SET PSAORD(PSAORDB,PSAORD)=PSAINVH
QUIT
+16 if PSACNT>1
DO INV
End DoDot:2
QUIT
+17 IF 'PSACNT
IF PSAXCNT
Begin DoDot:2
+18 IF PSAXCNT=1
WRITE !,"Invoice# "_PSAINVH
SET PSAORD(PSAORDB,0)=PSAINVH_"~"_PSACTRLH
SET PSACTRL=PSACTRLH
QUIT
+19 if PSAXCNT>1
DO INVXTMP
End DoDot:2
QUIT
+20 IF PSACNT
IF PSAXCNT
DO INVBOTH
QUIT
+21 IF '$DATA(PSAORD(PSAORDB))
WRITE !,PSAORDB_" is an invalid order number."
End DoDot:1
if PSAOUT!(PSAFIN)
QUIT
+22 QUIT
+23 ;
INV ;Select invoice from 58.811
+1 SET (PSACNT,PSADONE)=0
+2 FOR
SET DA(1)=PSAORD
SET DIC="^PSD(58.811,"_DA(1)_",1,"
SET DIC("A")="Select INVOICE NUMBER: "
SET DIC(0)="AEMZQ"
SET DA(1)=PSAORD
DO ^DIC
KILL DIC
Begin DoDot:1
+3 IF $GET(DTOUT)!($GET(DUOUT))
SET PSAOUT=1
QUIT
+4 IF Y=-1
SET PSADONE=1
QUIT
+5 IF 'PSACNT
SET PSAORD(PSAORDB,PSAORD)=+Y
SET PSACNT=1
QUIT
+6 IF PSACNT
SET PSAORD(PSAORDB,PSAORD)=PSAORD(PSAORDB,PSAORD)_","_+Y
End DoDot:1
if PSAOUT!(PSADONE)
QUIT
+7 QUIT
+8 ;
INVXTMP ;Select invoice from XTMP
+1 SET (PSAXCNT,PSADONE)=0
SET PSAFIRST=1
+2 FOR
SET DIR(0)="FO^1:22"
SET DIR("A")="Select INVOICE NUMBER"
DO ^DIR
KILL DIR
Begin DoDot:1
+3 IF $GET(DTOUT)!($GET(DUOUT))
SET PSAOUT=1
QUIT
+4 IF Y=""
SET PSADONE=1
QUIT
+5 if Y=" "
QUIT
SET PSAINV=Y
+6 IF 'PSAXCNT
SET PSAORD(PSAORDB,0)=Y_"~"_PSACTRLH
SET PSAXCNT=1
QUIT
+7 IF PSAXCNT
SET PSAORD(PSAORDB,0)=PSAORD(PSAORDB,0)_","_Y
QUIT
End DoDot:1
if PSAOUT!(PSADONE)
QUIT
+8 QUIT
+9 ;
INVBOTH ;Select invoice from XTMP & 58.811
+1 SET (PSADONE)=0
+2 FOR
SET DIR(0)="FO^1:22"
SET DIR("A")="Select INVOICE NUMBER"
DO ^DIR
KILL DIR
Begin DoDot:1
+3 IF $GET(DTOUT)!($GET(DUOUT))
SET PSAXCNT=1
QUIT
+4 if Y=" "
QUIT
+5 IF Y=""
SET PSADONE=1
QUIT
+6 SET PSAINVB=Y
SET PSAINV=$ORDER(^PSD(58.811,PSAORD,1,"B",PSAINVB,0))
+7 IF PSAINV
if $DATA(PSAORD(PSAORDB,PSAORD))
SET PSAORD(PSAORDB,PSAORD)=PSAORD(PSAORDB,PSAORD)_","_PSAINV
if '$DATA(PSAORD(PSAORDB,PSAORD))
SET PSAORD(PSAORDB,PSAORD)=PSAINV
QUIT
+8 IF $DATA(PSA(PSAORDB,PSAINVB))
SET PSACTRL=$ORDER(PSA(PSAORDB,PSAINVB,0))
IF PSACTRL'=""
if $DATA(PSAORD(PSAORDB,0))
SET PSAORD(PSAORDB,0)=PSAORD(PSAORDB,0)_","_PSAINVB_"~"_PSACTRL
if '$DATA(PSAORD(PSAORDB,0))
SET PSAORD(PSAORDB,0)=PSAINVB_"~"_PSACTRL
QUIT
+9 WRITE !,PSAINVB_" is an invalid invoice number."
End DoDot:1
if PSAOUT!(PSADONE)
QUIT
+10 QUIT
+11 ;
PRTINV ;Loops thru orders & invoices to print invoices
+1 SET PSAORDB=""
FOR
SET PSAORDB=$ORDER(PSAORD(PSAORDB))
if PSAORDB=""!(PSAOUT)
QUIT
Begin DoDot:1
+2 SET PSAORD=""
FOR
SET PSAORD=$ORDER(PSAORD(PSAORDB,PSAORD))
if PSAORD=""!(PSAOUT)
QUIT
Begin DoDot:2
+3 FOR PSAPC=1:1
SET PSAINV=$PIECE(PSAORD(PSAORDB,PSAORD),",",PSAPC)
if PSAINV=""!(PSAOUT)
QUIT
Begin DoDot:3
+4 IF PSAORD
DO ^PSAORDP1
QUIT
+5 ;DAVEB (PSA*3*7)
+6 SET PSACTRL=$PIECE(PSAINV,"~",2)
SET PSAINV=$PIECE(PSAINV,"~")
SET IOM=80
+7 IF $DATA(PSA(PSAORDB,$PIECE(PSAINV,"~")))
SET PSAINV=$PIECE(PSAINV,"~")
SET PSACTRL=$ORDER(PSA(PSAORDB,PSAINV,0))
+8 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET PSARUN=$EXTRACT(Y,1,18)
SET PSAPAGE=1
SET $PIECE(PSASLN,"-",80)=""
SET $PIECE(PSADLN,"=",80)=""
SET PSADJDRG=0
SET PSAFPG=1
+9 DO START^PSAUP4
End DoDot:3
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
ORDER ;Select order
+1 KILL PSAORD
SET PSADONE=0
+2 FOR
WRITE !
SET DIR(0)="FO^1:22"
SET DIR("A")="Select ORDER NUMBER"
SET DIR("?")="Enter the number of the order to be printed"
SET DIR("??")="^D ORDHELP^PSAORDP"
DO ^DIR
KILL DIR
Begin DoDot:1
+3 IF $GET(DTOUT)!($GET(DUOUT))
SET PSAOUT=1
QUIT
+4 if X=" "
QUIT
+5 IF X=""
SET PSADONE=1
QUIT
+6 IF $ORDER(^PSD(58.811,"B",Y,0))
SET PSAORD(Y,+$ORDER(^PSD(58.811,"B",Y,0)))=""
+7 SET PSACTRL=0
FOR
SET PSACTRL=$ORDER(^XTMP("PSAPV",PSACTRL))
if PSACTRL=""!(PSADONE)
QUIT
IF $PIECE($GET(^XTMP("PSAPV",PSACTRL,"IN")),"^",4)=Y
SET PSAORD(Y,0)=""
SET PSADONE=1
+8 SET PSADONE=0
+9 IF '$DATA(PSAORD(X))
WRITE !,Y_" is an invalid order number."
End DoDot:1
if PSAOUT!(PSADONE)
QUIT
+10 QUIT
+11 ;
PRTORD ;Loops thru invoices to print all for one order
+1 SET PSAORDB=""
FOR
SET PSAORDB=$ORDER(PSAORD(PSAORDB))
if PSAORDB=""!(PSAOUT)
QUIT
Begin DoDot:1
+2 SET PSAORD=""
FOR
SET PSAORD=$ORDER(PSAORD(PSAORDB,PSAORD))
if PSAORD=""!(PSAOUT)
QUIT
Begin DoDot:2
+3 IF 'PSAORD
SET PSACTRL=0
FOR
SET PSACTRL=$ORDER(^XTMP("PSAPV",PSACTRL))
if PSACTRL=""!(PSAOUT)
QUIT
Begin DoDot:3
+4 if $PIECE($GET(^XTMP("PSAPV",PSACTRL,"IN")),"^",4)'=PSAORDB
QUIT
+5 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET PSARUN=$EXTRACT(Y,1,18)
SET PSAPAGE=1
SET $PIECE(PSASLN,"-",80)=""
SET $PIECE(PSADLN,"=",80)=""
SET PSADJDRG=0
SET PSAFPG=1
+6 SET PSAINV=$PIECE($GET(^XTMP("PSAPV",PSACTRL,"IN")),"^",2)
DO START^PSAUP4
End DoDot:3
+7 IF PSAORD
SET PSAINVB=""
FOR
SET PSAINVB=$ORDER(^PSD(58.811,PSAORD,1,"B",PSAINVB))
if PSAINVB=""!(PSAOUT)
QUIT
SET PSAINV=$ORDER(^PSD(58.811,PSAORD,1,"B",PSAINVB,0))
DO ^PSAORDP1
End DoDot:2
End DoDot:1
+8 GOTO EXIT
+9 ;
STATUS ;Select status
+1 WRITE !
SET DIR(0)="SOB^U:Unprocessed;P:Processed"
SET DIR("A")="Select Unprocessed or Processed Invoice Status"
SET DIR("??")="^D STATHELP^PSAORDP"
+2 DO ^DIR
KILL DIR
IF $GET(DIRUT)
SET PSAOUT=1
QUIT
+3 SET PSASTA=Y
+4 IF PSASTA="P"
IF '$ORDER(^PSD(58.811,"ASTAT","P",0))
WRITE !!,"There are no invoices with the status of Processed."
GOTO STATUS
+5 IF PSASTA="U"
Begin DoDot:1
+6 SET (PSACNT,PSACTRL)=0
FOR
SET PSACTRL=$ORDER(^XTMP("PSAPV",PSACTRL))
if PSACTRL=""!(PSACNT)
QUIT
IF $DATA(^XTMP("PSAPV",PSACTRL,"IN"))
IF $PIECE(^("IN"),"^",8)'="P"
SET PSACNT=1
+7 IF 'PSACNT
WRITE !!,"There are no invoices with the status of Unprocessed."
End DoDot:1
if 'PSACNT
GOTO STATUS
+8 QUIT
+9 ;
PRTSTA ;Sets up printing & prints Unprocessed invoices
+1 if PSASTA="P"
GOTO PROCESS
+2 SET PSACTRL=0
FOR
SET PSACTRL=$ORDER(^XTMP("PSAPV",PSACTRL))
if PSACTRL=""!(PSAOUT)
QUIT
Begin DoDot:1
+3 if $PIECE($GET(^XTMP("PSAPV",PSACTRL,"IN")),"^",8)="P"
QUIT
+4 SET IOM=80
DO NOW^%DTC
SET Y=%
DO DD^%DT
SET PSARUN=$EXTRACT(Y,1,18)
SET PSAPAGE=1
SET $PIECE(PSASLN,"-",80)=""
SET $PIECE(PSADLN,"=",80)=""
SET PSADJDRG=0
SET PSAFPG=1
+5 DO START^PSAUP4
End DoDot:1
+6 QUIT
+7 ;
PROCESS ;Prints Processed invoices
+1 ;S PSAORDB="" F S PSAORDB=$O(^PSD(58.811,"AORD",PSAORDB)) Q:PSAORDB=""!(PSAOUT) D
+2 ;.S PSAINVB="" F S PSAINVB=$O(^PSD(58.811,"AORD",PSAORDB,PSAINVB)) Q:PSAINVB=""!(PSAOUT) D
+3 ;..S PSAORD=0 F S PSAORD=$O(^PSD(58.811,"AORD",PSAORDB,PSAINVB,PSAORD)) Q:'PSAORD!(PSAOUT) D
+4 ;...S PSAINV=0 F S PSAINV=$O(^PSD(58.811,"AORD",PSAORDB,PSAINVB,PSAORD,PSAINV)) Q:'PSAINV!(PSAOUT) D ^PSAORDP1
+5 SET PSAORD=0
FOR
SET PSAORD=$ORDER(^PSD(58.811,"ASTAT","P",PSAORD))
if 'PSAORD!(PSAOUT)
QUIT
Begin DoDot:1
+6 SET PSAINV=0
FOR
SET PSAINV=$ORDER(^PSD(58.811,"ASTAT","P",PSAORD,PSAINV))
if 'PSAINV!(PSAOUT)
QUIT
Begin DoDot:2
+7 SET PSAORDB=$PIECE($GET(^PSD(58.811,PSAORD,0)),"^")
SET PSAINVB=$PIECE($GET(^PSD(58.811,PSAORD,1,PSAINV,0)),"^")
if PSAORDB=""!(PSAINVB="")
QUIT
DO ^PSAORDP1
End DoDot:2
End DoDot:1
+8 GOTO EXIT
+9 ;
ORDHELP ;Extended help to Select Order
+1 WRITE !?5,"Enter the order number assigned to the order to be print."
+2 QUIT
ORDIHELP ;Extended help to Select Invoice's Order
+1 WRITE !?5,"Enter the invoice's order number to be print. The invoice number ",!?5,"prompt will follow."
+2 QUIT
SELHELP ;Extended help to Print by Order#, Invoice#, or Invoice Status
+1 WRITE !?5,"To print all invoices for a specific order, select Order Number.",!?5,"To print a specific invoice, select Invoice Number. To print all"
+2 WRITE !?5,"invoices with an unprocessed or processed status, select Invoice",!?5,"Status."
+3 QUIT
STATHELP ;Extended help for Enter Status
+1 WRITE !?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."
+2 QUIT
