PSOCOPAY ;BHAM ISC/RTR - DAYS SUPPLY TOTAL FOR ACCOUNTS RECEIVABLE ; 07/28/93
;;7.0;OUTPATIENT PHARMACY;;DEC 1997
POT(DFN) N FILL,RECNO,DAYS S X=0 G:'$G(DFN) END
S FILL="" F S FILL=$O(^PSRX("ACP",DFN,DT,FILL)) Q:FILL="" F RECNO=0:0 S RECNO=$O(^PSRX("ACP",DFN,DT,FILL,RECNO)) Q:'RECNO D
.I 'FILL,$P($G(^PSRX(RECNO,0)),"^",11)="W",$G(^PSRX(RECNO,"IB")),'+$P($G(^(2)),"^",13) S X=X+$S($P(^(0),"^",8)>60:3,$P(^(0),"^",8)>30:2,1:1) Q
.I FILL,$P($G(^PSRX(RECNO,1,FILL,0)),"^",2)="W",'+$P($G(^(0)),"^",18),$G(^PSRX(RECNO,"IB")) S DAYS=$S($P(^PSRX(RECNO,1,FILL,0),"^",10):$P(^(0),"^",10),1:$P($G(^PSRX(RECNO,0)),"^",8)) S X=X+$S(DAYS>60:3,DAYS>30:2,1:1) K DAYS Q
END ;
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOCOPAY 681 printed Nov 22, 2024@17:35:36 Page 2
PSOCOPAY ;BHAM ISC/RTR - DAYS SUPPLY TOTAL FOR ACCOUNTS RECEIVABLE ; 07/28/93
+1 ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
POT(DFN) NEW FILL,RECNO,DAYS
SET X=0
if '$GET(DFN)
GOTO END
+1 SET FILL=""
FOR
SET FILL=$ORDER(^PSRX("ACP",DFN,DT,FILL))
if FILL=""
QUIT
FOR RECNO=0:0
SET RECNO=$ORDER(^PSRX("ACP",DFN,DT,FILL,RECNO))
if 'RECNO
QUIT
Begin DoDot:1
+2 IF 'FILL
IF $PIECE($GET(^PSRX(RECNO,0)),"^",11)="W"
IF $GET(^PSRX(RECNO,"IB"))
IF '+$PIECE($GET(^(2)),"^",13)
SET X=X+$SELECT($PIECE(^(0),"^",8)>60:3,$PIECE(^(0),"^",8)>30:2,1:1)
QUIT
+3 IF FILL
IF $PIECE($GET(^PSRX(RECNO,1,FILL,0)),"^",2)="W"
IF '+$PIECE($GET(^(0)),"^",18)
IF $GET(^PSRX(RECNO,"IB"))
SET DAYS=$SELECT($PIECE(^PSRX(RECNO,1,FILL,0),"^",10):$PIECE(^(0),"^",10),1:$PIECE($GET(^PSRX(RECNO,0)),"^",8))
SET X=X+$SELECT(DAYS>60:3,DAYS>30:2,1:1)
KILL DAYS
QUIT
End DoDot:1
END ;
+1 QUIT X
