- PSAOP4 ;BIR/LTL-Outpatient Dispensing (Single Drug) & (All Drugs) - CONT'D ;7/23/97
- ;;3.0;DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,76**; 10/24/97;Build 1
- ;This routine gathers outpatient dispensing and is called by PSAOP2.
- ;
- N PSADRUGN S PSADRUGN=0
- F S PSADRUGN=$O(^TMP("PSA",$J,PSADRUGN)) Q:PSADRUGN="" S PSADRUG=$O(^PSDRUG("B",PSADRUGN,0)) D ;;<< RJS-*76
- .S PSA(2)=0 F S PSA(2)=$O(^TMP("PSA",$J,PSADRUGN,PSA(2))) Q:'PSA(2) D
- ..S PSA(3)=+^TMP("PSA",$J,PSADRUGN,PSA(2)) D TMP^PSAOP1
- ..K:$D(^XTMP("PSA",PSAS,PSADRUGN)) ^XTMP("PSA",PSAS,PSADRUGN)
- QUIT K ^TMP("PSA",$J) S:$D(ZTQUEUED) ZTREQ="@"
- Q
- ;
- AM ;Collects partial fills released & returned to stock.
- F S PSAP=$O(^PSRX("AM",PSAP)) Q:'PSAP F S PSAP(1)=$O(^PSRX("AM",+PSAP,PSAP(1))) Q:'PSAP(1) D:$P($G(^PSRX(+PSAP(1),0)),U,6)=PSADRUG&($P($G(^PSRX(+PSAP(1),2)),U,9)=PSAS)
- .S PSAP(2)="" F S PSAP(2)=$O(^PSRX("AM",+PSAP,+PSAP(1),PSAP(2))) Q:'PSAP(2) S $P(^TMP("PSA",$J,+PSADRUG,$E(PSAP,1,7)),U)=$P($G(^TMP("PSA",$J,+PSADRUG,$E(PSAP,1,7))),U)+$P($G(^PSRX(+PSAP(1),"P",+PSAP(2),0)),U,4) D
- ..S $P(^TMP("PSA",$J,+PSADRUG,$E(PSAP,1,7)),U,6)=PSAP,$P(^($E(PSAP,1,7)),U,7)=PSAP(1)
- F S PSAN=$O(^PSRX("AN",PSAN)) Q:'PSAN F S PSAN(1)=$O(^PSRX("AN",+PSAN,PSAN(1))) Q:'PSAN(1) D:$P($G(^PSRX(+PSAN(1),0)),U,6)=PSADRUG&($P($G(^PSRX(+PSAN(1),2)),U,0)=PSAS)
- .S PSAN(2)="" F S PSAN(2)=$O(^PSRX("AN",+PSAN,+PSAN(1),PSAN(2))) Q:'PSAN(2) S $P(^TMP("PSA",$J,+PSADRUG,$E(PSAN,1,7)),U)=$P($G(^($E(PSAN,1,7))),U)-$P($G(^PSRX(+PSAN(1),"P",+PSAN(2),0)),U,4) D
- ..S $P(^TMP("PSA",$J,+PSADRUG,$E(PSAN,1,7)),U,8)=PSAN,$P(^($E(PSAN,1,7)),U,9)=PSAN(1)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSAOP4 1626 printed Feb 18, 2025@23:16:15 Page 2
- PSAOP4 ;BIR/LTL-Outpatient Dispensing (Single Drug) & (All Drugs) - CONT'D ;7/23/97
- +1 ;;3.0;DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,76**; 10/24/97;Build 1
- +2 ;This routine gathers outpatient dispensing and is called by PSAOP2.
- +3 ;
- +4 NEW PSADRUGN
- SET PSADRUGN=0
- +5 ;;<< RJS-*76
- FOR
- SET PSADRUGN=$ORDER(^TMP("PSA",$JOB,PSADRUGN))
- if PSADRUGN=""
- QUIT
- SET PSADRUG=$ORDER(^PSDRUG("B",PSADRUGN,0))
- Begin DoDot:1
- +6 SET PSA(2)=0
- FOR
- SET PSA(2)=$ORDER(^TMP("PSA",$JOB,PSADRUGN,PSA(2)))
- if 'PSA(2)
- QUIT
- Begin DoDot:2
- +7 SET PSA(3)=+^TMP("PSA",$JOB,PSADRUGN,PSA(2))
- DO TMP^PSAOP1
- +8 if $DATA(^XTMP("PSA",PSAS,PSADRUGN))
- KILL ^XTMP("PSA",PSAS,PSADRUGN)
- End DoDot:2
- End DoDot:1
- QUIT KILL ^TMP("PSA",$JOB)
- if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +1 QUIT
- +2 ;
- AM ;Collects partial fills released & returned to stock.
- +1 FOR
- SET PSAP=$ORDER(^PSRX("AM",PSAP))
- if 'PSAP
- QUIT
- FOR
- SET PSAP(1)=$ORDER(^PSRX("AM",+PSAP,PSAP(1)))
- if 'PSAP(1)
- QUIT
- if $PIECE($GET(^PSRX(+PSAP(1),0)),U,6)=PSADRUG&($PIECE($GET(^PSRX(+PSAP(1),2)),U,9)=PSAS)
- Begin DoDot:1
- +2 SET PSAP(2)=""
- FOR
- SET PSAP(2)=$ORDER(^PSRX("AM",+PSAP,+PSAP(1),PSAP(2)))
- if 'PSAP(2)
- QUIT
- SET $PIECE(^TMP("PSA",$JOB,+PSADRUG,$EXTRACT(PSAP,1,7)),U)=$PIECE($GET(^TMP("PSA",$JOB,+PSADRUG,$EXTRACT(PSAP,1,7))),U)+$PIECE($GET(^PSRX(+PSAP(1),"P",+PSAP(2),0)),U,4)
- Begin DoDot:2
- +3 SET $PIECE(^TMP("PSA",$JOB,+PSADRUG,$EXTRACT(PSAP,1,7)),U,6)=PSAP
- SET $PIECE(^($EXTRACT(PSAP,1,7)),U,7)=PSAP(1)
- End DoDot:2
- End DoDot:1
- +4 FOR
- SET PSAN=$ORDER(^PSRX("AN",PSAN))
- if 'PSAN
- QUIT
- FOR
- SET PSAN(1)=$ORDER(^PSRX("AN",+PSAN,PSAN(1)))
- if 'PSAN(1)
- QUIT
- if $PIECE($GET(^PSRX(+PSAN(1),0)),U,6)=PSADRUG&($PIECE($GET(^PSRX(+PSAN(1),2)),U,0)=PSAS)
- Begin DoDot:1
- +5 SET PSAN(2)=""
- FOR
- SET PSAN(2)=$ORDER(^PSRX("AN",+PSAN,+PSAN(1),PSAN(2)))
- if 'PSAN(2)
- QUIT
- SET $PIECE(^TMP("PSA",$JOB,+PSADRUG,$EXTRACT(PSAN,1,7)),U)=$PIECE($GET(^($EXTRACT(PSAN,1,7))),U)-$PIECE($GET(^PSRX(+PSAN(1),"P",+PSAN(2),0)),U,4)
- Begin DoDot:2
- +6 SET $PIECE(^TMP("PSA",$JOB,+PSADRUG,$EXTRACT(PSAN,1,7)),U,8)=PSAN
- SET $PIECE(^($EXTRACT(PSAN,1,7)),U,9)=PSAN(1)
- End DoDot:2
- End DoDot:1
- +7 QUIT
