PSALOG3.m

PSALOG3 ;BIR/LTL-Post Drug Procurement History - CONT'D;7/23/97

 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;; 10/24/97

 ;This routine contains the warehouse drug report. It is called by PSALOG2.

 ;

LOOP2 S PSAPG=0 D HEADER2

 S (PSA(33),PSA(55))=0

 F  S PSA(33)=$O(^TMP("PSAC",$J,PSA(33))) Q:'PSA(33)!(PSAOUT)  D:$Y+4>IOSL HEADER2 Q:PSAOUT  F  S PSA(55)=$O(^TMP("PSAC",$J,+PSA(33),PSA(55))) Q:'PSA(55)!($P($G(^TMP("PSAC",$J,+PSA(33),+PSA(55))),U)<PSA(44))  D

 .W !,$E($$DESCR^PRCPUX1($P($G(^TMP("PSAC",$J,+PSA(33),PSA(55))),U,2),PSA(55)),1,50)

 .S X=$P($G(^TMP("PSAC",$J,+PSA(33),PSA(55))),U),X2="2$"

 .D COMMA^%DTC W ?53,X,"(",$E($$INVNAME^PRCPUX1($P($G(^TMP("PSAC",$J,+PSA(33),PSA(55))),U,2)),1,20),")",!

 I $E(IOST,1,2)="C-",'PSAOUT W ! S DIR(0)="EA",DIR("A")="END OF REPORT!  Press <RET> to return to the option." D ^DIR

 K ^TMP("PSAC",$J) S PSAOUT=1 Q

HEADER2 I $E(IOST,1,2)'="P-",PSAPG S DIR(0)="E" D ^DIR K DIR I 'Y S PSAOUT=1 Q

 I $$S^%ZTLOAD W !!,"Task #",$G(ZTSK),", ",$G(ZTDESC)," was stopped by ",$P($G(^VA(200,+$G(DUZ),0)),U),"." S PSAOUT=1 Q

 W:$Y @IOF S PSAPG=PSAPG+1 W !,"High Cost Items Over $",PSA(44),?57,"TOTAL $",?75,"PSAPG:",PSAPG,!,PSALN

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSALOG3   1183     printed  Mar 13, 2025@20:54:19                                                                                                                                                                                                     Page 2

PSALOG3   ;BIR/LTL-Post Drug Procurement History - CONT'D;7/23/97

 +1       ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;; 10/24/97

 +2       ;This routine contains the warehouse drug report. It is called by PSALOG2.

 +3       ;

LOOP2      SET PSAPG=0

           DO HEADER2

 +1        SET (PSA(33),PSA(55))=0

 +2        FOR 

               SET PSA(33)=$ORDER(^TMP("PSAC",$JOB,PSA(33)))

               if 'PSA(33)!(PSAOUT)

                   QUIT 

               if $Y+4>IOSL

                   DO HEADER2

               if PSAOUT

                   QUIT 

               FOR 

                   SET PSA(55)=$ORDER(^TMP("PSAC",$JOB,+PSA(33),PSA(55)))

                   if 'PSA(55)!($PIECE($GET(^TMP("PSAC",$JOB,+PSA(33),+PSA(55))),U)<PSA(44))

                       QUIT 

                   Begin DoDot:1

 +3                    WRITE !,$EXTRACT($$DESCR^PRCPUX1($PIECE($GET(^TMP("PSAC",$JOB,+PSA(33),PSA(55))),U,2),PSA(55)),1,50)

 +4                    SET X=$PIECE($GET(^TMP("PSAC",$JOB,+PSA(33),PSA(55))),U)

                       SET X2="2$"

 +5                    DO COMMA^%DTC

                       WRITE ?53,X,"(",$EXTRACT($$INVNAME^PRCPUX1($PIECE($GET(^TMP("PSAC",$JOB,+PSA(33),PSA(55))),U,2)),1,20),")",!

                   End DoDot:1

 +6        IF $EXTRACT(IOST,1,2)="C-"

               IF 'PSAOUT

                   WRITE !

                   SET DIR(0)="EA"

                   SET DIR("A")="END OF REPORT!  Press <RET> to return to the option."

                   DO ^DIR

 +7        KILL ^TMP("PSAC",$JOB)

           SET PSAOUT=1

           QUIT 

HEADER2    IF $EXTRACT(IOST,1,2)'="P-"

               IF PSAPG

                   SET DIR(0)="E"

                   DO ^DIR

                   KILL DIR

                   IF 'Y

                       SET PSAOUT=1

                       QUIT 

 +1        IF $$S^%ZTLOAD

               WRITE !!,"Task #",$GET(ZTSK),", ",$GET(ZTDESC)," was stopped by ",$PIECE($GET(^VA(200,+$GET(DUZ),0)),U),"."

               SET PSAOUT=1

               QUIT 

 +2        if $Y

               WRITE @IOF

           SET PSAPG=PSAPG+1

           WRITE !,"High Cost Items Over $",PSA(44),?57,"TOTAL $",?75,"PSAPG:",PSAPG,!,PSALN

 +3        QUIT