source: FOIAVistA/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAPV.m@ 1754

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

initial load of FOIAVistA 6/30/08 version
File size: 4.8 KB
Line 
1PSAPV ;BIR/JMB-Processor and Verifier ;9/6/97
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**15**; 10/24/97
3 ;This routine prints the order number, invoice number, invoice date,
4 ;processor's name, process date, verifier's name, and verification
5 ;date for a specified invoice date range.
6 ;
7 I '$D(^XUSEC("PSA ORDERS",DUZ)) W !,"You do not hold the key to enter the option." Q
8 I '$O(^PSD(58.811,"ADATE",0)) W !,"There are no invoices." G EXIT
9 S PSAOUT=0 D BDATE G:PSAOUT EXIT
10DEVICE ;Asks device & queueing info
11 W !!,"The report must be sent to a printer that supports 132 columns.",!
12DEV K IO("Q"),%ZIS,IOP,POP S %ZIS="Q",%ZIS("B")="",IOM=132
13 D ^%ZIS I POP W !,"NO DEVICE SELECTED OR OUTPUT PRINTED!" Q
14 ;I $E(IOST)["C"!($G(IOM)<132) W !,"The printout must be sent to a 132 column printer!",! G DEV
15 I $D(IO("Q")) D G EXIT
16 .N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTDTH,ZTSK
17 .S ZTRTN="COMPILE^PSAPV",ZTDESC="Drug Acct. - Processor and Verifier Report"
18 .S:$D(PSABEG) ZTSAVE("PSABEG")="" S:$D(PSAEND) ZTSAVE("PSAEND")=""
19 .D ^%ZTLOAD
20 ;
21COMPILE ;Compiles data
22 S PSAOUT=0,X1=PSABEG,X2=-1 D C^%DTC S PSADATE=X_.239999
23 F S PSADATE=+$O(^PSD(58.811,"ADATE",PSADATE)) Q:'PSADATE!(PSADATE>PSAEND)!(PSAOUT) D
24 .S PSAIEN=0 F S PSAIEN=+$O(^PSD(58.811,"ADATE",PSADATE,PSAIEN)) Q:'PSAIEN!(PSAOUT) D
25 ..Q:'$D(^PSD(58.811,PSAIEN,0)) S PSAORD=$P(^PSD(58.811,PSAIEN,0),"^"),PSAIEN1=0
26 ..F S PSAIEN1=+$O(^PSD(58.811,"ADATE",PSADATE,PSAIEN,PSAIEN1)) Q:'PSAIEN1!(PSAOUT) D
27 ...Q:'$D(^PSD(58.811,PSAIEN,1,PSAIEN1,0))
28 ...S PSAIN=^PSD(58.811,PSAIEN,1,PSAIEN1,0),PSAINV=$P(PSAIN,"^"),PSAINVDT=$P(PSAIN,"^",2),PSAPROC=+$P(PSAIN,"^",10),PSAVER=+$P(PSAIN,"^",11)
29 ...S PSAPROC=$S($P($G(^VA(200,PSAPROC,0)),"^")'="":$P($G(^VA(200,PSAPROC,0)),"^"),1:"")
30 ...S PSAVER=$S($P($G(^VA(200,PSAVER,0)),"^")'="":$P($G(^VA(200,PSAVER,0)),"^"),1:"")
31 ...S (PSALINE,PSAPROCD,PSAVERD)=0
32 ...Q:PSAPROC=""&(PSAVER="")
33 ...F S PSALINE=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE)) Q:'PSALINE!(PSAOUT) D
34 ....Q:'$D(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0))
35 ....S PSADATA=^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0) S:PSAPROCD<$P(PSADATA,"^",6) PSAPROCD=$P(PSADATA,"^",6) S:PSAVERD<$P(PSADATA,"^",8) PSAVERD=$P(PSADATA,"^",8)
36 ..S PSAINVDT=$S(+PSAINVDT:$E(PSAINVDT,4,5)_"/"_$E(PSAINVDT,6,7)_"/"_$E(PSAINVDT,2,3),1:"UNKNOWN")
37 ..S PSAPROCD=$S(+PSAPROCD&(PSAPROC'=""):$E(PSAPROCD,4,5)_"/"_$E(PSAPROCD,6,7)_"/"_$E(PSAPROCD,2,3),1:"")
38 ..S PSAVERD=$S(+PSAVERD&(PSAVER'=""):$E(PSAVERD,4,5)_"/"_$E(PSAVERD,6,7)_"/"_$E(PSAVERD,2,3),1:"")
39 ..S ^TMP("PSAPVR",$J,PSAORD,PSAINV)=PSAINVDT_"^"_PSAPROC_"^"_PSAPROCD_"^"_PSAVER_"^"_PSAVERD
40 ;
41PRINT ;Print data
42 S Y=PSAEND D DD^%DT S PSAENDX=Y K X,Y,%DT
43 S Y=PSABEG D DD^%DT S PSABEGX=Y K X,Y,%DT
44 D NOW^%DTC S PSARUN=%,PSARUN=$E(PSARUN,4,5)_"/"_$E(PSARUN,6,7)_"/"_$E(PSARUN,2,3)_"@"_$E($P(PSARUN,".",2),1,2)_":"_$E($P(PSARUN,".",2),3,4)
45 S PSAPG=0,PSASLN="",$P(PSASLN,"-",123)="" K Y D HDR
46 S PSAORD="" F S PSAORD=$O(^TMP("PSAPVR",$J,PSAORD)) Q:PSAORD="" D
47 .I $Y+4>IOSL D HDR
48 .W !,"Order #: "_PSAORD,?24,"|",?36,"|",?68,"|",?80,"|",?112,"|"
49 .S PSAINV="" F S PSAINV=$O(^TMP("PSAPVR",$J,PSAORD,PSAINV)) Q:PSAINV="" D
50 ..S PSADATA=^TMP("PSAPVR",$J,PSAORD,PSAINV),PSAINVDT=$P(PSADATA,"^"),PSAPROC=$P(PSADATA,"^",2),PSAPROCD=$P(PSADATA,"^",3),PSAVER=$P(PSADATA,"^",4),PSAVERD=$P(PSADATA,"^",5)
51 ..W !,PSAINV,?24,"|",?26,PSAINVDT,?36,"|",?38,PSAPROC,?68,"|",?70,PSAPROCD,?80,"|",?82,PSAVER,?112,"|",?114,PSAVERD
52 .W !," | | | | |"
53 W !,PSASLN,!
54 ;
55EXIT W @IOF
56 D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" K IO("Q"),^TMP("PSAPVR",$J)
57 K %,%ZIS,DTOUT,PSABEG,PSABEG,PSABEGX,PSADATA,PSADATE,PSAEND,PSAENDX,PSAIEN,PSAIEN1,PSAIN,PSAINV,PSAINVDT
58 K PSALINE,PSAORD,PSAOUT,PSAPG,PSAPROC,PSAPROCD,PSARUN,PSASLN,PSAVER,PSAVERD,X,X1,X2,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
59 Q
60 ;
61BDATE ;Gets beginning and ending invoice dates
62 W ! S %DT="AEP",%DT("A")="Beginning Date: " D ^%DT
63 I +Y<1!($D(DTOUT))!(X["^")!(X']"") S PSAOUT=1 Q
64 I Y>DT K X,Y,%DT W !!,"Future dates are not permitted.",! K X,Y,%DT G BDATE
65 S PSABEG=+Y
66EDATE W ! S %DT="AE",%DT("A")="Ending Date : " D ^%DT
67 I +Y<1!($D(DTOUT))!(X["^")!(X']"") S PSAOUT=1 Q
68 I Y<PSABEG K X,Y,%DT W !!,"Ending Date cannot be before the Start Date.",! K X,Y,%DT G EDATE
69 S PSAEND=+Y
70 Q
71 ;
72HDR ;Report header
73 I $E(IOST)'="C",PSAPG W !,PSASLN,@IOF
74 S PSAPG=PSAPG+1
75 W !?46,"DRUG ACCOUNTABILITY/INVENTORY INTERFACE",?114,"PAGE "_PSAPG,!?51,"PROCESSOR AND VERIFIER REPORT"
76 I $E(IOST,1,2)="C-" W !,"RUN DATE: "_PSARUN,?52,PSABEGX_" - "_PSAENDX
77 E W !,?52,PSABEGX_" - "_PSAENDX
78 W !!?24,"| INVOICE",?36,"|",?68,"| DATE",?80,"|",?112,"| DATE"
79 W !,"INVOICE#",?24,"| DATE",?36,"| PROCESSOR",?68,"| PROCESSED",?80,"| VERIFIER",?112,"| VERIFIED"
80 W !,"========================|===========|===============================|===========|===============================|========="
81 Q
Note: See TracBrowser for help on using the repository browser.