- PSAHIS1 ;BIR/LTL,JMB-Drug Transaction History - CONT'D ;7/23/97
- ;;3.0;DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,69,72,80**; 10/24/97;Build 2
- ;Prints the Show Drug Transaction History report in pharmacy location
- ;then date order. It is called by PSAHIS.
- ;
- PRINT D HEADER S PSADRG="",PSACNT=0
- F S PSADRG=$O(^TMP("PSAHIS",$J,PSADRG)) Q:PSADRG=""!(PSAOUT) K PSABAL,PSATRCNT D:$Y+6>IOSL HEADER Q:PSAOUT S PSADT=0 D Q:PSAOUT
- .F S PSADT=+$O(^TMP("PSAHIS",$J,PSADRG,PSADT)) Q:'PSADT!(PSAOUT) D Q:PSAOUT
- ..S PSATR=0 F S PSATR=+$O(^TMP("PSAHIS",$J,PSADRG,PSADT,PSATR)) Q:'PSATR!(PSAOUT) D:$Y+6>IOSL HEADER Q:PSAOUT D TRANS
- .Q:PSAOUT D:$Y+6>IOSL HEADER Q:PSAOUT D TOTALS
- I 'PSACNT W !!,"No transactions were found for the pharmacy location."
- Q:PSAOUT
- ;
- DONE ;Holds screen or ejects paper if sent to printer
- I $E(IOST,1,2)="C-" D
- .S PSAS=21-$Y F PSASS=1:1:PSAS W !
- .S DIR(0)="EA",DIR("A")="End of pharmacy location's display! Enter RETURN to continue or '^' to exit:" D ^DIR K DIR S:$G(DIRUT) PSAOUT=1
- I $E(IOST)'="C" W !!!,"REPORT RUN: ",PSARUN W @IOF
- Q
- ;
- TRANS S PSATR0=$G(^PSD(58.81,PSATR,0)),PSACNT=1,PSATRCNT=$G(PSATRCNT)+1
- ;If it is first transaction for drug, print drug name & beg balance.
- ;Beg balance = 1st transaction + (receipts(+), adjs(+/-), &
- ;dispensing(-) made prior to beg date & fell within rpt date range)
- I PSATRCNT=1 D
- .W !,?37,"|",?48,"|",?54,"|",?60,"|",?71,"|" D WRAPDRUG
- .S Z=$G(^PSD(58.81,+^TMP("PSA",$J,PSADRG),0))
- .S PSABAL=$P(Z,"^",10)+$G(PSABAD(PSADRG)) W ?72,$J(PSABAL,7)
- ;
- I $P(^PSD(58.81,PSATR,0),"^",2)=14 S PSATR4=$G(^PSD(58.81,PSATR,4))
- ;Print transaction date & +/- qty from balance
- W !,$E(PSADT,4,5)_"-"_$E(PSADT,6,7)_"-"_$E(PSADT,2,3),?10,$S($P(PSATR0,"^",2)=14:$E($P($G(^VA(200,+$P(PSATR4,"^",2),0)),"^"),1,28),1:$E($P($G(^VA(200,+$P(PSATR0,"^",7),0)),"^"),1,28))
- I $P(PSATR0,"^",2)'=24,$P(PSATR0,"^",2)'=9 S PSABAL=$S(",1,10,11,19,"[(","_$P(PSATR0,"^",2)_","):PSABAL+$P(PSATR0,"^",6),1:PSABAL-$P(PSATR0,"^",6)) ;;<<3*72-RJS>>
- I $P(PSATR0,"^",2)=24!($P(PSATR0,"^",2)=9) S PSABAL=PSABAL+$P(PSATR0,"^",6)
- I $P(PSATR0,"^",2)=14 S PSABAL=PSABAL+$P(PSATR4,"^",4)
- ;Receipts
- I $P(PSATR0,"^",2)=1 S PSAWRT=0 W ?37,"|",?41,$J($P(PSATR0,"^",6),6),?48,"|",?54,"|",?60,"|",?71,"|",?72,$J(PSABAL,7),! S PSARECT=$G(PSARECT)+$P(PSATR0,"^",6) D Q
- .I $P($G(^PRC(442,+$P(PSATR0,"^",9),0)),"^") W ?11,"PO# ",$P($G(^(0)),"^"),?37,"|",?48,"|",?54,"|",?60,"|",?71,"|" S PSALN=$G(PSALN)+1 S PSAWRT=1
- .I $P($G(^PRCS(410,+$P(PSATR0,"^",8),0)),"^") W:PSAWRT ! W ?11,"TR# ",$P($G(^(0)),"^"),?37,"|",?48,"|",?54,"|",?60,"|",?71,"|" S PSALN=$G(PSALN)+1,PSAWRT=1
- .I $P($G(^PSD(58.81,PSATR,8)),"^",2)'="" W:PSAWRT ! W ?11,"ORD# ",$P($G(^(8)),"^",2),?37,"|",?48,"|",?54,"|",?60,"|",?71,"|" S PSALN=$G(PSALN)+1,PSAWRT=1
- .I $P($G(^PSD(58.81,PSATR,8)),"^")'="" W:PSAWRT ! W ?11,"INV# ",$P($G(^(8)),"^"),?37,"|",?48,"|",?54,"|",?60,"|",?71,"|" S PSALN=$G(PSALN)+1,PSAWRT=1
- .W:$G(PSAW) !?37,"|",?48,"|",?54,"|",?60,"|",?71,"|" K PSAW
- ;Adjusted or transferred
- I $P(PSATR0,"^",2)=9!($P(PSATR0,"^",2)=11)!($P(PSATR0,"^",2)=24) D Q
- .W ?37,"|",?48,"|",?54,"|",?60,"|",?64,$J($P(PSATR0,"^",6),6),?71,"|",?72,$J(PSABAL,7)
- .I +$P(PSATR0,"^",19) S PSADJDT=$P(PSATR0,"^",19) W !?11,"DATE ENTERED: "_$E(PSADJDT,4,5)_"-"_$E(PSADJDT,6,7)_"-"_$E(PSADJDT,2,3),?37,"|",?48,"|",?54,"|",?60,"|",?71,"|"
- .I $P(PSATR0,"^",2)=9!($P(PSATR0,"^",2)=11),$P(PSATR0,"^",16)'="" D REASON
- .D:$P(PSATR0,"^",2)=24 TRANSFER S PSADJT=$G(PSADJT)+$P(PSATR0,"^",6)
- ;Dispensed by IP (2 means Unit Dose or Ward Stock 15 means IV)
- I $P(PSATR0,"^",2)=2!($P(PSATR0,"^",2)=15) W ?10,"NIGHTLY BACKGROUND JOB",?37,"|",?48,"|",?49,$J($P(PSATR0,"^",6),5),?54,"|",?60,"|",?71,"|",?72,$J(PSABAL,7) S PSAIPT=$G(PSAIPT)+$P(PSATR0,"^",6) Q
- ;Dispensed by OP
- I $P(PSATR0,"^",2)=6 W ?10,"NIGHTLY BACKGROUND JOB",?37,"|",?48,"|",?54,"|",?55,$J($P(PSATR0,"^",6),5),?60,"|",?71,"|",?72,$J(PSABAL,7) S PSAOPT=$G(PSAOPT)+$P(PSATR0,"^",6)
- ;Return Drug Credit
- I $P(PSATR0,"^",2)=10 W ?37,"|",?48,"|",?54,"|",?60,"|",?62,$J($P(PSATR0,"^",6),8),?71,"|",?72,$J($P(PSATR0,"^",10),7) S PSADJT=$G(PSADJT)+$P(PSATR0,"^",6) D REASON
- ;Edit Verified Invoice
- I $P(PSATR0,"^",2)=14 S PSATR8=$G(^PSD(58.81,PSATR,8)) D
- .W ?37,"|",?48,"|",?54,"|",?60,"|",?64,$J($P(PSATR4,"^",4),6),?71,"|",?72,$J(PSABAL,7) S PSADJT=$G(PSADJT)+$P(PSATR4,"^",4)
- .W !,?11,$P($G(PSATR4),"^",6),?37,"|",?48,"|",?54,"|",?60,"|",?71,"|" S PSALN=$G(PSALN)+1,PSAWRT=1
- .W !,?11,"ORD# ",$P($G(PSATR8),"^",2),?37,"|",?48,"|",?54,"|",?60,"|",?71,"|" S PSALN=$G(PSALN)+1,PSAWRT=1
- .W !,?11,"INV# ",$P($G(PSATR8),"^"),?37,"|",?48,"|",?54,"|",?60,"|",?71,"|" S PSALN=$G(PSALN)+1,PSAWRT=1
- .W:$G(PSAW) !?37,"|",?48,"|",?54,"|",?60,"|",?71,"|" K PSAW
- Q
- ;
- S PSAPG=PSAPG+1 I PSAPG=1,$E(IOST,1,2)="C-" W @IOF
- I $E(IOST,1,2)="C-",PSAPG>1 D Q:PSAOUT
- .S PSAS=21-$Y F PSASS=1:1:PSAS W !
- .S DIR(0)="E" D ^DIR K DIR W:'$G(DIRUT) @IOF S:$G(DIRUT) PSAOUT=1
- I $$S^%ZTLOAD W !!,"Task #",$G(ZTSK),", ",$G(ZTDESC)," was stopped by ",$P($G(^VA(200,+$G(DUZ),0)),"^"),"." S PSAOUT=1 Q
- I PSAPG>1,$E(IOST)'="C" W @IOF
- W !?22,"D R U G A C C O U N T A B I L I T Y",?71,"Page ",$J(PSAPG,2)
- W !?((42-$L(PSABDTR)-$L(PSARPDT))/2),"HISTORY OF DRUG TRANSACTIONS FROM ",PSABDTR," TO ",PSARPDT
- W !?((80-$L(PSALOCN))/2),PSALOCN
- W !!?37,"|",?48,"| DISPENSED |",?71,"|"
- W !,"DATE",?10,"INITIATOR",?37,"| RECEIVED | IP | OP | ADJUSTED | BALANCE"
- W !,PSADLN
- I $G(PSADRG)'=""&($G(PSATRCNT)) D WRAPDRUG W ?72,$J(PSABAL,7)
- Q
- ;
- ALL ;Creates drug array with all drugs in location
- S PSA50=0 F S PSA50=+$O(^PSD(58.8,PSALOC,1,PSA50)) Q:'PSA50 S:$P($G(^PSDRUG(PSA50,0)),"^")'="" ^TMP("PSADRG",$J,PSALOC,$P($G(^PSDRUG(PSA50,0)),"^"),PSA50)="",PSACNT=PSACNT+1
- Q
- ;
- WRAPDRUG ;Prints drug name w/o spliting words
- I $L(PSADRG)<36 W !,"* ",PSADRG,?37,"|",?48,"|",?54,"|",?60,"|",?71,"|" Q
- S PSAPC1="" F PSAPCS=1:1 S PSAPC=$P(PSADRG," ",PSAPCS) Q:PSAPC="" D
- .I $L(PSAPC1)+$L(PSAPC)+1<36 S PSAPC1=PSAPC1_PSAPC_" " Q
- .I $L(PSAPC1)+$L(PSAPC)+1>35 W !,"* "_PSAPC1,?37,"|",?48,"|",?54,"|",?60,"|",?71,"|" S PSAPC1=PSAPC_" "
- W:$L(PSAPC1) !?4,PSAPC1,?37,"|",?48,"|",?54,"|",?60,"|",?71,"|"
- Q
- ;
- REASON ;Prints transaction reason w/o spliting words
- S PSAREA=$P(PSATR0,"^",16)
- I $L(PSAREA)<27 W !?11,PSAREA,?37,"|",?48,"|",?54,"|",?60,"|",?71,"|" Q
- S PSAPC1="" F PSAPCS=1:1 S PSAPC=$P(PSAREA," ",PSAPCS) Q:PSAPC="" D
- .I $L(PSAPC1)+$L(PSAPC)+1<27 S PSAPC1=PSAPC1_PSAPC_" " Q
- .I $L(PSAPC1)+$L(PSAPC)+1>26 W !?11,PSAPC1,?37,"|",?48,"|",?54,"|",?60,"|",?71,"|" S PSAPC1=PSAPC_" "
- W:$L(PSAPC1) !?11,PSAPC1,?37,"|",?48,"|",?54,"|",?60,"|",?71,"|"
- Q
- ;
- TRANSFER ;Prints transfer pharm loc that rec'd or sent drugs
- S PSATRANL=$P($G(^PSD(58.81,+$P(PSATR0,"^",17),0)),"^",3),PSAHOLD=PSALOC,PSAHOLDN=PSALOCN,PSALOC=PSATRANL
- I PSALOC="" S PSAREA="TRANSFER DATA MISSING" S PSALOC=PSAHOLD,PSALOCN=PSAHOLDN Q
- D SITES^PSAUTL1 S PSALOCN=$P(^PSD(58.8,PSALOC,0),"^")_PSACOMB
- S PSAREA="TRANSFER "_$S($P(PSATR0,"^",6)<0:"TO ",1:"FROM ") D TRAN
- S PSALOC=PSAHOLD,PSALOCN=PSAHOLDN
- S PSAPC1="" F PSAPCS=1:1 S PSAPC=$P(PSAREA," ",PSAPCS) Q:PSAPC="" D
- .I $L(PSAPC1)+$L(PSAPC)+1<27 S PSAPC1=PSAPC1_PSAPC_" " Q
- .I $L(PSAPC1)+$L(PSAPC)+1>26 W !?11,PSAPC1,?37,"|",?48,"|",?54,"|",?60,"|",?71,"|" S PSAPC1=PSAPC_" "
- W:$L(PSAPC1) !?11,PSAPC1,?37,"|",?48,"|",?54,"|",?60,"|",?71,"|"
- Q
- ;
- TRAN ;Prints transferred location w/o spliting words
- I $E(PSALOCN)="I" S PSAREA=PSAREA_"INPATIENT:"_$P($P(PSALOCN,":",2),"(IP)")
- I $E(PSALOCN)="O" S PSAREA=PSAREA_"OUTPATIENT:"_$P($P(PSALOCN,":",2),"(OP)")
- I $E(PSALOCN)="C" S PSAREA=PSAREA_"COMBINED:"_$P($P(PSALOCN,":",2),"(IP)")_"(IP)"_$P($P(PSALOCN,":",2),"(IP)",2)
- W !?11,$P(PSAREA,":")_":",?37,"|",?48,"|",?54,"|",?60,"|",?71,"|"
- S PSAREA=$P(PSAREA,": ",2)
- Q
- ;
- TOTALS ;Prints totals
- W !?37,"|----------|-----|-----|----------|--------"
- W !?25,"DRUG TOTALS",?37,"|",?41,$J($G(PSARECT),6),?48,"|",$J($G(PSAIPT),5),?54,"|",$J($G(PSAOPT),5),?60,"|",?64,$J($G(PSADJT),6),?71,"|",!,PSADLN
- K PSADJT,PSAIPT,PSAOPT,PSARECT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSAHIS1 8134 printed Feb 18, 2025@23:15:45 Page 2
- PSAHIS1 ;BIR/LTL,JMB-Drug Transaction History - CONT'D ;7/23/97
- +1 ;;3.0;DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,69,72,80**; 10/24/97;Build 2
- +2 ;Prints the Show Drug Transaction History report in pharmacy location
- +3 ;then date order. It is called by PSAHIS.
- +4 ;
- PRINT DO HEADER
- SET PSADRG=""
- SET PSACNT=0
- +1 FOR
- SET PSADRG=$ORDER(^TMP("PSAHIS",$JOB,PSADRG))
- if PSADRG=""!(PSAOUT)
- QUIT
- KILL PSABAL,PSATRCNT
- if $Y+6>IOSL
- DO HEADER
- if PSAOUT
- QUIT
- SET PSADT=0
- Begin DoDot:1
- +2 FOR
- SET PSADT=+$ORDER(^TMP("PSAHIS",$JOB,PSADRG,PSADT))
- if 'PSADT!(PSAOUT)
- QUIT
- Begin DoDot:2
- +3 SET PSATR=0
- FOR
- SET PSATR=+$ORDER(^TMP("PSAHIS",$JOB,PSADRG,PSADT,PSATR))
- if 'PSATR!(PSAOUT)
- QUIT
- if $Y+6>IOSL
- DO HEADER
- if PSAOUT
- QUIT
- DO TRANS
- End DoDot:2
- if PSAOUT
- QUIT
- +4 if PSAOUT
- QUIT
- if $Y+6>IOSL
- DO HEADER
- if PSAOUT
- QUIT
- DO TOTALS
- End DoDot:1
- if PSAOUT
- QUIT
- +5 IF 'PSACNT
- WRITE !!,"No transactions were found for the pharmacy location."
- +6 if PSAOUT
- QUIT
- +7 ;
- DONE ;Holds screen or ejects paper if sent to printer
- +1 IF $EXTRACT(IOST,1,2)="C-"
- Begin DoDot:1
- +2 SET PSAS=21-$Y
- FOR PSASS=1:1:PSAS
- WRITE !
- +3 SET DIR(0)="EA"
- SET DIR("A")="End of pharmacy location's display! Enter RETURN to continue or '^' to exit:"
- DO ^DIR
- KILL DIR
- if $GET(DIRUT)
- SET PSAOUT=1
- End DoDot:1
- +4 IF $EXTRACT(IOST)'="C"
- WRITE !!!,"REPORT RUN: ",PSARUN
- WRITE @IOF
- +5 QUIT
- +6 ;
- TRANS SET PSATR0=$GET(^PSD(58.81,PSATR,0))
- SET PSACNT=1
- SET PSATRCNT=$GET(PSATRCNT)+1
- +1 ;If it is first transaction for drug, print drug name & beg balance.
- +2 ;Beg balance = 1st transaction + (receipts(+), adjs(+/-), &
- +3 ;dispensing(-) made prior to beg date & fell within rpt date range)
- +4 IF PSATRCNT=1
- Begin DoDot:1
- +5 WRITE !,?37,"|",?48,"|",?54,"|",?60,"|",?71,"|"
- DO WRAPDRUG
- +6 SET Z=$GET(^PSD(58.81,+^TMP("PSA",$JOB,PSADRG),0))
- +7 SET PSABAL=$PIECE(Z,"^",10)+$GET(PSABAD(PSADRG))
- WRITE ?72,$JUSTIFY(PSABAL,7)
- End DoDot:1
- +8 ;
- +9 IF $PIECE(^PSD(58.81,PSATR,0),"^",2)=14
- SET PSATR4=$GET(^PSD(58.81,PSATR,4))
- +10 ;Print transaction date & +/- qty from balance
- +11 WRITE !,$EXTRACT(PSADT,4,5)_"-"_$EXTRACT(PSADT,6,7)_"-"_$EXTRACT(PSADT,2,3),?10,$SELECT($PIECE(PSATR0,"^",2)=14:$EXTRACT($PIECE($GET(^VA(200,+$PIECE(PSATR4,"^",2),0)),"^"),1,28),1:$EXTRACT($PIECE($GET(^VA(200,+$PIECE(PSATR0,"^",7),0)),"^"),1,28
- ))
- +12 ;;<<3*72-RJS>>
- IF $PIECE(PSATR0,"^",2)'=24
- IF $PIECE(PSATR0,"^",2)'=9
- SET PSABAL=$SELECT(",1,10,11,19,"[(","_$PIECE(PSATR0,"^",2)_","):PSABAL+$PIECE(PSATR0,"^",6),1:PSABAL-$PIECE(PSATR0,"^",6))
- +13 IF $PIECE(PSATR0,"^",2)=24!($PIECE(PSATR0,"^",2)=9)
- SET PSABAL=PSABAL+$PIECE(PSATR0,"^",6)
- +14 IF $PIECE(PSATR0,"^",2)=14
- SET PSABAL=PSABAL+$PIECE(PSATR4,"^",4)
- +15 ;Receipts
- +16 IF $PIECE(PSATR0,"^",2)=1
- SET PSAWRT=0
- WRITE ?37,"|",?41,$JUSTIFY($PIECE(PSATR0,"^",6),6),?48,"|",?54,"|",?60,"|",?71,"|",?72,$JUSTIFY(PSABAL,7),!
- SET PSARECT=$GET(PSARECT)+$PIECE(PSATR0,"^",6)
- Begin DoDot:1
- +17 IF $PIECE($GET(^PRC(442,+$PIECE(PSATR0,"^",9),0)),"^")
- WRITE ?11,"PO# ",$PIECE($GET(^(0)),"^"),?37,"|",?48,"|",?54,"|",?60,"|",?71,"|"
- SET PSALN=$GET(PSALN)+1
- SET PSAWRT=1
- +18 IF $PIECE($GET(^PRCS(410,+$PIECE(PSATR0,"^",8),0)),"^")
- if PSAWRT
- WRITE !
- WRITE ?11,"TR# ",$PIECE($GET(^(0)),"^"),?37,"|",?48,"|",?54,"|",?60,"|",?71,"|"
- SET PSALN=$GET(PSALN)+1
- SET PSAWRT=1
- +19 IF $PIECE($GET(^PSD(58.81,PSATR,8)),"^",2)'=""
- if PSAWRT
- WRITE !
- WRITE ?11,"ORD# ",$PIECE($GET(^(8)),"^",2),?37,"|",?48,"|",?54,"|",?60,"|",?71,"|"
- SET PSALN=$GET(PSALN)+1
- SET PSAWRT=1
- +20 IF $PIECE($GET(^PSD(58.81,PSATR,8)),"^")'=""
- if PSAWRT
- WRITE !
- WRITE ?11,"INV# ",$PIECE($GET(^(8)),"^"),?37,"|",?48,"|",?54,"|",?60,"|",?71,"|"
- SET PSALN=$GET(PSALN)+1
- SET PSAWRT=1
- +21 if $GET(PSAW)
- WRITE !?37,"|",?48,"|",?54,"|",?60,"|",?71,"|"
- KILL PSAW
- End DoDot:1
- QUIT
- +22 ;Adjusted or transferred
- +23 IF $PIECE(PSATR0,"^",2)=9!($PIECE(PSATR0,"^",2)=11)!($PIECE(PSATR0,"^",2)=24)
- Begin DoDot:1
- +24 WRITE ?37,"|",?48,"|",?54,"|",?60,"|",?64,$JUSTIFY($PIECE(PSATR0,"^",6),6),?71,"|",?72,$JUSTIFY(PSABAL,7)
- +25 IF +$PIECE(PSATR0,"^",19)
- SET PSADJDT=$PIECE(PSATR0,"^",19)
- WRITE !?11,"DATE ENTERED: "_$EXTRACT(PSADJDT,4,5)_"-"_$EXTRACT(PSADJDT,6,7)_"-"_$EXTRACT(PSADJDT,2,3),?37,"|",?48,"|",?54,"|",?60,"|",?71,"|"
- +26 IF $PIECE(PSATR0,"^",2)=9!($PIECE(PSATR0,"^",2)=11)
- IF $PIECE(PSATR0,"^",16)'=""
- DO REASON
- +27 if $PIECE(PSATR0,"^",2)=24
- DO TRANSFER
- SET PSADJT=$GET(PSADJT)+$PIECE(PSATR0,"^",6)
- End DoDot:1
- QUIT
- +28 ;Dispensed by IP (2 means Unit Dose or Ward Stock 15 means IV)
- +29 IF $PIECE(PSATR0,"^",2)=2!($PIECE(PSATR0,"^",2)=15)
- WRITE ?10,"NIGHTLY BACKGROUND JOB",?37,"|",?48,"|",?49,$JUSTIFY($PIECE(PSATR0,"^",6),5),?54,"|",?60,"|",?71,"|",?72,$JUSTIFY(PSABAL,7)
- SET PSAIPT=$GET(PSAIPT)+$PIECE(PSATR0,"^",6)
- QUIT
- +30 ;Dispensed by OP
- +31 IF $PIECE(PSATR0,"^",2)=6
- WRITE ?10,"NIGHTLY BACKGROUND JOB",?37,"|",?48,"|",?54,"|",?55,$JUSTIFY($PIECE(PSATR0,"^",6),5),?60,"|",?71,"|",?72,$JUSTIFY(PSABAL,7)
- SET PSAOPT=$GET(PSAOPT)+$PIECE(PSATR0,"^",6)
- +32 ;Return Drug Credit
- +33 IF $PIECE(PSATR0,"^",2)=10
- WRITE ?37,"|",?48,"|",?54,"|",?60,"|",?62,$JUSTIFY($PIECE(PSATR0,"^",6),8),?71,"|",?72,$JUSTIFY($PIECE(PSATR0,"^",10),7)
- SET PSADJT=$GET(PSADJT)+$PIECE(PSATR0,"^",6)
- DO REASON
- +34 ;Edit Verified Invoice
- +35 IF $PIECE(PSATR0,"^",2)=14
- SET PSATR8=$GET(^PSD(58.81,PSATR,8))
- Begin DoDot:1
- +36 WRITE ?37,"|",?48,"|",?54,"|",?60,"|",?64,$JUSTIFY($PIECE(PSATR4,"^",4),6),?71,"|",?72,$JUSTIFY(PSABAL,7)
- SET PSADJT=$GET(PSADJT)+$PIECE(PSATR4,"^",4)
- +37 WRITE !,?11,$PIECE($GET(PSATR4),"^",6),?37,"|",?48,"|",?54,"|",?60,"|",?71,"|"
- SET PSALN=$GET(PSALN)+1
- SET PSAWRT=1
- +38 WRITE !,?11,"ORD# ",$PIECE($GET(PSATR8),"^",2),?37,"|",?48,"|",?54,"|",?60,"|",?71,"|"
- SET PSALN=$GET(PSALN)+1
- SET PSAWRT=1
- +39 WRITE !,?11,"INV# ",$PIECE($GET(PSATR8),"^"),?37,"|",?48,"|",?54,"|",?60,"|",?71,"|"
- SET PSALN=$GET(PSALN)+1
- SET PSAWRT=1
- +40 if $GET(PSAW)
- WRITE !?37,"|",?48,"|",?54,"|",?60,"|",?71,"|"
- KILL PSAW
- End DoDot:1
- +41 QUIT
- +42 ;
- +1 SET PSAPG=PSAPG+1
- IF PSAPG=1
- IF $EXTRACT(IOST,1,2)="C-"
- WRITE @IOF
- +2 IF $EXTRACT(IOST,1,2)="C-"
- IF PSAPG>1
- Begin DoDot:1
- +3 SET PSAS=21-$Y
- FOR PSASS=1:1:PSAS
- WRITE !
- +4 SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- if '$GET(DIRUT)
- WRITE @IOF
- if $GET(DIRUT)
- SET PSAOUT=1
- End DoDot:1
- if PSAOUT
- QUIT
- +5 IF $$S^%ZTLOAD
- WRITE !!,"Task #",$GET(ZTSK),", ",$GET(ZTDESC)," was stopped by ",$PIECE($GET(^VA(200,+$GET(DUZ),0)),"^"),"."
- SET PSAOUT=1
- QUIT
- +6 IF PSAPG>1
- IF $EXTRACT(IOST)'="C"
- WRITE @IOF
- +7 WRITE !?22,"D R U G A C C O U N T A B I L I T Y",?71,"Page ",$JUSTIFY(PSAPG,2)
- +8 WRITE !?((42-$LENGTH(PSABDTR)-$LENGTH(PSARPDT))/2),"HISTORY OF DRUG TRANSACTIONS FROM ",PSABDTR," TO ",PSARPDT
- +9 WRITE !?((80-$LENGTH(PSALOCN))/2),PSALOCN
- +10 WRITE !!?37,"|",?48,"| DISPENSED |",?71,"|"
- +11 WRITE !,"DATE",?10,"INITIATOR",?37,"| RECEIVED | IP | OP | ADJUSTED | BALANCE"
- +12 WRITE !,PSADLN
- +13 IF $GET(PSADRG)'=""&($GET(PSATRCNT))
- DO WRAPDRUG
- WRITE ?72,$JUSTIFY(PSABAL,7)
- +14 QUIT
- +15 ;
- ALL ;Creates drug array with all drugs in location
- +1 SET PSA50=0
- FOR
- SET PSA50=+$ORDER(^PSD(58.8,PSALOC,1,PSA50))
- if 'PSA50
- QUIT
- if $PIECE($GET(^PSDRUG(PSA50,0)),"^")'=""
- SET ^TMP("PSADRG",$JOB,PSALOC,$PIECE($GET(^PSDRUG(PSA50,0)),"^"),PSA50)=""
- SET PSACNT=PSACNT+1
- +2 QUIT
- +3 ;
- WRAPDRUG ;Prints drug name w/o spliting words
- +1 IF $LENGTH(PSADRG)<36
- WRITE !,"* ",PSADRG,?37,"|",?48,"|",?54,"|",?60,"|",?71,"|"
- QUIT
- +2 SET PSAPC1=""
- FOR PSAPCS=1:1
- SET PSAPC=$PIECE(PSADRG," ",PSAPCS)
- if PSAPC=""
- QUIT
- Begin DoDot:1
- +3 IF $LENGTH(PSAPC1)+$LENGTH(PSAPC)+1<36
- SET PSAPC1=PSAPC1_PSAPC_" "
- QUIT
- +4 IF $LENGTH(PSAPC1)+$LENGTH(PSAPC)+1>35
- WRITE !,"* "_PSAPC1,?37,"|",?48,"|",?54,"|",?60,"|",?71,"|"
- SET PSAPC1=PSAPC_" "
- End DoDot:1
- +5 if $LENGTH(PSAPC1)
- WRITE !?4,PSAPC1,?37,"|",?48,"|",?54,"|",?60,"|",?71,"|"
- +6 QUIT
- +7 ;
- REASON ;Prints transaction reason w/o spliting words
- +1 SET PSAREA=$PIECE(PSATR0,"^",16)
- +2 IF $LENGTH(PSAREA)<27
- WRITE !?11,PSAREA,?37,"|",?48,"|",?54,"|",?60,"|",?71,"|"
- QUIT
- +3 SET PSAPC1=""
- FOR PSAPCS=1:1
- SET PSAPC=$PIECE(PSAREA," ",PSAPCS)
- if PSAPC=""
- QUIT
- Begin DoDot:1
- +4 IF $LENGTH(PSAPC1)+$LENGTH(PSAPC)+1<27
- SET PSAPC1=PSAPC1_PSAPC_" "
- QUIT
- +5 IF $LENGTH(PSAPC1)+$LENGTH(PSAPC)+1>26
- WRITE !?11,PSAPC1,?37,"|",?48,"|",?54,"|",?60,"|",?71,"|"
- SET PSAPC1=PSAPC_" "
- End DoDot:1
- +6 if $LENGTH(PSAPC1)
- WRITE !?11,PSAPC1,?37,"|",?48,"|",?54,"|",?60,"|",?71,"|"
- +7 QUIT
- +8 ;
- TRANSFER ;Prints transfer pharm loc that rec'd or sent drugs
- +1 SET PSATRANL=$PIECE($GET(^PSD(58.81,+$PIECE(PSATR0,"^",17),0)),"^",3)
- SET PSAHOLD=PSALOC
- SET PSAHOLDN=PSALOCN
- SET PSALOC=PSATRANL
- +2 IF PSALOC=""
- SET PSAREA="TRANSFER DATA MISSING"
- SET PSALOC=PSAHOLD
- SET PSALOCN=PSAHOLDN
- QUIT
- +3 DO SITES^PSAUTL1
- SET PSALOCN=$PIECE(^PSD(58.8,PSALOC,0),"^")_PSACOMB
- +4 SET PSAREA="TRANSFER "_$SELECT($PIECE(PSATR0,"^",6)<0:"TO ",1:"FROM ")
- DO TRAN
- +5 SET PSALOC=PSAHOLD
- SET PSALOCN=PSAHOLDN
- +6 SET PSAPC1=""
- FOR PSAPCS=1:1
- SET PSAPC=$PIECE(PSAREA," ",PSAPCS)
- if PSAPC=""
- QUIT
- Begin DoDot:1
- +7 IF $LENGTH(PSAPC1)+$LENGTH(PSAPC)+1<27
- SET PSAPC1=PSAPC1_PSAPC_" "
- QUIT
- +8 IF $LENGTH(PSAPC1)+$LENGTH(PSAPC)+1>26
- WRITE !?11,PSAPC1,?37,"|",?48,"|",?54,"|",?60,"|",?71,"|"
- SET PSAPC1=PSAPC_" "
- End DoDot:1
- +9 if $LENGTH(PSAPC1)
- WRITE !?11,PSAPC1,?37,"|",?48,"|",?54,"|",?60,"|",?71,"|"
- +10 QUIT
- +11 ;
- TRAN ;Prints transferred location w/o spliting words
- +1 IF $EXTRACT(PSALOCN)="I"
- SET PSAREA=PSAREA_"INPATIENT:"_$PIECE($PIECE(PSALOCN,":",2),"(IP)")
- +2 IF $EXTRACT(PSALOCN)="O"
- SET PSAREA=PSAREA_"OUTPATIENT:"_$PIECE($PIECE(PSALOCN,":",2),"(OP)")
- +3 IF $EXTRACT(PSALOCN)="C"
- SET PSAREA=PSAREA_"COMBINED:"_$PIECE($PIECE(PSALOCN,":",2),"(IP)")_"(IP)"_$PIECE($PIECE(PSALOCN,":",2),"(IP)",2)
- +4 WRITE !?11,$PIECE(PSAREA,":")_":",?37,"|",?48,"|",?54,"|",?60,"|",?71,"|"
- +5 SET PSAREA=$PIECE(PSAREA,": ",2)
- +6 QUIT
- +7 ;
- TOTALS ;Prints totals
- +1 WRITE !?37,"|----------|-----|-----|----------|--------"
- +2 WRITE !?25,"DRUG TOTALS",?37,"|",?41,$JUSTIFY($GET(PSARECT),6),?48,"|",$JUSTIFY($GET(PSAIPT),5),?54,"|",$JUSTIFY($GET(PSAOPT),5),?60,"|",?64,$JUSTIFY($GET(PSADJT),6),?71,"|",!,PSADLN
- +3 KILL PSADJT,PSAIPT,PSAOPT,PSARECT
- +4 QUIT