- 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 Feb 18, 2025@23:16:43 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