28 lines
2.5 KiB
Mathematica
28 lines
2.5 KiB
Mathematica
PSOSUSRP ;BHAM ISC/RTR-Reprint label driver routine ; 7/20/96
|
|
;;7.0;OUTPATIENT PHARMACY;;DEC 1997
|
|
;
|
|
BEG ;
|
|
G:'$D(^UTILITY($J,"PSOREPT")) END
|
|
S (PATIFLAG,RECOUNT)=0
|
|
F AAAA=0:0 S AAAA=$O(^UTILITY($J,"PSOREPT",AAAA)) Q:'AAAA F BBBB=0:0 S BBBB=$O(^UTILITY($J,"PSOREPT",AAAA,BBBB)) Q:'BBBB F CCCC=0:0 S CCCC=$O(^UTILITY($J,"PSOREPT",AAAA,BBBB,CCCC)) Q:'CCCC D
|
|
.F DDDD=0:0 S DDDD=$O(^PS(52.5,"AS",AAAA,BBBB,CCCC,DDDD)) Q:'DDDD F EEEE=0:0 S EEEE=$O(^PS(52.5,"AS",AAAA,BBBB,CCCC,DDDD,EEEE)) Q:'EEEE D:$D(^PS(52.5,EEEE,0))&($P($G(^(0)),"^"))&($P($G(^(0)),"^",3))
|
|
..S DFN=$P(^PS(52.5,EEEE,0),"^",3) D DEM^VADPT S HLDDEAD=VADM(6) K VADM,VA("PID"),VA("BID"),DFN I HLDDEAD'="" S DA=EEEE,DIK="^PS(52.5," D ^DIK Q
|
|
..I 'PATIFLAG S OPATIENT=$P(^PS(52.5,EEEE,0),"^",3),PATIFLAG=1
|
|
..S NPATIENT=$P(^PS(52.5,EEEE,0),"^",3) D:OPATIENT'=NPATIENT!(RECOUNT>15) S REHLDPPL=$S('$G(REHLDPPL):$P(^PS(52.5,EEEE,0),"^")_",",1:REHLDPPL_$P(^PS(52.5,EEEE,0),"^")_","),RECOUNT=RECOUNT+1,OPATIENT=$P(^PS(52.5,EEEE,0),"^",3)
|
|
...S PPL=REHLDPPL,RECOUNT=0,PSOSUREP=1,PDUZ=DUZ K REHLDPPL D D:$G(PPL) DQ^PSOLBL K PPL,RXRP,RXPR,RXFL
|
|
....S REPCOUNT=0 F FFF=1:1:$L(PPL) S FFFF=$E(PPL,FFF) I FFFF="," S REPCOUNT=REPCOUNT+1
|
|
....F GGGG=1:1:REPCOUNT S HHHH=$P(PPL,",",GGGG) S MMMM=$O(^PS(52.5,"B",HHHH,0)),NNNN=+$P($G(^PS(52.5,+MMMM,0)),"^",5) S:NNNN RXPR(HHHH)=$P($G(^(0)),"^",5) S RXFL(HHHH)=$P($G(^PS(52.5,+MMMM,0)),"^",13)
|
|
I $G(REHLDPPL) S PPL=REHLDPPL,PSOSUREP=1,PDUZ=DUZ D D:$G(PPL) DQ^PSOLBL K RXFL
|
|
.S REPCOUNT=0 F FFF=1:1:$L(PPL) S FFFF=$E(PPL,FFF) I FFFF="," S REPCOUNT=REPCOUNT+1
|
|
.F GGGG=1:1:REPCOUNT S HHHH=$P(PPL,",",GGGG) S MMMM=$O(^PS(52.5,"B",HHHH,0)),NNNN=+$P($G(^PS(52.5,+MMMM,0)),"^",5) S:NNNN RXPR(HHHH)=$P($G(^(0)),"^",5) S RXFL(HHHH)=$P($G(^PS(52.5,+MMMM,0)),"^",13)
|
|
END K ^UTILITY($J,"PSOREPT"),AAAA,BBBB,CCCC,DDDD,EEEE,FFF,FFFF,GGGG,HHHH,MMMM,NNNN,NPATIENT,OPATIENT,PATIFLAG,PPL,HLDDEAD,RECOUNT,REHLDPPL,REPCOUNT,RXPR,RXRP,RXFL D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" Q
|
|
AREC ;
|
|
N RFLNUM
|
|
S PSOREEPF=0 S PSOREEP=$O(^PS(52.5,"B",RX,0)) I $G(PSOREEP),$P($G(^PS(52.5,PSOREEP,0)),"^",12) S PSOREEPF=1
|
|
I $G(PSOREEP) S RFLNUM=$P($G(^PS(52.5,PSOREEP,0)),"^",13) I RFLNUM>5 S RFLNUM=RFLNUM+1
|
|
D NOW^%DTC S DTTM=%,COM="Suspense "_$S($G(PSOREEPF):"(Reprint) ",1:"")_"Label Reprinted"_$S($G(RXP):" (Partial)",1:"")
|
|
S CNT=0 F JJ=0:0 S JJ=$O(^PSRX(RX,"A",JJ)) Q:'JJ S CNT=JJ
|
|
S RFCNT=0 F RF=0:0 S RF=$O(^PSRX(RX,1,RF)) Q:'RF S RFCNT=RF S:RF>5 RFCNT=RF+1
|
|
S CNT=CNT+1,^PSRX(RX,"A",0)="^52.3DA^"_CNT_"^"_CNT S ^PSRX(RX,"A",CNT,0)=DTTM_"^S^"_PDUZ_"^"_$S($G(RXP):6,$G(RFLNUM)'="":$G(RFLNUM),1:RFCNT)_"^"_COM
|
|
K PSOREEP,PSOREEPF Q
|