- PSAMON1 ;BIR/LTL,JMB-Monthly Summary - CONT'D;9/11/97
- ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;; 10/24/97
- ;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.
- ;
- PRINT ;Prints totals report
- S (PSAGADJ,PSAGDISP,PSAGREC,PSAGTF,PSAPG)=0 D HEADER
- S PSADRUG="" F S PSADRUG=$O(^TMP("PSAG",$J,PSADRUG)) Q:PSADRUG=""!(PSAOUT) D Q:PSAOUT
- .D:$Y+4>IOSL HEADER Q:PSAOUT
- .S PSANODE=^TMP("PSAG",$J,PSADRUG),PSAGREC=PSAGREC+$P(PSANODE,"^"),PSAGDISP=PSAGDISP+$P(PSANODE,"^",2),PSAGADJ=PSAGADJ+$P(PSANODE,"^",3),PSAGTF=PSAGTF+$P(PSANODE,"^",4)
- .D WRAPDRG
- .W ?36,$J($P(PSANODE,"^"),6,0),?49,$J($P(PSANODE,"^",2),6,0),?60,$J($P(PSANODE,"^",3),6,0),?73,$J($P(PSANODE,"^",4),6,0),!
- .W:$O(^TMP("PSAG",$J,PSADRUG))'="" PSASLN W:$O(^TMP("PSAG",$J,PSADRUG))="" PSADLN
- I 'PSAOUT D:$Y+4>IOSL HEADER Q:PSAOUT W !,"GRAND TOTAL",?36,$J(PSAGREC,6,0),?49,$J(PSAGDISP,6,0),?60,$J(PSAGADJ,6,0),?73,$J(PSAGTF,6,0),!,PSADLN,!
- ;
- END 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
- Q
- ;
- I $E(IOST,1,2)="C-",PSAPG 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 !?19,"MONTHLY SUMMARY TOTALS REPORT FOR "_PSAMONN
- 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
- ..W:$L(PSALOCN)>79 !!,$P(PSALOCN,"(IP)",1)_"(IP)",!?17,$P(PSALOCN,"(IP)",2) W:$L(PSALOCN)<80 !?((80-$L(PSALOCN))/2),PSALOCN
- W !!?36,"TOTAL",?48,"TOTAL",?60,"TOTAL",?72,"TOTAL"
- W !,"DRUG",?34,"RECEIVED",?46,"DISPENSED",?58,"ADJUSTED",?69,"TRANSFERRED",!,PSADLN
- Q
- ;
- WRAPDRG ;Wraps the drug name if it is longer than 34 characters
- I $L(PSADRUG)<36 W !,PSADRUG Q
- S PSAPC1="" F PSAPCS=1:1 S PSAPC=$P(PSADRUG," ",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 S PSAPC1=PSAPC_" "
- W:$L(PSAPC1) !?4,PSAPC1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSAMON1 2711 printed Mar 13, 2025@20:54:22 Page 2
- PSAMON1 ;BIR/LTL,JMB-Monthly Summary - CONT'D;9/11/97
- +1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;; 10/24/97
- +2 ;This routine allows the user to print a report per pharmacy location
- +3 ;of the drug, beginning balance, ending balance, total received, total
- +4 ;dispensed, and total adjustments. Specific or all drugs can be selected
- +5 ;for the report. The report can be sent to the screen and printer.
- +6 ;
- PRINT ;Prints totals report
- +1 SET (PSAGADJ,PSAGDISP,PSAGREC,PSAGTF,PSAPG)=0
- DO HEADER
- +2 SET PSADRUG=""
- FOR
- SET PSADRUG=$ORDER(^TMP("PSAG",$JOB,PSADRUG))
- if PSADRUG=""!(PSAOUT)
- QUIT
- Begin DoDot:1
- +3 if $Y+4>IOSL
- DO HEADER
- if PSAOUT
- QUIT
- +4 SET PSANODE=^TMP("PSAG",$JOB,PSADRUG)
- SET PSAGREC=PSAGREC+$PIECE(PSANODE,"^")
- SET PSAGDISP=PSAGDISP+$PIECE(PSANODE,"^",2)
- SET PSAGADJ=PSAGADJ+$PIECE(PSANODE,"^",3)
- SET PSAGTF=PSAGTF+$PIECE(PSANODE,"^",4)
- +5 DO WRAPDRG
- +6 WRITE ?36,$JUSTIFY($PIECE(PSANODE,"^"),6,0),?49,$JUSTIFY($PIECE(PSANODE,"^",2),6,0),?60,$JUSTIFY($PIECE(PSANODE,"^",3),6,0),?73,$JUSTIFY($PIECE(PSANODE,"^",4),6,0),!
- +7 if $ORDER(^TMP("PSAG",$JOB,PSADRUG))'=""
- WRITE PSASLN
- if $ORDER(^TMP("PSAG",$JOB,PSADRUG))=""
- WRITE PSADLN
- End DoDot:1
- if PSAOUT
- QUIT
- +8 IF 'PSAOUT
- if $Y+4>IOSL
- DO HEADER
- if PSAOUT
- QUIT
- WRITE !,"GRAND TOTAL",?36,$JUSTIFY(PSAGREC,6,0),?49,$JUSTIFY(PSAGDISP,6,0),?60,$JUSTIFY(PSAGADJ,6,0),?73,$JUSTIFY(PSAGTF,6,0),!,PSADLN,!
- +9 ;
- END IF $EXTRACT($GET(IOST))="C"
- IF '$GET(PSAOUT)
- Begin DoDot:1
- +1 SET PSAS=22-$Y
- FOR PSASS=1:1:PSAS
- WRITE !
- +2 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
- +3 WRITE @IOF
- +4 QUIT
- +5 ;
- +1 IF $EXTRACT(IOST,1,2)="C-"
- IF PSAPG
- 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 !?19,"MONTHLY SUMMARY TOTALS REPORT FOR "_PSAMONN
- +10 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 if $LENGTH(PSALOCN)>79
- WRITE !!,$PIECE(PSALOCN,"(IP)",1)_"(IP)",!?17,$PIECE(PSALOCN,"(IP)",2)
- if $LENGTH(PSALOCN)<80
- WRITE !?((80-$LENGTH(PSALOCN))/2),PSALOCN
- End DoDot:2
- End DoDot:1
- +13 WRITE !!?36,"TOTAL",?48,"TOTAL",?60,"TOTAL",?72,"TOTAL"
- +14 WRITE !,"DRUG",?34,"RECEIVED",?46,"DISPENSED",?58,"ADJUSTED",?69,"TRANSFERRED",!,PSADLN
- +15 QUIT
- +16 ;
- WRAPDRG ;Wraps the drug name if it is longer than 34 characters
- +1 IF $LENGTH(PSADRUG)<36
- WRITE !,PSADRUG
- QUIT
- +2 SET PSAPC1=""
- FOR PSAPCS=1:1
- SET PSAPC=$PIECE(PSADRUG," ",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
- SET PSAPC1=PSAPC_" "
- End DoDot:1
- +5 if $LENGTH(PSAPC1)
- WRITE !?4,PSAPC1
- +6 QUIT
