- 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
