PSAMON ;BIR/LTL,JMB-Monthly Summary ;7/23/97
;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**15**; 10/24/97
;
;References to ^PSDRUG( are covered by IA #2095
;
;This routine allows the user to print a report per pharmacy location
;of the drug, beginning balance, ending balance, total received, total
;dispensed, and total adjustments. Specific or all drugs can be selected
;for the report. The report can be sent to the screen and printer.
;
LOC K ^TMP("PSAD",$J) S PSAHIS=1,(PSACNT,PSAOUT)=0
D LOC^PSALEVRP I $G(DIRUT) S PSAOUT=1 G END1
S PSACHK=$O(PSALOC(""))
I 'PSACNT,PSACHK="" W !,"There are no active pharmacy locations." G END1
I PSACNT=1 D
.S PSALOCN=$O(PSALOCA("")),PSALOC=$O(PSALOCA(PSALOCN,0)),PSALOC(PSALOCN,PSALOC)=PSALOCA(PSALOCN,PSALOC),PSAMENU(1,PSALOCN,PSALOC)="",PSASEL=1,PSATOT=0
.W:$L(PSALOCN)>76 !,$P(PSALOCN,"(IP)",1)_"(IP)",!?17,$P(PSALOCN,"(IP)",2) W:$L(PSALOCN)<77 !,PSALOCN
D DT^DICRW S Y=$E(DT,1,5) X ^DD("DD") S PSAMON=Y
S DIR(0)="D:AEP",DIR("A")="Select month and year: ",DIR("B")=PSAMON D ^DIR K DIR I $D(DIRUT) S PSAOUT=1 G END1
S PSAMON=+($E(Y,1,5)*100),PSA=0,Y=PSAMON X ^DD("DD") S PSAMONN=Y,PSACNT=0
W ! F PSAPC=1:1 S PSAPICK=+$P(PSASEL,",",PSAPC) Q:'PSAPICK D
.S PSALOCN="" F S PSALOCN=$O(PSAMENU(PSAPICK,PSALOCN)) Q:PSALOCN=""!(PSAOUT) S PSALOC=0 F S PSALOC=$O(PSAMENU(PSAPICK,PSALOCN,PSALOC)) Q:'PSALOC!(PSAOUT) D
..S PSACNT=PSACNT+1
..W @IOF W:$L(PSALOCN)>79 !,$P(PSALOCN,"(IP)",1)_"(IP)",!?17,$P(PSALOCN,"(IP)",2) W:$L(PSALOCN)<80 !,PSALOCN
..I '$O(^PSD(58.8,+PSALOC,1,0)) W !!,"There are no drugs in ",$G(PSALOCN) S PSAOUT=1 Q
..D DRUG Q:PSAOUT
I PSACNT=1!(PSAOUT) S PSATOT=0 G DEV
W ! S DIR(0)="Y",DIR("A")="Print summary report",DIR("B")="Y",DIR("?",1)="Enter YES to print a report of the total figures for each selected",DIR("?",2)="drug in all selected pharmacy locations."
S DIR("?")="Enter NO to print only the report per pharmacy location.",DIR("??")="^D SUMHELP^PSAMON" D ^DIR K DIR G:$G(DIRUT) END1 S PSATOT=+Y
G DEV
;
DRUG W !!,"Select one, several, or ^ALL drugs.",!
S PSADONE=0,DIC="^PSD(58.8,+PSALOC,1,",DIC(0)="AEMQ",DIC("A")="Select Drug: "
F D ^DIC S:$G(DTOUT)!(X="^") PSAOUT=1 Q:Y=-1&(X'="^A")&(X'="^ALL") D Q:PSAOUT!(PSADONE)
.I X'="^A",X'="^ALL",'+Y S PSAOUT=1 Q
.I X="^A"!(X="^ALL") D Q
..W !,"Please wait." S PSA=0 F S PSA=$O(^PSD(58.8,+PSALOC,1,PSA)) Q:'PSA S:$G(^PSD(58.8,+PSALOC,1,+PSA,5,PSAMON,0))'="" ^TMP("PSAD",$J,PSALOCN,PSA)="" W:(PSA#500) "."
..D END^PSAPROC S PSADONE=1
.I +Y,$G(^PSD(58.8,+PSALOC,1,+Y,5,PSAMON,0))="" W !!,"Sorry, no history for that month." Q
.S ^TMP("PSAD",$J,PSALOCN,+Y)=""
K DIC
Q
;
DEV ;asks device and queueing info
S PSA=$O(^TMP("PSAD",$J,"")) G:PSA=""!(PSAOUT) END1
K IO("Q") N IOP,POP S %ZIS="Q" W ! D ^%ZIS I POP W !,"NO DEVICE SELECTED OR OUTPUT PRINTED!" G END1
I $D(IO("Q")) D G END1
.K ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTDTH,ZTSK
.S ZTRTN="START^PSAMON",ZTDESC="Drug Accountability Monthly Summary Report",ZTSAVE("PSA*")="",ZTSAVE("^TMP(""PSAD"",$J,")=""
.D ^%ZTLOAD,HOME^%ZIS
;
START ;compiles and prints output
S PSARPDT=$E($$HTFM^XLFDT($H),1,12),PSADT=$P(PSARPDT,".")
S PSARPDT=$E(PSADT,4,5)_"/"_$E(PSADT,6,7)_"/"_$E(PSADT,2,3)_"@"_$P(PSARPDT,".",2)
S (PSAOUT,PSAPG)=0,$P(PSADLN,"=",81)="",$P(PSASLN,"-",81)="",PSATABH=(66-($L(PSAMONN)+$L($E(PSALOCN,1,20))))/2
K ^TMP("PSAMON",$J)
LOOP S PSALOCN="" F S PSALOCN=$O(^TMP("PSAD",$J,PSALOCN)) Q:PSALOCN=""!(PSAOUT) D
.D HEADER S PSALOC=$O(PSALOC(PSALOCN,0))
.F PSA=0:0 S PSA=+$O(^TMP("PSAD",$J,PSALOCN,PSA)) Q:'PSA D
..I $D(^PSD(58.8,PSALOC,1,PSA,5,PSAMON,0)) S ^TMP("PSAMON",$J,$P($G(^PSDRUG(PSA,0)),U))=PSA
.D PRINT K ^TMP("PSAMON",$J)
.I 'PSAOUT D:$Y+4>IOSL HEADER Q:PSAOUT W !,"TOTAL",?36,$J(PSATREC,6,0),?49,$J(PSATDISP,6,0),?60,$J(PSATADJ,6,0),?73,$J(PSATTF,6,0),!,PSADLN,!
G END
;
PRINT ;Prints in drug order.
S PSAX="",PSAX=$O(^TMP("PSAMON",$J,PSAX)) I PSAX="" W !!,"<< NO DATA WAS FOUND. >>" G END
S (PSATREC,PSATDISP,PSATADJ,PSATTF)=0
S PSADRUG="" F S PSADRUG=$O(^TMP("PSAMON",$J,PSADRUG)) Q:PSADRUG="" D Q:PSAOUT
.D:$Y+4>IOSL HEADER Q:PSAOUT S PSA=+^TMP("PSAMON",$J,PSADRUG)
.W !,PSADRUG
.W !?17 W:+$P($G(^PSD(58.8,PSALOC,1,PSA,5,PSAMON,0)),U,2) $J($P($G(^PSD(58.8,PSALOC,1,PSA,5,PSAMON,0)),U,2),6,0)
.I '+$P($G(^PSD(58.8,PSALOC,1,PSA,5,PSAMON,0)),U,2) S PSABAL=$P($G(^PSD(58.8,PSALOC,1,PSA,5,PSAMON,0)),U,4) W $J($S($G(PSABAL):PSABAL,1:0),6,0)
.W ?26,$J($S($P($G(^PSD(58.8,PSALOC,1,PSA,5,PSAMON,0)),U,4)]"":$P($G(^(0)),U,4),1:$P($G(^PSD(58.8,PSALOC,1,PSA,0)),U,4)),6,0)
.S PSAREC=$P($G(^PSD(58.8,PSALOC,1,PSA,5,PSAMON,0)),U,3),PSATREC=PSATREC+PSAREC W ?36,$J(PSAREC,6,0)
.S PSADISP=$P($G(^PSD(58.8,PSALOC,1,PSA,5,PSAMON,0)),U,6),PSATDISP=PSATDISP+PSADISP W ?49,$J(PSADISP,6,0)
.S PSADJ=$P($G(^PSD(58.8,PSALOC,1,PSA,5,PSAMON,0)),U,5),PSATADJ=PSATADJ+PSADJ W ?60,$J(PSADJ,6,0)
.S PSATF=$P($G(^PSD(58.8,PSALOC,1,PSA,5,PSAMON,0)),U,9),PSATTF=PSATTF+PSATF W ?73,$J(PSATF,6,0),!
.W:$O(^TMP("PSAMON",$J,PSADRUG))'="" PSASLN W:$O(^TMP("PSAMON",$J,PSADRUG))="" PSADLN
.I PSATOT D
..S $P(^TMP("PSAG",$J,PSADRUG),"^")=$P($G(^TMP("PSAG",$J,PSADRUG)),"^")+PSAREC,$P(^(PSADRUG),"^",2)=$P($G(^(PSADRUG)),"^",2)+PSADISP
..S $P(^TMP("PSAG",$J,PSADRUG),"^",3)=$P($G(^TMP("PSAG",$J,PSADRUG)),"^",3)+PSADJ,$P(^(PSADRUG),"^",4)=$P($G(^(PSADRUG)),"^",4)+PSATF
Q
;
END ;End of page
I $E($G(IOST))="C",'$G(PSAOUT) D
.S PSAS=22-$Y F PSASS=1:1:PSAS W !
.S DIR(0)="EA",DIR("A")="END OF REPORT! Press <RET> to return to the menu." D ^DIR K DIR I $G(DIRUT) S PSAOUT=1
W @IOF I 'PSAOUT,PSATOT D ^PSAMON1
;
END1 ;Kills variables at end of report
D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
K IO("Q"),^TMP("PSAD",$J),^TMP("PSAG",$J),^TMP("PSAMON",$J)
K %ZIS,DIC,DIRUT,DTOUT,DUOUT,PSA,PSABAL,PSACHK,PSACNT,PSACOMB,PSAD,PSADISP,PSADJ,PSADLN,PSADONE,PSADRUG,PSADT,PSAGADJ,PSAGDISP,PSAGREC,PSAGTF,PSAHIS
K PSAISIT,PSAISITN,PSALOC,PSALOCA,PSALOCN,PSAMENU,PSAMON,PSAMONN,PSANODE,PSANUM,PSAOSIT,PSAOSITN,PSAOUT,PSAPC,PSAPC1,PSAPCS,PSAPICK
K PSAREC,PSAPG,PSARPDT,PSAS,PSASEL,PSASLN,PSAS,PSASS,PSASUB,PSATABH,PSATADJ,PSATDISP,PSATF,PSATOT,PSATREC,PSATTF,PSAX,X,Y,ZTDESC,ZTRTN
Q
;
I $E(IOST,1,2)="C-",PSAPG S DIR(0)="E" D Q:PSAOUT
.S PSAS=22-$Y F PSASS=1:1:PSAS W !
.S DIR(0)="E" D ^DIR K DIR I $G(DIRUT) S PSAOUT=1
I $$S^%ZTLOAD W !!,"Task #",$G(ZTSK),", ",$G(ZTDESC)," was stopped by ",$P($G(^VA(200,+$G(DUZ),0)),U),"." S PSAOUT=1 Q
I $E(IOST,1,2)="C-" W @IOF
I $E(IOST)'="C",PSAPG W @IOF
S PSAPG=PSAPG+1 W:$E(IOST)'="C" !,PSARPDT W:$E(IOST,1,2)="C-" !
W ?20,"DRUG ACCOUNTABILITY/INVENTORY INTERFACE",?71,"PAGE: ",PSAPG
W !?22,"MONTHLY SUMMARY REPORT FOR "_PSAMONN
W:$L(PSALOCN)>79 !!,$P(PSALOCN,"(IP)",1)_"(IP)",!?17,$P(PSALOCN,"(IP)",2)
W:$L(PSALOCN)<80 !?((80-$L(PSALOCN))/2),PSALOCN
W !!,?14,"BEGINNING",?26,"ENDING",?36,"TOTAL",?48,"TOTAL",?60,"TOTAL",?72,"TOTAL"
W !,"DRUG",?16,"BALANCE",?25,"BALANCE",?34,"RECEIVED",?46,"DISPENSED",?58,"ADJUSTED",?69,"TRANSFERRED"
W !,PSADLN
Q
;
SUMHELP ;Extended help to 'Print summary report?'
W !!?5,"Enter YES to print a report with the totals for each selected drug",!?5,"in all the pharmacy locations that were selected. A total line will"
W !?5,"print for the total dispense units received, dispensed, adjusted,",!?5,"and transferrred during the selected month."
W !!?5,"Enter NO to print each pharmacy location's report without the",!?5,"summary report."
Q
PSAMON ;BIR/LTL,JMB-Monthly Summary ;7/23/97
+1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**15**; 10/24/97
+2 ;
+3 ;References to ^PSDRUG( are covered by IA #2095
+4 ;
+5 ;This routine allows the user to print a report per pharmacy location
+6 ;of the drug, beginning balance, ending balance, total received, total
+7 ;dispensed, and total adjustments. Specific or all drugs can be selected
+8 ;for the report. The report can be sent to the screen and printer.
+9 ;
LOC KILL ^TMP("PSAD",$JOB)
SET PSAHIS=1
SET (PSACNT,PSAOUT)=0
+1 DO LOC^PSALEVRP
IF $GET(DIRUT)
SET PSAOUT=1
GOTO END1
+2 SET PSACHK=$ORDER(PSALOC(""))
+3 IF 'PSACNT
IF PSACHK=""
WRITE !,"There are no active pharmacy locations."
GOTO END1
+4 IF PSACNT=1
Begin DoDot:1
+5 SET PSALOCN=$ORDER(PSALOCA(""))
SET PSALOC=$ORDER(PSALOCA(PSALOCN,0))
SET PSALOC(PSALOCN,PSALOC)=PSALOCA(PSALOCN,PSALOC)
SET PSAMENU(1,PSALOCN,PSALOC)=""
SET PSASEL=1
SET PSATOT=0
+6 IF $LENGTH(PSALOCN)>76
WRITE !,$PIECE(PSALOCN,"(IP)",1)_"(IP)",!?17,$PIECE(PSALOCN,"(IP)",2)
IF $LENGTH(PSALOCN)<77
WRITE !,PSALOCN
End DoDot:1
+7 DO DT^DICRW
SET Y=$EXTRACT(DT,1,5)
XECUTE ^DD("DD")
SET PSAMON=Y
+8 SET DIR(0)="D:AEP"
SET DIR("A")="Select month and year: "
SET DIR("B")=PSAMON
DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET PSAOUT=1
GOTO END1
+9 SET PSAMON=+($EXTRACT(Y,1,5)*100)
SET PSA=0
SET Y=PSAMON
XECUTE ^DD("DD")
SET PSAMONN=Y
SET PSACNT=0
+10 WRITE !
FOR PSAPC=1:1
SET PSAPICK=+$PIECE(PSASEL,",",PSAPC)
IF 'PSAPICK
QUIT
Begin DoDot:1
+11 SET PSALOCN=""
FOR
SET PSALOCN=$ORDER(PSAMENU(PSAPICK,PSALOCN))
IF PSALOCN=""!(PSAOUT)
QUIT
SET PSALOC=0
FOR
SET PSALOC=$ORDER(PSAMENU(PSAPICK,PSALOCN,PSALOC))
IF 'PSALOC!(PSAOUT)
QUIT
Begin DoDot:2
+12 SET PSACNT=PSACNT+1
+13 WRITE @IOF
IF $LENGTH(PSALOCN)>79
WRITE !,$PIECE(PSALOCN,"(IP)",1)_"(IP)",!?17,$PIECE(PSALOCN,"(IP)",2)
IF $LENGTH(PSALOCN)<80
WRITE !,PSALOCN
+14 IF '$ORDER(^PSD(58.8,+PSALOC,1,0))
WRITE !!,"There are no drugs in ",$GET(PSALOCN)
SET PSAOUT=1
QUIT
+15 DO DRUG
IF PSAOUT
QUIT
End DoDot:2
End DoDot:1
+16 IF PSACNT=1!(PSAOUT)
SET PSATOT=0
GOTO DEV
+17 WRITE !
SET DIR(0)="Y"
SET DIR("A")="Print summary report"
SET DIR("B")="Y"
SET DIR("?",1)="Enter YES to print a report of the total figures for each selected"
SET DIR("?",2)="drug in all selected pharmacy locations."
+18 SET DIR("?")="Enter NO to print only the report per pharmacy location."
SET DIR("??")="^D SUMHELP^PSAMON"
DO ^DIR
KILL DIR
IF $GET(DIRUT)
GOTO END1
SET PSATOT=+Y
+19 GOTO DEV
+20 ;
DRUG WRITE !!,"Select one, several, or ^ALL drugs.",!
+1 SET PSADONE=0
SET DIC="^PSD(58.8,+PSALOC,1,"
SET DIC(0)="AEMQ"
SET DIC("A")="Select Drug: "
+2 FOR
DO ^DIC
IF $GET(DTOUT)!(X="^")
SET PSAOUT=1
IF Y=-1&(X'="^A")&(X'="^ALL")
QUIT
Begin DoDot:1
+3 IF X'="^A"
IF X'="^ALL"
IF '+Y
SET PSAOUT=1
QUIT
+4 IF X="^A"!(X="^ALL")
Begin DoDot:2
+5 WRITE !,"Please wait."
SET PSA=0
FOR
SET PSA=$ORDER(^PSD(58.8,+PSALOC,1,PSA))
IF 'PSA
QUIT
IF $GET(^PSD(58.8,+PSALOC,1,+PSA,5,PSAMON,0))'=""
SET ^TMP("PSAD",$JOB,PSALOCN,PSA)=""
IF (PSA#500)
WRITE "."
+6 DO END^PSAPROC
SET PSADONE=1
End DoDot:2
QUIT
+7 IF +Y
IF $GET(^PSD(58.8,+PSALOC,1,+Y,5,PSAMON,0))=""
WRITE !!,"Sorry, no history for that month."
QUIT
+8 SET ^TMP("PSAD",$JOB,PSALOCN,+Y)=""
End DoDot:1
IF PSAOUT!(PSADONE)
QUIT
+9 KILL DIC
+10 QUIT
+11 ;
DEV ;asks device and queueing info
+1 SET PSA=$ORDER(^TMP("PSAD",$JOB,""))
IF PSA=""!(PSAOUT)
GOTO END1
+2 KILL IO("Q")
NEW IOP,POP
SET %ZIS="Q"
WRITE !
DO ^%ZIS
IF POP
WRITE !,"NO DEVICE SELECTED OR OUTPUT PRINTED!"
GOTO END1
+3 IF $DATA(IO("Q"))
Begin DoDot:1
+4 KILL ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTDTH,ZTSK
+5 SET ZTRTN="START^PSAMON"
SET ZTDESC="Drug Accountability Monthly Summary Report"
SET ZTSAVE("PSA*")=""
SET ZTSAVE("^TMP(""PSAD"",$J,")=""
+6 DO ^%ZTLOAD
DO HOME^%ZIS
End DoDot:1
GOTO END1
+7 ;
START ;compiles and prints output
+1 SET PSARPDT=$EXTRACT($$HTFM^XLFDT($HOROLOG),1,12)
SET PSADT=$PIECE(PSARPDT,".")
+2 SET PSARPDT=$EXTRACT(PSADT,4,5)_"/"_$EXTRACT(PSADT,6,7)_"/"_$EXTRACT(PSADT,2,3)_"@"_$PIECE(PSARPDT,".",2)
+3 SET (PSAOUT,PSAPG)=0
SET $PIECE(PSADLN,"=",81)=""
SET $PIECE(PSASLN,"-",81)=""
SET PSATABH=(66-($LENGTH(PSAMONN)+$LENGTH($EXTRACT(PSALOCN,1,20))))/2
+4 KILL ^TMP("PSAMON",$JOB)
LOOP SET PSALOCN=""
FOR
SET PSALOCN=$ORDER(^TMP("PSAD",$JOB,PSALOCN))
IF PSALOCN=""!(PSAOUT)
QUIT
Begin DoDot:1
+1 DO HEADER
SET PSALOC=$ORDER(PSALOC(PSALOCN,0))
+2 FOR PSA=0:0
SET PSA=+$ORDER(^TMP("PSAD",$JOB,PSALOCN,PSA))
IF 'PSA
QUIT
Begin DoDot:2
+3 IF $DATA(^PSD(58.8,PSALOC,1,PSA,5,PSAMON,0))
SET ^TMP("PSAMON",$JOB,$PIECE($GET(^PSDRUG(PSA,0)),U))=PSA
End DoDot:2
+4 DO PRINT
KILL ^TMP("PSAMON",$JOB)
+5 IF 'PSAOUT
IF $Y+4>IOSL
DO HEADER
IF PSAOUT
QUIT
WRITE !,"TOTAL",?36,$JUSTIFY(PSATREC,6,0),?49,$JUSTIFY(PSATDISP,6,0),?60,$JUSTIFY(PSATADJ,6,0),?73,$JUSTIFY(PSATTF,6,0),!,PSADLN,!
End DoDot:1
+6 GOTO END
+7 ;
PRINT ;Prints in drug order.
+1 SET PSAX=""
SET PSAX=$ORDER(^TMP("PSAMON",$JOB,PSAX))
IF PSAX=""
WRITE !!,"<< NO DATA WAS FOUND. >>"
GOTO END
+2 SET (PSATREC,PSATDISP,PSATADJ,PSATTF)=0
+3 SET PSADRUG=""
FOR
SET PSADRUG=$ORDER(^TMP("PSAMON",$JOB,PSADRUG))
IF PSADRUG=""
QUIT
Begin DoDot:1
+4 IF $Y+4>IOSL
DO HEADER
IF PSAOUT
QUIT
SET PSA=+^TMP("PSAMON",$JOB,PSADRUG)
+5 WRITE !,PSADRUG
+6 WRITE !?17
IF +$PIECE($GET(^PSD(58.8,PSALOC,1,PSA,5,PSAMON,0)),U,2)
WRITE $JUSTIFY($PIECE($GET(^PSD(58.8,PSALOC,1,PSA,5,PSAMON,0)),U,2),6,0)
+7 IF '+$PIECE($GET(^PSD(58.8,PSALOC,1,PSA,5,PSAMON,0)),U,2)
SET PSABAL=$PIECE($GET(^PSD(58.8,PSALOC,1,PSA,5,PSAMON,0)),U,4)
WRITE $JUSTIFY($SELECT($GET(PSABAL):PSABAL,1:0),6,0)
+8 WRITE ?26,$JUSTIFY($SELECT($PIECE($GET(^PSD(58.8,PSALOC,1,PSA,5,PSAMON,0)),U,4)]"":$PIECE($GET(^(0)),U,4),1:$PIECE($GET(^PSD(58.8,PSALOC,1,PSA,0)),U,4)),6,0)
+9 SET PSAREC=$PIECE($GET(^PSD(58.8,PSALOC,1,PSA,5,PSAMON,0)),U,3)
SET PSATREC=PSATREC+PSAREC
WRITE ?36,$JUSTIFY(PSAREC,6,0)
+10 SET PSADISP=$PIECE($GET(^PSD(58.8,PSALOC,1,PSA,5,PSAMON,0)),U,6)
SET PSATDISP=PSATDISP+PSADISP
WRITE ?49,$JUSTIFY(PSADISP,6,0)
+11 SET PSADJ=$PIECE($GET(^PSD(58.8,PSALOC,1,PSA,5,PSAMON,0)),U,5)
SET PSATADJ=PSATADJ+PSADJ
WRITE ?60,$JUSTIFY(PSADJ,6,0)
+12 SET PSATF=$PIECE($GET(^PSD(58.8,PSALOC,1,PSA,5,PSAMON,0)),U,9)
SET PSATTF=PSATTF+PSATF
WRITE ?73,$JUSTIFY(PSATF,6,0),!
+13 IF $ORDER(^TMP("PSAMON",$JOB,PSADRUG))'=""
WRITE PSASLN
IF $ORDER(^TMP("PSAMON",$JOB,PSADRUG))=""
WRITE PSADLN
+14 IF PSATOT
Begin DoDot:2
+15 SET $PIECE(^TMP("PSAG",$JOB,PSADRUG),"^")=$PIECE($GET(^TMP("PSAG",$JOB,PSADRUG)),"^")+PSAREC
SET $PIECE(^(PSADRUG),"^",2)=$PIECE($GET(^(PSADRUG)),"^",2)+PSADISP
+16 SET $PIECE(^TMP("PSAG",$JOB,PSADRUG),"^",3)=$PIECE($GET(^TMP("PSAG",$JOB,PSADRUG)),"^",3)+PSADJ
SET $PIECE(^(PSADRUG),"^",4)=$PIECE($GET(^(PSADRUG)),"^",4)+PSATF
End DoDot:2
End DoDot:1
IF PSAOUT
QUIT
+17 QUIT
+18 ;
END ;End of page
+1 IF $EXTRACT($GET(IOST))="C"
IF '$GET(PSAOUT)
Begin DoDot:1
+2 SET PSAS=22-$Y
FOR PSASS=1:1:PSAS
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 PSAOUT=1
End DoDot:1
+4 WRITE @IOF
IF 'PSAOUT
IF PSATOT
DO ^PSAMON1
+5 ;
END1 ;Kills variables at end of report
+1 DO ^%ZISC
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 KILL IO("Q"),^TMP("PSAD",$JOB),^TMP("PSAG",$JOB),^TMP("PSAMON",$JOB)
+3 KILL %ZIS,DIC,DIRUT,DTOUT,DUOUT,PSA,PSABAL,PSACHK,PSACNT,PSACOMB,PSAD,PSADISP,PSADJ,PSADLN,PSADONE,PSADRUG,PSADT,PSAGADJ,PSAGDISP,PSAGREC,PSAGTF,PSAHIS
+4 KILL PSAISIT,PSAISITN,PSALOC,PSALOCA,PSALOCN,PSAMENU,PSAMON,PSAMONN,PSANODE,PSANUM,PSAOSIT,PSAOSITN,PSAOUT,PSAPC,PSAPC1,PSAPCS,PSAPICK
+5 KILL PSAREC,PSAPG,PSARPDT,PSAS,PSASEL,PSASLN,PSAS,PSASS,PSASUB,PSATABH,PSATADJ,PSATDISP,PSATF,PSATOT,PSATREC,PSATTF,PSAX,X,Y,ZTDESC,ZTRTN
+6 QUIT
+7 ;
+1 IF $EXTRACT(IOST,1,2)="C-"
IF PSAPG
SET DIR(0)="E"
Begin DoDot:1
+2 SET PSAS=22-$Y
FOR PSASS=1:1:PSAS
WRITE !
+3 SET DIR(0)="E"
DO ^DIR
KILL DIR
IF $GET(DIRUT)
SET PSAOUT=1
End DoDot:1
IF PSAOUT
QUIT
+4 IF $$S^%ZTLOAD
WRITE !!,"Task #",$GET(ZTSK),", ",$GET(ZTDESC)," was stopped by ",$PIECE($GET(^VA(200,+$GET(DUZ),0)),U),"."
SET PSAOUT=1
QUIT
+5 IF $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
+6 IF $EXTRACT(IOST)'="C"
IF PSAPG
WRITE @IOF
+7 SET PSAPG=PSAPG+1
IF $EXTRACT(IOST)'="C"
WRITE !,PSARPDT
IF $EXTRACT(IOST,1,2)="C-"
WRITE !
+8 WRITE ?20,"DRUG ACCOUNTABILITY/INVENTORY INTERFACE",?71,"PAGE: ",PSAPG
+9 WRITE !?22,"MONTHLY SUMMARY REPORT FOR "_PSAMONN
+10 IF $LENGTH(PSALOCN)>79
WRITE !!,$PIECE(PSALOCN,"(IP)",1)_"(IP)",!?17,$PIECE(PSALOCN,"(IP)",2)
+11 IF $LENGTH(PSALOCN)<80
WRITE !?((80-$LENGTH(PSALOCN))/2),PSALOCN
+12 WRITE !!,?14,"BEGINNING",?26,"ENDING",?36,"TOTAL",?48,"TOTAL",?60,"TOTAL",?72,"TOTAL"
+13 WRITE !,"DRUG",?16,"BALANCE",?25,"BALANCE",?34,"RECEIVED",?46,"DISPENSED",?58,"ADJUSTED",?69,"TRANSFERRED"
+14 WRITE !,PSADLN
+15 QUIT
+16 ;
SUMHELP ;Extended help to 'Print summary report?'
+1 WRITE !!?5,"Enter YES to print a report with the totals for each selected drug",!?5,"in all the pharmacy locations that were selected. A total line will"
+2 WRITE !?5,"print for the total dispense units received, dispensed, adjusted,",!?5,"and transferrred during the selected month."
+3 WRITE !!?5,"Enter NO to print each pharmacy location's report without the",!?5,"summary report."
+4 QUIT
