PSACONW ;BIR/LTL-Display Connected Drug and Procurement History - CONT'D ;7/23/97
;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**15**; 10/24/97
;This routine contains the history of warehoused drugs. It is called
;by PSACON.
;
;References to $$INVNAME^PRCPUX1 are covered by IA #259
;References to ^PSDRUG( are covered by IA #2095
;References to ^PRCP( are covered by IA #214
;
N PSAI,PSAD,PSAN,PSAQ S (PSAI,PSAOUT)=0
W !!,"The Supply Warehouse is the mandatory source for this item.",!
I '$O(^PRCP(445.2,"AD",+PSAW,+PSA(1),"")) W !!,"NO HISTORY!" Q
W !,"There is a procurement history."
S DIR(0)="D",DIR("A")="How far back in time would you like to view",DIR("B")="T-3M" W ! D ^DIR K DIR S PSAD=Y I $D(DIRUT) S PSAOUT=1 G QUIT
X ^DD("DD") S PSAD(2)=Y
D NOW^%DTC S X1=X,X2=PSAD D ^%DTC S PSAD(1)=$S(X/30>0:X/30,1:1)
K IO("Q") N %ZIS,IOP,POP S %ZIS="Q" W ! D ^%ZIS
I POP W !,"NO DEVICE SELECTED OR OUTPUT PRINTED!" S PSAOUT=1 G QUIT
I $D(IO("Q")) N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTDTH,ZTSK S ZTRTN="LOOP^PSACONW",ZTDESC="Drug Issue history",ZTSAVE("PSA*")="" D ^%ZTLOAD,HOME^%ZIS S PSAOUT=1 G QUIT
LOOP N PSALN,PSAPG S PSAPG=0 D HEADER
F S PSAI=$O(^PRCP(445.2,"AD",+PSAW,+PSA(1),+PSAI)) Q:PSAOUT!('PSAI) D:$Y+4>IOSL HEADER G:PSAOUT QUIT I $P($G(^PRCP(445.2,PSAI,0)),U,2)?1"R".N S PSAN=$G(^(0)) D:$G(PSAN)&($P($G(PSAN),U,17)'<PSAD)
.S Y=$P($P(PSAN,U,17),".") D DD^%DT W !!,Y
.W ?14,$P(PSAN,U,19),?33,$J(-$P(PSAN,U,7),3) S PSAQ=$G(PSAQ)-$P(PSAN,U,7)
.W ?39,$P(PSAN,U,6)
.S X=$P(PSAN,U,9),X2="2$",X3=5 D COMMA^%DTC S PSAN(1)=X
.S X=$P(PSAN,U,9)*-$P(PSAN,U,7),X2="2$",X3=10 D COMMA^%DTC S PSAN(2)=X,PSAN(3)=$G(PSAN(3))+($P(PSAN,U,9)*-$P(PSAN,U,7))
.W ?47,PSAN(1),?55,PSAN(2)
.W ?66,$E($$INVNAME^PRCPUX1($P(PSAN,U,18)),1,14)
S X=$G(PSAQ)/PSAD(1),X2=1,X3=5 D COMMA^%DTC W !,PSALN,!!,"Average ord/mon: ",X,?24,"TOT ORD: ",$J($G(PSAQ),3),?49,"TOTAL $: " S X=$G(PSAN(3)),X2="2$",X3=4 D COMMA^%DTC W X
QUIT W:$E(IOST)'="C" @IOF
I $E(IOST,1,2)="C-",'PSAOUT S DIR(0)="EA",DIR("A")="END OF HISTORY! Press <RET> to return to the option." W ! D ^DIR K DIR
D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" K IO("Q") D HOME^%ZIS
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 $P(PSALN,"-",81)="",PSAPG=PSAPG+1
W !,$E($P($G(^PSDRUG(+PSA,0)),U),1,40),"=> from ",PSAD(2),?60,"PAGE: ",PSAPG,!,PSALN,!?2,"DATE",?16,"TRANSACTION",?33,"QTY",?39,"PKG",?47,"UNIT $",?57,"TOTAL $",?66,"INVENTORY",!,PSALN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSACONW 2596 printed Sep 23, 2025@19:25:05 Page 2
PSACONW ;BIR/LTL-Display Connected Drug and Procurement History - CONT'D ;7/23/97
+1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**15**; 10/24/97
+2 ;This routine contains the history of warehoused drugs. It is called
+3 ;by PSACON.
+4 ;
+5 ;References to $$INVNAME^PRCPUX1 are covered by IA #259
+6 ;References to ^PSDRUG( are covered by IA #2095
+7 ;References to ^PRCP( are covered by IA #214
+8 ;
+9 NEW PSAI,PSAD,PSAN,PSAQ
SET (PSAI,PSAOUT)=0
+10 WRITE !!,"The Supply Warehouse is the mandatory source for this item.",!
+11 IF '$ORDER(^PRCP(445.2,"AD",+PSAW,+PSA(1),""))
WRITE !!,"NO HISTORY!"
QUIT
+12 WRITE !,"There is a procurement history."
+13 SET DIR(0)="D"
SET DIR("A")="How far back in time would you like to view"
SET DIR("B")="T-3M"
WRITE !
DO ^DIR
KILL DIR
SET PSAD=Y
IF $DATA(DIRUT)
SET PSAOUT=1
GOTO QUIT
+14 XECUTE ^DD("DD")
SET PSAD(2)=Y
+15 DO NOW^%DTC
SET X1=X
SET X2=PSAD
DO ^%DTC
SET PSAD(1)=$SELECT(X/30>0:X/30,1:1)
+16 KILL IO("Q")
NEW %ZIS,IOP,POP
SET %ZIS="Q"
WRITE !
DO ^%ZIS
+17 IF POP
WRITE !,"NO DEVICE SELECTED OR OUTPUT PRINTED!"
SET PSAOUT=1
GOTO QUIT
+18 IF $DATA(IO("Q"))
NEW ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTDTH,ZTSK
SET ZTRTN="LOOP^PSACONW"
SET ZTDESC="Drug Issue history"
SET ZTSAVE("PSA*")=""
DO ^%ZTLOAD
DO HOME^%ZIS
SET PSAOUT=1
GOTO QUIT
LOOP NEW PSALN,PSAPG
SET PSAPG=0
DO HEADER
+1 FOR
SET PSAI=$ORDER(^PRCP(445.2,"AD",+PSAW,+PSA(1),+PSAI))
if PSAOUT!('PSAI)
QUIT
if $Y+4>IOSL
DO HEADER
if PSAOUT
GOTO QUIT
IF $PIECE($GET(^PRCP(445.2,PSAI,0)),U,2)?1"R".N
SET PSAN=$GET(^(0))
if $GET(PSAN)&($PIECE($GET(PSAN),U,17)'<PSAD)
Begin DoDot:1
+2 SET Y=$PIECE($PIECE(PSAN,U,17),".")
DO DD^%DT
WRITE !!,Y
+3 WRITE ?14,$PIECE(PSAN,U,19),?33,$JUSTIFY(-$PIECE(PSAN,U,7),3)
SET PSAQ=$GET(PSAQ)-$PIECE(PSAN,U,7)
+4 WRITE ?39,$PIECE(PSAN,U,6)
+5 SET X=$PIECE(PSAN,U,9)
SET X2="2$"
SET X3=5
DO COMMA^%DTC
SET PSAN(1)=X
+6 SET X=$PIECE(PSAN,U,9)*-$PIECE(PSAN,U,7)
SET X2="2$"
SET X3=10
DO COMMA^%DTC
SET PSAN(2)=X
SET PSAN(3)=$GET(PSAN(3))+($PIECE(PSAN,U,9)*-$PIECE(PSAN,U,7))
+7 WRITE ?47,PSAN(1),?55,PSAN(2)
+8 WRITE ?66,$EXTRACT($$INVNAME^PRCPUX1($PIECE(PSAN,U,18)),1,14)
End DoDot:1
+9 SET X=$GET(PSAQ)/PSAD(1)
SET X2=1
SET X3=5
DO COMMA^%DTC
WRITE !,PSALN,!!,"Average ord/mon: ",X,?24,"TOT ORD: ",$JUSTIFY($GET(PSAQ),3),?49,"TOTAL $: "
SET X=$GET(PSAN(3))
SET X2="2$"
SET X3=4
DO COMMA^%DTC
WRITE X
QUIT if $EXTRACT(IOST)'="C"
WRITE @IOF
+1 IF $EXTRACT(IOST,1,2)="C-"
IF 'PSAOUT
SET DIR(0)="EA"
SET DIR("A")="END OF HISTORY! Press <RET> to return to the option."
WRITE !
DO ^DIR
KILL DIR
+2 DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
KILL IO("Q")
DO HOME^%ZIS
+3 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 $PIECE(PSALN,"-",81)=""
SET PSAPG=PSAPG+1
+3 WRITE !,$EXTRACT($PIECE($GET(^PSDRUG(+PSA,0)),U),1,40),"=> from ",PSAD(2),?60,"PAGE: ",PSAPG,!,PSALN,!?2,"DATE",?16,"TRANSACTION",?33,"QTY",?39,"PKG",?47,"UNIT $",?57,"TOTAL $",?66,"INVENTORY",!,PSALN
