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