PSOCOPAY.m

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 ---PSOCOPAY   681     printed  Apr 09, 2024@21:31:13                                                                                                                                                                                                     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