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

PSAPV.m

Go to the documentation of this file.
  1. PSAPV ;BIR/JMB-Processor and Verifier ;9/6/97
  1. ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**15**; 10/24/97
  1. ;This routine prints the order number, invoice number, invoice date,
  1. ;processor's name, process date, verifier's name, and verification
  1. ;date for a specified invoice date range.
  1. ;
  1. I '$D(^XUSEC("PSA ORDERS",DUZ)) W !,"You do not hold the key to enter the option." Q
  1. I '$O(^PSD(58.811,"ADATE",0)) W !,"There are no invoices." G EXIT
  1. S PSAOUT=0 D BDATE G:PSAOUT EXIT
  1. DEVICE ;Asks device & queueing info
  1. W !!,"The report must be sent to a printer that supports 132 columns.",!
  1. DEV K IO("Q"),%ZIS,IOP,POP S %ZIS="Q",%ZIS("B")="",IOM=132
  1. D ^%ZIS I POP W !,"NO DEVICE SELECTED OR OUTPUT PRINTED!" Q
  1. ;I $E(IOST)["C"!($G(IOM)<132) W !,"The printout must be sent to a 132 column printer!",! G DEV
  1. I $D(IO("Q")) D G EXIT
  1. .N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTDTH,ZTSK
  1. .S ZTRTN="COMPILE^PSAPV",ZTDESC="Drug Acct. - Processor and Verifier Report"
  1. .S:$D(PSABEG) ZTSAVE("PSABEG")="" S:$D(PSAEND) ZTSAVE("PSAEND")=""
  1. .D ^%ZTLOAD
  1. ;
  1. COMPILE ;Compiles data
  1. S PSAOUT=0,X1=PSABEG,X2=-1 D C^%DTC S PSADATE=X_.239999
  1. F S PSADATE=+$O(^PSD(58.811,"ADATE",PSADATE)) Q:'PSADATE!(PSADATE>PSAEND)!(PSAOUT) D
  1. .S PSAIEN=0 F S PSAIEN=+$O(^PSD(58.811,"ADATE",PSADATE,PSAIEN)) Q:'PSAIEN!(PSAOUT) D
  1. ..Q:'$D(^PSD(58.811,PSAIEN,0)) S PSAORD=$P(^PSD(58.811,PSAIEN,0),"^"),PSAIEN1=0
  1. ..F S PSAIEN1=+$O(^PSD(58.811,"ADATE",PSADATE,PSAIEN,PSAIEN1)) Q:'PSAIEN1!(PSAOUT) D
  1. ...Q:'$D(^PSD(58.811,PSAIEN,1,PSAIEN1,0))
  1. ...S PSAIN=^PSD(58.811,PSAIEN,1,PSAIEN1,0),PSAINV=$P(PSAIN,"^"),PSAINVDT=$P(PSAIN,"^",2),PSAPROC=+$P(PSAIN,"^",10),PSAVER=+$P(PSAIN,"^",11)
  1. ...S PSAPROC=$S($P($G(^VA(200,PSAPROC,0)),"^")'="":$P($G(^VA(200,PSAPROC,0)),"^"),1:"")
  1. ...S PSAVER=$S($P($G(^VA(200,PSAVER,0)),"^")'="":$P($G(^VA(200,PSAVER,0)),"^"),1:"")
  1. ...S (PSALINE,PSAPROCD,PSAVERD)=0
  1. ...Q:PSAPROC=""&(PSAVER="")
  1. ...F S PSALINE=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE)) Q:'PSALINE!(PSAOUT) D
  1. ....Q:'$D(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0))
  1. ....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)
  1. ..S PSAINVDT=$S(+PSAINVDT:$E(PSAINVDT,4,5)_"/"_$E(PSAINVDT,6,7)_"/"_$E(PSAINVDT,2,3),1:"UNKNOWN")
  1. ..S PSAPROCD=$S(+PSAPROCD&(PSAPROC'=""):$E(PSAPROCD,4,5)_"/"_$E(PSAPROCD,6,7)_"/"_$E(PSAPROCD,2,3),1:"")
  1. ..S PSAVERD=$S(+PSAVERD&(PSAVER'=""):$E(PSAVERD,4,5)_"/"_$E(PSAVERD,6,7)_"/"_$E(PSAVERD,2,3),1:"")
  1. ..S ^TMP("PSAPVR",$J,PSAORD,PSAINV)=PSAINVDT_"^"_PSAPROC_"^"_PSAPROCD_"^"_PSAVER_"^"_PSAVERD
  1. ;
  1. PRINT ;Print data
  1. S Y=PSAEND D DD^%DT S PSAENDX=Y K X,Y,%DT
  1. S Y=PSABEG D DD^%DT S PSABEGX=Y K X,Y,%DT
  1. 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)
  1. S PSAPG=0,PSASLN="",$P(PSASLN,"-",123)="" K Y D HDR
  1. S PSAORD="" F S PSAORD=$O(^TMP("PSAPVR",$J,PSAORD)) Q:PSAORD="" D
  1. .I $Y+4>IOSL D HDR
  1. .W !,"Order #: "_PSAORD,?24,"|",?36,"|",?68,"|",?80,"|",?112,"|"
  1. .S PSAINV="" F S PSAINV=$O(^TMP("PSAPVR",$J,PSAORD,PSAINV)) Q:PSAINV="" D
  1. ..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)
  1. ..W !,PSAINV,?24,"|",?26,PSAINVDT,?36,"|",?38,PSAPROC,?68,"|",?70,PSAPROCD,?80,"|",?82,PSAVER,?112,"|",?114,PSAVERD
  1. .W !," | | | | |"
  1. W !,PSASLN,!
  1. ;
  1. EXIT W @IOF
  1. D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" K IO("Q"),^TMP("PSAPVR",$J)
  1. K %,%ZIS,DTOUT,PSABEG,PSABEG,PSABEGX,PSADATA,PSADATE,PSAEND,PSAENDX,PSAIEN,PSAIEN1,PSAIN,PSAINV,PSAINVDT
  1. K PSALINE,PSAORD,PSAOUT,PSAPG,PSAPROC,PSAPROCD,PSARUN,PSASLN,PSAVER,PSAVERD,X,X1,X2,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
  1. Q
  1. ;
  1. BDATE ;Gets beginning and ending invoice dates
  1. W ! S %DT="AEP",%DT("A")="Beginning Date: " D ^%DT
  1. I +Y<1!($D(DTOUT))!(X["^")!(X']"") S PSAOUT=1 Q
  1. I Y>DT K X,Y,%DT W !!,"Future dates are not permitted.",! K X,Y,%DT G BDATE
  1. S PSABEG=+Y
  1. EDATE W ! S %DT="AE",%DT("A")="Ending Date : " D ^%DT
  1. I +Y<1!($D(DTOUT))!(X["^")!(X']"") S PSAOUT=1 Q
  1. I Y<PSABEG K X,Y,%DT W !!,"Ending Date cannot be before the Start Date.",! K X,Y,%DT G EDATE
  1. S PSAEND=+Y
  1. Q
  1. ;
  1. HDR ;Report header
  1. I $E(IOST)'="C",PSAPG W !,PSASLN,@IOF
  1. S PSAPG=PSAPG+1
  1. W !?46,"DRUG ACCOUNTABILITY/INVENTORY INTERFACE",?114,"PAGE "_PSAPG,!?51,"PROCESSOR AND VERIFIER REPORT"
  1. I $E(IOST,1,2)="C-" W !,"RUN DATE: "_PSARUN,?52,PSABEGX_" - "_PSAENDX
  1. E W !,?52,PSABEGX_" - "_PSAENDX
  1. W !!?24,"| INVOICE",?36,"|",?68,"| DATE",?80,"|",?112,"| DATE"
  1. W !,"INVOICE#",?24,"| DATE",?36,"| PROCESSOR",?68,"| PROCESSED",?80,"| VERIFIER",?112,"| VERIFIED"
  1. W !,"========================|===========|===============================|===========|===============================|========="
  1. Q