APSPSUM.m

APSPSUM ; IHS/DSD/ENM - SUMMARY LABEL LIST/SELECT RX'S ;21-Mar-2004 20:48;PLS

 ;;7.0;IHS PHARMACY MODIFICATIONS;;09/03/97

 ; Modified - IHS/CIA/PLS - 01/21/04 - Changed calls to PSONUM to APSPNUM

EP ;

 S PSOOPT=-1,PSONUM="LIST" D EN^APSPNUM

 Q

RANGE ;

 I '$D(PSOSD) D ^PSOBUILD

 I $D(PSOSD)'>1 W !,"This patient has no prescriptions to act on. " G RANGEX

 S PSOHI=PSOSD

 ;I $G(PSOOPT)'=3,$G(PSOOPT)'=4 N:$G(PSOOPT)]"" PSOOPT S PSOOPT=-1

 ;D ^PSODSPL Q:PSOQFLG  ;display profile

 I '$G(APSPFLG) D ^PSODSPL Q:PSOQFLG  ;IHS/DSD/ENM 3.29.93 display profile

 D ^APSPLIST ;select range of #s to refill

 I 'Y Q

 ;F PS=1:1 Q:'$D(Y(PS))

 ;S M=1,PSOLIST(1)=""

 ;F I=1:1:PS-1 F J=1:1:$L(Y(I),",") S N=$P(Y(I),",",J) S DRG="" F K=1:1:N S DRG=$O(PSOSD(DRG)),RXN=+PSOSD(DRG) S:K=N PSOLIST(M)=PSOLIST(M)_RXN_"," S:$L(PSOLIST(M)_RXN_1)>220 M=M+1,PSOLIST(M)=""

 ;K X,Y,DIR

RANGEX Q

APSPSUM   ; IHS/DSD/ENM - SUMMARY LABEL LIST/SELECT RX'S ;21-Mar-2004 20:48;PLS

 +1       ;;7.0;IHS PHARMACY MODIFICATIONS;;09/03/97

 +2       ; Modified - IHS/CIA/PLS - 01/21/04 - Changed calls to PSONUM to APSPNUM

EP        ;

 +1        SET PSOOPT=-1

           SET PSONUM="LIST"

           DO EN^APSPNUM

 +2        QUIT 

RANGE     ;

 +1        IF '$DATA(PSOSD)

               DO ^PSOBUILD

 +2        IF $DATA(PSOSD)'>1

               WRITE !,"This patient has no prescriptions to act on. "

               GOTO RANGEX

 +3        SET PSOHI=PSOSD

 +4       ;I $G(PSOOPT)'=3,$G(PSOOPT)'=4 N:$G(PSOOPT)]"" PSOOPT S PSOOPT=-1

 +5       ;D ^PSODSPL Q:PSOQFLG  ;display profile

 +6       ;IHS/DSD/ENM 3.29.93 display profile

           IF '$GET(APSPFLG)

               DO ^PSODSPL

               IF PSOQFLG

                   QUIT 

 +7       ;select range of #s to refill

           DO ^APSPLIST

 +8        IF 'Y

               QUIT 

 +9       ;F PS=1:1 Q:'$D(Y(PS))

 +10      ;S M=1,PSOLIST(1)=""

 +11      ;F I=1:1:PS-1 F J=1:1:$L(Y(I),",") S N=$P(Y(I),",",J) S DRG="" F K=1:1:N S DRG=$O(PSOSD(DRG)),RXN=+PSOSD(DRG) S:K=N PSOLIST(M)=PSOLIST(M)_RXN_"," S:$L(PSOLIST(M)_RXN_1)>220 M=M+1,PSOLIST(M)=""

 +12      ;K X,Y,DIR

RANGEX     QUIT