PSDBALI1.m

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 ---PSDBALI1   1276     printed  Apr 09, 2024@20:51:46                                                                                                                                                                                                    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