- PSDREPD ;BIR/BJW-Invoice Review by Date Range ; 12 Feb 98
- ;;3.0; CONTROLLED SUBSTANCES ;**6,8**;13 Feb 97
- ;chgs made for drug acct 8 Oct 97
- ;**Y2K compliance**,"P" added to date input string
- I '$D(PSDSITE) W ! D ^PSDSET Q:'$D(PSDSITE)
- I '$D(^XUSEC("PSJ RPHARM",DUZ)) W $C(7),!!,?9,"** Please contact your Pharmacy Coordinator for access to print",!,?12,"the Invoice Review Report. PSJ RPHARM security key required.",! Q
- S PSDS=0 F S PSDS=$O(^PSD(58.8,"ADISP","M",PSDS)) Q:'PSDS I $P($G(^PSD(58.8,+PSDS,0)),"^",3)=+PSDSITE&('$G(^PSD(58.8,+PSDS,"I"))!($G(^PSD(58.8,+PSDS,"I"))>DT)) S PSDC=$G(PSDC)+1,PSDONE=PSDS
- I '$G(PSDC) W !!,"Sorry, no Master Vaults set up for this site.",!! G END
- S:PSDC=1 PSDS=PSDONE
- I PSDC>1 D G:Y<1 END S PSDS=+Y W !
- .S DIC="^PSD(58.8,",DIC(0)="AEQ",DIC("A")="Select Dispensing Site: "
- .S:$P($G(^PSD(58.8,+$P(PSDSITE,"^",3),0)),"^",2)["M" DIC("B")=$P(PSDSITE,"^",4)
- .S DIC("S")="I $P($G(^(0)),U,3)=+PSDSITE,$P($G(^(0)),U,2)[""M"",$S('$G(^(""I"")):1,+^(""I"")>DT:1,1:0)"
- .W ! D ^DIC K DIC S $P(PSDSITE,"^",3)=+Y,$P(PSDSITE,"^",4)=$P(Y,"^",2)
- W !,"Select Invoice Date Range",!
- DATE ;ask date range
- K %DT S %DT="AEP",%DT("A")="Start with Date: " D ^%DT I Y<0 S PSDOUT=1 G END
- S PSDSD=Y D D^DIQ S PSDATE=Y,%DT("A")="End with Date: " W ! D ^%DT I Y<0 S PSDOUT=1 G END
- I Y<PSDSD W !!,"The ending date of the range must be later than the starting date." G DATE
- S PSDED=Y D D^DIQ S PSDATE=PSDATE_"^"_Y,PSDSD=PSDSD-.0001,PSDED=PSDED+.9999
- SUM ;if summary only
- W ! K DA,DIR,DIRUT S DIR(0)="Y",DIR("A")="Do you want to print the invoice numbers only",DIR("B")="NO"
- S DIR("?",1)="Answer 'YES' to print only the invoice numbers for this report,",DIR("?")="answer 'NO' to print the detailed report including drug totals."
- D ^DIR K DIR G:$D(DIRUT) END S PSDSUM=Y
- D NOW^%DTC S PSDT=X,Y=% X ^DD("DD") S PSDT(1)=Y
- DEV ;asks device and queueing information
- W !!,"This report is designed for a 80 column format.",!,"You may queue this report to print at a later time.",!
- S Y=$P($G(^PSD(58.8,+$P(PSDSITE,"^",3),2)),"^",9),C=$P(^DD(58.8,24,0),"^",2) D Y^DIQ S PSDEV=Y
- K %ZIS,IOP,IO("Q") S %ZIS="QM",%ZIS("B")=PSDEV D ^%ZIS
- I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED!" S PSDOUT=1 G END
- I $D(IO("Q")) D G END
- .K IO("Q") S ZTIO=ION,ZTRTN="START^PSDREPD",ZTDESC="CS Invoice Report data"
- .S ZTSAVE("PSDSUM")="",ZTSAVE("PSDSITE")="",ZTSAVE("PSD*")=""
- .D ^%ZTLOAD,HOME^%ZIS K ZTSK S PSDOUT=1
- U IO
- START S (PSDPG,PSDOUT)=0,PSDSD(1)=PSDSD,$P(PSDSLN,"-",81)="" D HDR G:PSDOUT END
- F S PSDSD=$O(^PSD(58.81,"AF",PSDSD)) Q:PSDSD>PSDED!('PSDSD)!(PSDOUT) S PSDTR=0 F S PSDTR=$O(^PSD(58.81,"AF",PSDSD,PSDS,1,PSDTR)) Q:'PSDTR!(PSDOUT) D
- .S PSD0=$G(^PSD(58.81,+PSDTR,0)),PSDINV=$P($G(^PSD(58.81,+PSDTR,8)),"^")
- .S PSDORD=$S(+$P(PSD0,"^",9)&($P($G(^PRC(442,+$P(PSD0,"^",9),0)),"^")'=""):$P($G(^PRC(442,+$P(PSD0,"^",9),0)),"^"),$P($G(^PSD(58.81,+PSDTR,8)),"^",2)'="":$P($G(^PSD(58.81,+PSDTR,8)),"^",2),1:"UNKNOWN")
- .Q:PSDINV="" S:'$D(^TMP("PSD",$J,PSDINV,PSDORD)) ^TMP("PSD",$J,PSDINV,PSDORD)=0
- ;
- I PSDSUM S PSDINV="" D G END
- .F S PSDINV=$O(^TMP("PSD",$J,PSDINV)) Q:PSDINV=""!(PSDOUT) S PSDFND=0,PSDORD="" D
- ..F S PSDORD=$O(^TMP("PSD",$J,PSDINV,PSDORD)) Q:PSDORD=""!(PSDOUT) D
- ...S PSDTR=0 F S PSDTR=+$O(^PSD(58.81,"PV",PSDINV,PSDTR)) Q:'PSDTR S PSD0=$G(^PSD(58.81,PSDTR,0)) D:$P(PSD0,"^",4)>PSDSD(1)&($P(PSD0,"^",4)'>PSDED) Q:PSDOUT!(PSDFND)
- ....Q:PSDORD'=$P($G(^PRC(442,+$P(PSD0,"^",9),0)),"^")&(PSDORD'=$P($G(^PSD(58.81,PSDTR,8)),"^",2))
- ....Q:'+$P($G(^PSD(58.81,PSDTR,"CS")),"^")
- ....D:$Y+5>IOSL HEADER Q:PSDOUT S PSDDT=$P(PSD0,"^",4)
- ....W !!,$$FMTE^XLFDT(PSDDT,"1P"),?26,PSDINV,?38,PSDORD,?54
- ....W $E($P($G(^VA(200,+$P(PSD0,"^",7),0)),"^"),1,26) S PSDFND=1
- ;
- S PSDINV="" F S PSDINV=$O(^TMP("PSD",$J,PSDINV)) Q:PSDINV=""!(PSDOUT) S PSDORD="" D
- .F S PSDORD=$O(^TMP("PSD",$J,PSDINV,PSDORD)) Q:PSDORD=""!(PSDOUT) D
- ..S PSDFIRST=2,PSDTR=0 F S PSDTR=+$O(^PSD(58.81,"PV",PSDINV,PSDTR)) Q:'PSDTR S PSD0=$G(^PSD(58.81,PSDTR,0)) D:$P(PSD0,"^",4)>PSDSD(1)&($P(PSD0,"^",4)'>PSDED) Q:PSDOUT
- ...Q:PSDORD'=$P($G(^PRC(442,+$P(PSD0,"^",9),0)),"^")&(PSDORD'=$P($G(^PSD(58.81,PSDTR,8)),"^",2))
- ...Q:'+$P($G(^PSD(58.81,PSDTR,"CS")),"^")
- ...I $Y+5>IOSL D HEADER Q:PSDOUT
- ...I PSDFIRST=2 W !!,"Invoice Number ==> ",PSDINV," Order Number ==> ",PSDORD S PSDFIRST=0
- ...I PSDFIRST=1 W !!,"Invoice Number ==> ",PSDINV," Order Number ==> ",PSDORD W " (Continued)" S PSDFIRST=0
- ...W !!,$E($P($G(^PSDRUG(+$P(PSD0,"^",5),0)),"^"),1,30),?32
- ...W $J($P(PSD0,"^",6),8),?41
- ...W $P($G(^PSDRUG(+$P(PSD0,"^",5),660)),"^",8),?50
- ...W $E($P($G(^VA(200,+$P(PSD0,"^",7),0)),"^"),1,18),?72
- ...W $$FMTE^XLFDT($P(PSD0,"^",4),"2D")
- ;
- END W:$E(IOST)'="C" @IOF
- I $E(IOST)="C",'$G(PSDOUT) D
- .S PSDSS=21-$Y F PSDKK=1:1:PSDSS W !
- .S DIR(0)="EA",DIR("A")="END OF REPORT! Press <RET> to return to the menu." D ^DIR K DIR S:$G(DIRUT) PSDOUT=1 W @IOF
- K %,%DT,%H,%I,%ZIS,C,DA,DIR,DIRUT,DUOUT,DTOUT,IO("Q"),POP,PSD0,PSDATE,PSDC,PSDDT,PSDED,PSDEV,PSDFIRST,PSDFND
- K PSDINV,PSDKK,PSDLOC,PSDONE,PSDORD,PSDOUT,PSDPG,PSDS,PSDSD,PSDSLN,PSDSS,PSDSUM,PSDT,PSDTR,X,Y,ZTDESC,ZTIO,ZTRTN,ZTSAVE,^TMP("PSD",$J)
- D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
- Q
- I $E(IOST,1,2)'="P-",PSDPG S DIR(0)="E" D ^DIR K DIR I 'Y S PSDOUT=1 Q
- I $$S^%ZTLOAD W !!,"Task #",$G(ZTSK),", ",$G(ZTDESC)," was stopped by ",$P($G(^VA(200,+$G(DUZ),0)),"^"),"." S PSDOUT=1
- HDR W:$Y @IOF S PSDPG=PSDPG+1
- W !?2,$E($S($P($G(^VA(200,+$G(DUZ),.1)),"^",4)]"":$P($G(^(.1)),"^",4),1:$P($P($G(^VA(200,+$G(DUZ),0)),"^"),",",2)),1,20),"'s Invoice Review From "
- W $P(PSDATE,"^")," To ",$P(PSDATE,"^",2),?72,"Page ",PSDPG,!?2,$P($G(^PSD(58.8,PSDS,0)),"^"),!
- W ?45,"Report Date: ",PSDT(1)
- I PSDSUM W !!,"Date",?26,"Invoice#",?38,"Order#",?50,"Received By",!,PSDSLN Q
- W !!?5,"Drug",?34,"Quantity Received By Date",!,PSDSLN
- S:PSDPG PSDFIRST=1
- Q
- PSDREPD ;BIR/BJW-Invoice Review by Date Range ; 12 Feb 98
- +1 ;;3.0; CONTROLLED SUBSTANCES ;**6,8**;13 Feb 97
- +2 ;chgs made for drug acct 8 Oct 97
- +3 ;**Y2K compliance**,"P" added to date input string
- +4 IF '$DATA(PSDSITE)
- WRITE !
- DO ^PSDSET
- IF '$DATA(PSDSITE)
- QUIT
- +5 IF '$DATA(^XUSEC("PSJ RPHARM",DUZ))
- WRITE $CHAR(7),!!,?9,"** Please contact your Pharmacy Coordinator for access to print",!,?12,"the Invoice Review Report. PSJ RPHARM security key required.",!
- QUIT
- +6 SET PSDS=0
- FOR
- SET PSDS=$ORDER(^PSD(58.8,"ADISP","M",PSDS))
- IF 'PSDS
- QUIT
- IF $PIECE($GET(^PSD(58.8,+PSDS,0)),"^",3)=+PSDSITE&('$GET(^PSD(58.8,+PSDS,"I"))!($GET(^PSD(58.8,+PSDS,"I"))>DT))
- SET PSDC=$GET(PSDC)+1
- SET PSDONE=PSDS
- +7 IF '$GET(PSDC)
- WRITE !!,"Sorry, no Master Vaults set up for this site.",!!
- GOTO END
- +8 IF PSDC=1
- SET PSDS=PSDONE
- +9 IF PSDC>1
- Begin DoDot:1
- +10 SET DIC="^PSD(58.8,"
- SET DIC(0)="AEQ"
- SET DIC("A")="Select Dispensing Site: "
- +11 IF $PIECE($GET(^PSD(58.8,+$PIECE(PSDSITE,"^",3),0)),"^",2)["M"
- SET DIC("B")=$PIECE(PSDSITE,"^",4)
- +12 SET DIC("S")="I $P($G(^(0)),U,3)=+PSDSITE,$P($G(^(0)),U,2)[""M"",$S('$G(^(""I"")):1,+^(""I"")>DT:1,1:0)"
- +13 WRITE !
- DO ^DIC
- KILL DIC
- SET $PIECE(PSDSITE,"^",3)=+Y
- SET $PIECE(PSDSITE,"^",4)=$PIECE(Y,"^",2)
- End DoDot:1
- IF Y<1
- GOTO END
- SET PSDS=+Y
- WRITE !
- +14 WRITE !,"Select Invoice Date Range",!
- DATE ;ask date range
- +1 KILL %DT
- SET %DT="AEP"
- SET %DT("A")="Start with Date: "
- DO ^%DT
- IF Y<0
- SET PSDOUT=1
- GOTO END
- +2 SET PSDSD=Y
- DO D^DIQ
- SET PSDATE=Y
- SET %DT("A")="End with Date: "
- WRITE !
- DO ^%DT
- IF Y<0
- SET PSDOUT=1
- GOTO END
- +3 IF Y<PSDSD
- WRITE !!,"The ending date of the range must be later than the starting date."
- GOTO DATE
- +4 SET PSDED=Y
- DO D^DIQ
- SET PSDATE=PSDATE_"^"_Y
- SET PSDSD=PSDSD-.0001
- SET PSDED=PSDED+.9999
- SUM ;if summary only
- +1 WRITE !
- KILL DA,DIR,DIRUT
- SET DIR(0)="Y"
- SET DIR("A")="Do you want to print the invoice numbers only"
- SET DIR("B")="NO"
- +2 SET DIR("?",1)="Answer 'YES' to print only the invoice numbers for this report,"
- SET DIR("?")="answer 'NO' to print the detailed report including drug totals."
- +3 DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)
- GOTO END
- SET PSDSUM=Y
- +4 DO NOW^%DTC
- SET PSDT=X
- SET Y=%
- XECUTE ^DD("DD")
- SET PSDT(1)=Y
- DEV ;asks device and queueing information
- +1 WRITE !!,"This report is designed for a 80 column format.",!,"You may queue this report to print at a later time.",!
- +2 SET Y=$PIECE($GET(^PSD(58.8,+$PIECE(PSDSITE,"^",3),2)),"^",9)
- SET C=$PIECE(^DD(58.8,24,0),"^",2)
- DO Y^DIQ
- SET PSDEV=Y
- +3 KILL %ZIS,IOP,IO("Q")
- SET %ZIS="QM"
- SET %ZIS("B")=PSDEV
- DO ^%ZIS
- +4 IF POP
- WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED!"
- SET PSDOUT=1
- GOTO END
- +5 IF $DATA(IO("Q"))
- Begin DoDot:1
- +6 KILL IO("Q")
- SET ZTIO=ION
- SET ZTRTN="START^PSDREPD"
- SET ZTDESC="CS Invoice Report data"
- +7 SET ZTSAVE("PSDSUM")=""
- SET ZTSAVE("PSDSITE")=""
- SET ZTSAVE("PSD*")=""
- +8 DO ^%ZTLOAD
- DO HOME^%ZIS
- KILL ZTSK
- SET PSDOUT=1
- End DoDot:1
- GOTO END
- +9 USE IO
- START SET (PSDPG,PSDOUT)=0
- SET PSDSD(1)=PSDSD
- SET $PIECE(PSDSLN,"-",81)=""
- DO HDR
- IF PSDOUT
- GOTO END
- +1 FOR
- SET PSDSD=$ORDER(^PSD(58.81,"AF",PSDSD))
- IF PSDSD>PSDED!('PSDSD)!(PSDOUT)
- QUIT
- SET PSDTR=0
- FOR
- SET PSDTR=$ORDER(^PSD(58.81,"AF",PSDSD,PSDS,1,PSDTR))
- IF 'PSDTR!(PSDOUT)
- QUIT
- Begin DoDot:1
- +2 SET PSD0=$GET(^PSD(58.81,+PSDTR,0))
- SET PSDINV=$PIECE($GET(^PSD(58.81,+PSDTR,8)),"^")
- +3 SET PSDORD=$SELECT(+$PIECE(PSD0,"^",9)&($PIECE($GET(^PRC(442,+$PIECE(PSD0,"^",9),0)),"^")'=""):$PIECE($GET(^PRC(442,+$PIECE(PSD0,"^",9),0)),"^"),$PIECE($GET(^PSD(58.81,+PSDTR,8)),"^",2)'="":$PIECE($GET(^PSD(58.81,+PSDTR,8)),"^",2),1
- :"UNKNOWN")
- +4 IF PSDINV=""
- QUIT
- IF '$DATA(^TMP("PSD",$JOB,PSDINV,PSDORD))
- SET ^TMP("PSD",$JOB,PSDINV,PSDORD)=0
- End DoDot:1
- +5 ;
- +6 IF PSDSUM
- SET PSDINV=""
- Begin DoDot:1
- +7 FOR
- SET PSDINV=$ORDER(^TMP("PSD",$JOB,PSDINV))
- IF PSDINV=""!(PSDOUT)
- QUIT
- SET PSDFND=0
- SET PSDORD=""
- Begin DoDot:2
- +8 FOR
- SET PSDORD=$ORDER(^TMP("PSD",$JOB,PSDINV,PSDORD))
- IF PSDORD=""!(PSDOUT)
- QUIT
- Begin DoDot:3
- +9 SET PSDTR=0
- FOR
- SET PSDTR=+$ORDER(^PSD(58.81,"PV",PSDINV,PSDTR))
- IF 'PSDTR
- QUIT
- SET PSD0=$GET(^PSD(58.81,PSDTR,0))
- IF $PIECE(PSD0,"^",4)>PSDSD(1)&($PIECE(PSD0,"^",4)'>PSDED)
- Begin DoDot:4
- +10 IF PSDORD'=$PIECE($GET(^PRC(442,+$PIECE(PSD0,"^",9),0)),"^")&(PSDORD'=$PIECE($GET(^PSD(58.81,PSDTR,8)),"^",2))
- QUIT
- +11 IF '+$PIECE($GET(^PSD(58.81,PSDTR,"CS")),"^")
- QUIT
- +12 IF $Y+5>IOSL
- DO HEADER
- IF PSDOUT
- QUIT
- SET PSDDT=$PIECE(PSD0,"^",4)
- +13 WRITE !!,$$FMTE^XLFDT(PSDDT,"1P"),?26,PSDINV,?38,PSDORD,?54
- +14 WRITE $EXTRACT($PIECE($GET(^VA(200,+$PIECE(PSD0,"^",7),0)),"^"),1,26)
- SET PSDFND=1
- End DoDot:4
- IF PSDOUT!(PSDFND)
- QUIT
- End DoDot:3
- End DoDot:2
- End DoDot:1
- GOTO END
- +15 ;
- +16 SET PSDINV=""
- FOR
- SET PSDINV=$ORDER(^TMP("PSD",$JOB,PSDINV))
- IF PSDINV=""!(PSDOUT)
- QUIT
- SET PSDORD=""
- Begin DoDot:1
- +17 FOR
- SET PSDORD=$ORDER(^TMP("PSD",$JOB,PSDINV,PSDORD))
- IF PSDORD=""!(PSDOUT)
- QUIT
- Begin DoDot:2
- +18 SET PSDFIRST=2
- SET PSDTR=0
- FOR
- SET PSDTR=+$ORDER(^PSD(58.81,"PV",PSDINV,PSDTR))
- IF 'PSDTR
- QUIT
- SET PSD0=$GET(^PSD(58.81,PSDTR,0))
- IF $PIECE(PSD0,"^",4)>PSDSD(1)&($PIECE(PSD0,"^",4)'>PSDED)
- Begin DoDot:3
- +19 IF PSDORD'=$PIECE($GET(^PRC(442,+$PIECE(PSD0,"^",9),0)),"^")&(PSDORD'=$PIECE($GET(^PSD(58.81,PSDTR,8)),"^",2))
- QUIT
- +20 IF '+$PIECE($GET(^PSD(58.81,PSDTR,"CS")),"^")
- QUIT
- +21 IF $Y+5>IOSL
- DO HEADER
- IF PSDOUT
- QUIT
- +22 IF PSDFIRST=2
- WRITE !!,"Invoice Number ==> ",PSDINV," Order Number ==> ",PSDORD
- SET PSDFIRST=0
- +23 IF PSDFIRST=1
- WRITE !!,"Invoice Number ==> ",PSDINV," Order Number ==> ",PSDORD
- WRITE " (Continued)"
- SET PSDFIRST=0
- +24 WRITE !!,$EXTRACT($PIECE($GET(^PSDRUG(+$PIECE(PSD0,"^",5),0)),"^"),1,30),?32
- +25 WRITE $JUSTIFY($PIECE(PSD0,"^",6),8),?41
- +26 WRITE $PIECE($GET(^PSDRUG(+$PIECE(PSD0,"^",5),660)),"^",8),?50
- +27 WRITE $EXTRACT($PIECE($GET(^VA(200,+$PIECE(PSD0,"^",7),0)),"^"),1,18),?72
- +28 WRITE $$FMTE^XLFDT($PIECE(PSD0,"^",4),"2D")
- End DoDot:3
- IF PSDOUT
- QUIT
- End DoDot:2
- End DoDot:1
- +29 ;
- END IF $EXTRACT(IOST)'="C"
- WRITE @IOF
- +1 IF $EXTRACT(IOST)="C"
- IF '$GET(PSDOUT)
- Begin DoDot:1
- +2 SET PSDSS=21-$Y
- FOR PSDKK=1:1:PSDSS
- WRITE !
- +3 SET DIR(0)="EA"
- SET DIR("A")="END OF REPORT! Press <RET> to return to the menu."
- DO ^DIR
- KILL DIR
- IF $GET(DIRUT)
- SET PSDOUT=1
- WRITE @IOF
- End DoDot:1
- +4 KILL %,%DT,%H,%I,%ZIS,C,DA,DIR,DIRUT,DUOUT,DTOUT,IO("Q"),POP,PSD0,PSDATE,PSDC,PSDDT,PSDED,PSDEV,PSDFIRST,PSDFND
- +5 KILL PSDINV,PSDKK,PSDLOC,PSDONE,PSDORD,PSDOUT,PSDPG,PSDS,PSDSD,PSDSLN,PSDSS,PSDSUM,PSDT,PSDTR,X,Y,ZTDESC,ZTIO,ZTRTN,ZTSAVE,^TMP("PSD",$JOB)
- +6 DO ^%ZISC
- IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +7 QUIT
- +1 IF $EXTRACT(IOST,1,2)'="P-"
- IF PSDPG
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF 'Y
- SET PSDOUT=1
- QUIT
- +2 IF $$S^%ZTLOAD
- WRITE !!,"Task #",$GET(ZTSK),", ",$GET(ZTDESC)," was stopped by ",$PIECE($GET(^VA(200,+$GET(DUZ),0)),"^"),"."
- SET PSDOUT=1
- HDR IF $Y
- WRITE @IOF
- SET PSDPG=PSDPG+1
- +1 WRITE !?2,$EXTRACT($SELECT($PIECE($GET(^VA(200,+$GET(DUZ),.1)),"^",4)]"":$PIECE($GET(^(.1)),"^",4),1:$PIECE($PIECE($GET(^VA(200,+$GET(DUZ),0)),"^"),",",2)),1,20),"'s Invoice Review From "
- +2 WRITE $PIECE(PSDATE,"^")," To ",$PIECE(PSDATE,"^",2),?72,"Page ",PSDPG,!?2,$PIECE($GET(^PSD(58.8,PSDS,0)),"^"),!
- +3 WRITE ?45,"Report Date: ",PSDT(1)
- +4 IF PSDSUM
- WRITE !!,"Date",?26,"Invoice#",?38,"Order#",?50,"Received By",!,PSDSLN
- QUIT
- +5 WRITE !!?5,"Drug",?34,"Quantity Received By Date",!,PSDSLN
- +6 IF PSDPG
- SET PSDFIRST=1
- +7 QUIT
