- PSDBALI1 ;BIR/JPW-Display/Prt Drug Inv Sheet & Bal (cont'd) ; 12 Apr 94
- ;;3.0;CONTROLLED SUBSTANCES;**73**;13 Feb 97;Build 8
- PRINT ;prints data
- S TYPN="" F S TYPN=$O(^TMP("PSDBALI",$J,TYPN)) Q:TYPN=""!(PSDOUT) W !,?2,"=> INVENTORY TYPE: ",$S($E(TYPN,1,2)="ZZ":$E(TYPN,3,99),1:TYPN),! D
- .S PSDR="" F S PSDR=$O(^TMP("PSDBALI",$J,TYPN,PSDR)) Q:PSDR=""!(PSDOUT) F PSD=0:0 S PSD=$O(^TMP("PSDBALI",$J,TYPN,PSDR,PSD)) Q:'PSD D Q:PSDOUT
- ..I $Y+6>IOSL W !,?10,"Inspector's Signature: ______________________________",! D HDR Q:PSDOUT W !,?2,"=> INVENTORY TYPE: ",$S($E(TYPN,1,2)="ZZ":$E(TYPN,3,99),1:TYPN),!
- ..S NODE=^TMP("PSDBALI",$J,TYPN,PSDR,PSD),BAL=+NODE,PSDOK=$P(NODE,"^",2),SLVL=$P(NODE,"^",3),EXP=$P(NODE,"^",4)
- ..W !,PSDOK,?2,PSDR,?45,$J(BAL,6),?61,$$SCH^PSDBAL(+$P(NODE,"^",5)),?67,"___________",! W:SLVL ?5,"Stock Level: ",SLVL W:EXP]"" ?30,"Exp. Date: ",EXP W ! S LNUM=$Y
- PRT ;
- I LNUM<IOSL-5 F JJ=LNUM:1:IOSL-5 W !
- W:'PSDOUT ?10,"Inspector's Signature: ______________________________",!
- Q
- HDR ;header
- I $E(IOST,1,2)="C-",PG K DA,DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSDOUT=1 Q
- S PG=PG+1 W:$Y @IOF W !,?12,"Inventory Sheet for ",PSDSN,?72,"Page: ",PG,!,?20,RPDT,!!
- W ?5,"DRUG",?41,"CURRENT BALANCE",?58,"SCHEDULE",?69,"ON-HAND",!,LN,!!
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDBALI1 1276 printed Mar 13, 2025@20:49:50 Page 2
- PSDBALI1 ;BIR/JPW-Display/Prt Drug Inv Sheet & Bal (cont'd) ; 12 Apr 94
- +1 ;;3.0;CONTROLLED SUBSTANCES;**73**;13 Feb 97;Build 8
- PRINT ;prints data
- +1 SET TYPN=""
- FOR
- SET TYPN=$ORDER(^TMP("PSDBALI",$JOB,TYPN))
- if TYPN=""!(PSDOUT)
- QUIT
- WRITE !,?2,"=> INVENTORY TYPE: ",$SELECT($EXTRACT(TYPN,1,2)="ZZ":$EXTRACT(TYPN,3,99),1:TYPN),!
- Begin DoDot:1
- +2 SET PSDR=""
- FOR
- SET PSDR=$ORDER(^TMP("PSDBALI",$JOB,TYPN,PSDR))
- if PSDR=""!(PSDOUT)
- QUIT
- FOR PSD=0:0
- SET PSD=$ORDER(^TMP("PSDBALI",$JOB,TYPN,PSDR,PSD))
- if 'PSD
- QUIT
- Begin DoDot:2
- +3 IF $Y+6>IOSL
- WRITE !,?10,"Inspector's Signature: ______________________________",!
- DO HDR
- if PSDOUT
- QUIT
- WRITE !,?2,"=> INVENTORY TYPE: ",$SELECT($EXTRACT(TYPN,1,2)="ZZ":$EXTRACT(TYPN,3,99),1:TYPN),!
- +4 SET NODE=^TMP("PSDBALI",$JOB,TYPN,PSDR,PSD)
- SET BAL=+NODE
- SET PSDOK=$PIECE(NODE,"^",2)
- SET SLVL=$PIECE(NODE,"^",3)
- SET EXP=$PIECE(NODE,"^",4)
- +5 WRITE !,PSDOK,?2,PSDR,?45,$JUSTIFY(BAL,6),?61,$$SCH^PSDBAL(+$PIECE(NODE,"^",5)),?67,"___________",!
- if SLVL
- WRITE ?5,"Stock Level: ",SLVL
- if EXP]""
- WRITE ?30,"Exp. Date: ",EXP
- WRITE !
- SET LNUM=$Y
- End DoDot:2
- if PSDOUT
- QUIT
- End DoDot:1
- PRT ;
- +1 IF LNUM<IOSL-5
- FOR JJ=LNUM:1:IOSL-5
- WRITE !
- +2 if 'PSDOUT
- WRITE ?10,"Inspector's Signature: ______________________________",!
- +3 QUIT
- HDR ;header
- +1 IF $EXTRACT(IOST,1,2)="C-"
- IF PG
- KILL DA,DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF 'Y
- SET PSDOUT=1
- QUIT
- +2 SET PG=PG+1
- if $Y
- WRITE @IOF
- WRITE !,?12,"Inventory Sheet for ",PSDSN,?72,"Page: ",PG,!,?20,RPDT,!!
- +3 WRITE ?5,"DRUG",?41,"CURRENT BALANCE",?58,"SCHEDULE",?69,"ON-HAND",!,LN,!!
- +4 QUIT
