PSDADJB ;BIR/LTL-Review Adjustment Transactions for a Drug; 2 Nov 94 [ 05/01/95 3:11 PM ]
;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
START ;compiles and prints output
S PSDTI="Adjustments from "_PSDTB(2)_" to "_PSDTB(3)
N PSDR,PG S PSDT=PSDTB,CNT=0 S $P(LN,"-",81)=""
LOOP F S PSDT=$O(^PSD(58.81,"ACT",PSDT)) Q:'PSDT!(PSDT>PSDTB(1)) I $O(^PSD(58.81,"ACT",PSDT,0))=PSDLOC S PSDT(1)=$O(^PSD(58.81,"ACT",PSDT,PSDLOC,0)) I $D(PSDA(+PSDT(1))),$O(^PSD(58.81,"ACT",PSDT,PSDLOC,+PSDT(1),9,0)) D
.S PSDR(2)=$G(^PSD(58.81,+$O(^PSD(58.81,"ACT",PSDT,PSDLOC,+PSDT(1),9,0)),0))
.S CNT=$G(CNT)+1,^TMP("PSD",$J,CNT)=LN
.S CNT=$G(CNT)+1,^TMP("PSD",$J,CNT)=PSDA(+PSDT(1))
.S Y=$E($P(PSDR(2),U,4),1,12),CNT=$G(CNT)+1 X ^DD("DD") S ^TMP("PSD",$J,CNT)=Y_" "_" -> "_$P(PSDR(2),U,6)_" adjusted by "_$P($G(^VA(200,+$P(PSDR(2),U,7),0)),U)
.S CNT=$G(CNT)+1,^TMP("PSD",$J,CNT)="Reason: "_$P(PSDR(2),U,16)
D BROWSE^DDBR("^TMP(""PSD"",$J)","NR",PSDTI)
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")
K ^TMP("PSD",$J) Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDADJB 1148 printed Dec 13, 2024@01:44:50 Page 2
PSDADJB ;BIR/LTL-Review Adjustment Transactions for a Drug; 2 Nov 94 [ 05/01/95 3:11 PM ]
+1 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
START ;compiles and prints output
+1 SET PSDTI="Adjustments from "_PSDTB(2)_" to "_PSDTB(3)
+2 NEW PSDR,PG
SET PSDT=PSDTB
SET CNT=0
SET $PIECE(LN,"-",81)=""
LOOP FOR
SET PSDT=$ORDER(^PSD(58.81,"ACT",PSDT))
if 'PSDT!(PSDT>PSDTB(1))
QUIT
IF $ORDER(^PSD(58.81,"ACT",PSDT,0))=PSDLOC
SET PSDT(1)=$ORDER(^PSD(58.81,"ACT",PSDT,PSDLOC,0))
IF $DATA(PSDA(+PSDT(1)))
IF $ORDER(^PSD(58.81,"ACT",PSDT,PSDLOC,+PSDT(1),9,0))
Begin DoDot:1
+1 SET PSDR(2)=$GET(^PSD(58.81,+$ORDER(^PSD(58.81,"ACT",PSDT,PSDLOC,+PSDT(1),9,0)),0))
+2 SET CNT=$GET(CNT)+1
SET ^TMP("PSD",$JOB,CNT)=LN
+3 SET CNT=$GET(CNT)+1
SET ^TMP("PSD",$JOB,CNT)=PSDA(+PSDT(1))
+4 SET Y=$EXTRACT($PIECE(PSDR(2),U,4),1,12)
SET CNT=$GET(CNT)+1
XECUTE ^DD("DD")
SET ^TMP("PSD",$JOB,CNT)=Y_" "_" -> "_$PIECE(PSDR(2),U,6)_" adjusted by "_$PIECE($GET(^VA(200,+$PIECE(PSDR(2),U,7),0)),U)
+5 SET CNT=$GET(CNT)+1
SET ^TMP("PSD",$JOB,CNT)="Reason: "_$PIECE(PSDR(2),U,16)
End DoDot:1
+6 DO BROWSE^DDBR("^TMP(""PSD"",$J)","NR",PSDTI)
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 KILL ^TMP("PSD",$JOB)
QUIT
