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 Dec 13, 2024@01:45:09 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
