- 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 Feb 18, 2025@23:11:15 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