PSDADJW ;BIR/LTL-Review Adjustment Transactions for a Drug; 2 Nov 94 [ 11/02/94 12:19 PM ]
;;3.0; CONTROLLED SUBSTANCES ;**32**;13 Feb 97
;
; Reference to ^PSD(58.81 supported by DBIA # 2808
;
START ;compiles and prints output
N LN,JJ,KK,NN,PSDR,PG S (PG,PSDOUT)=0 D HEADER
LOOP F S PSDT=$O(^PSD(58.81,"ACT",PSDT)) Q:'PSDT!(PSDT>PSDTB(1)) F JJ=0:0 S JJ=$O(^PSD(58.81,"ACT",PSDT,JJ)) Q:'JJ D:JJ=PSDLOC G:PSDOUT END
.F KK=0:0 S KK=$O(^PSD(58.81,"ACT",PSDT,JJ,KK)) Q:'KK F NN=0:0 S NN=$O(^PSD(58.81,"ACT",PSDT,JJ,KK,9,NN)) Q:'NN D
..S PSDR=KK
..Q:'$D(PSDA(+PSDR))
..S PSDR(1)=NN
..S PSDR(2)=$G(^PSD(58.81,NN,0))
..D:$Y+7>IOSL HEADER Q:PSDOUT
..W !,$$FMTE^XLFDT($E($P(PSDR(2),U,4),1,12),"2P"),?18,PSDA(PSDR)
..W ?61,$J($P(PSDR(2),U,6),6),?69,$P(PSDR(2),U,16),?116
..W $E($P($G(^VA(200,+$P(PSDR(2),U,7),0)),U),1,16),!
END W:$E(IOST)'="C" @IOF
I $E(IOST)="C",'PSDOUT S DIR(0)="EA",DIR("A")="END OF REPORT! Press <RET> to return to the menu." D ^DIR
D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" K IO("Q")
Q
I $E(IOST,1,2)'="P-",PG S DIR(0)="E" D ^DIR K DIR I 'Y S PSDOUT=1 Q
I $$S^%ZTLOAD W !!,"Task #",$G(ZTSK),", ",$G(ZTDESC)," was stopped by ",$P($G(^VA(200,+$G(DUZ),0)),U),"." S PSDOUT=1
W:$Y @IOF S $P(LN,"-",80)="",PG=PG+1 W !,"Adjustments from ",PSDTB(2)," to ",PSDTB(3),?70,"PAGE: ",PG,!,LN,!?2,"Date",?18,"Drug",?64,"QTY",?69,"Reason",?116,"Pharmacist",!,LN,!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDADJW 1435 printed Dec 13, 2024@01:44:57 Page 2
PSDADJW ;BIR/LTL-Review Adjustment Transactions for a Drug; 2 Nov 94 [ 11/02/94 12:19 PM ]
+1 ;;3.0; CONTROLLED SUBSTANCES ;**32**;13 Feb 97
+2 ;
+3 ; Reference to ^PSD(58.81 supported by DBIA # 2808
+4 ;
START ;compiles and prints output
+1 NEW LN,JJ,KK,NN,PSDR,PG
SET (PG,PSDOUT)=0
DO HEADER
LOOP FOR
SET PSDT=$ORDER(^PSD(58.81,"ACT",PSDT))
if 'PSDT!(PSDT>PSDTB(1))
QUIT
FOR JJ=0:0
SET JJ=$ORDER(^PSD(58.81,"ACT",PSDT,JJ))
if 'JJ
QUIT
if JJ=PSDLOC
Begin DoDot:1
+1 FOR KK=0:0
SET KK=$ORDER(^PSD(58.81,"ACT",PSDT,JJ,KK))
if 'KK
QUIT
FOR NN=0:0
SET NN=$ORDER(^PSD(58.81,"ACT",PSDT,JJ,KK,9,NN))
if 'NN
QUIT
Begin DoDot:2
+2 SET PSDR=KK
+3 if '$DATA(PSDA(+PSDR))
QUIT
+4 SET PSDR(1)=NN
+5 SET PSDR(2)=$GET(^PSD(58.81,NN,0))
+6 if $Y+7>IOSL
DO HEADER
if PSDOUT
QUIT
+7 WRITE !,$$FMTE^XLFDT($EXTRACT($PIECE(PSDR(2),U,4),1,12),"2P"),?18,PSDA(PSDR)
+8 WRITE ?61,$JUSTIFY($PIECE(PSDR(2),U,6),6),?69,$PIECE(PSDR(2),U,16),?116
+9 WRITE $EXTRACT($PIECE($GET(^VA(200,+$PIECE(PSDR(2),U,7),0)),U),1,16),!
End DoDot:2
End DoDot:1
if PSDOUT
GOTO END
END if $EXTRACT(IOST)'="C"
WRITE @IOF
+1 IF $EXTRACT(IOST)="C"
IF 'PSDOUT
SET DIR(0)="EA"
SET DIR("A")="END OF REPORT! Press <RET> to return to the menu."
DO ^DIR
+2 DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
KILL IO("Q")
+3 QUIT
+1 IF $EXTRACT(IOST,1,2)'="P-"
IF PG
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET PSDOUT=1
QUIT
+2 IF $$S^%ZTLOAD
WRITE !!,"Task #",$GET(ZTSK),", ",$GET(ZTDESC)," was stopped by ",$PIECE($GET(^VA(200,+$GET(DUZ),0)),U),"."
SET PSDOUT=1
+3 if $Y
WRITE @IOF
SET $PIECE(LN,"-",80)=""
SET PG=PG+1
WRITE !,"Adjustments from ",PSDTB(2)," to ",PSDTB(3),?70,"PAGE: ",PG,!,LN,!?2,"Date",?18,"Drug",?64,"QTY",?69,"Reason",?116,"Pharmacist",!,LN,!
+4 QUIT
