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
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 ---[H[J[2J[HPSALOG3 1183 printed Sep 23, 2025@19:25:42 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
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
