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