Routine: PSODISP2

PSODISP2 ;BHAM ISC/SAB - report of released scripts ; 03/29/93 16:49

 ;;7.0;OUTPATIENT PHARMACY;;DEC 1997

 S (RXN,ND)=0,BDT=BEGDT-1 F  S BDT=$O(^PSRX("ADP",BDT)) Q:'BDT!(BDT>ENDDT)  F  S RXN=$O(^PSRX("ADP",BDT,RXN)) Q:'RXN  D

 .F  S ND=$O(^PSRX("ADP",BDT,RXN,ND)) Q:'ND!($G(^PSRX(RXN,0))']"")  S PAR=1,NODE=ND D  K LB,LBLP I $Y+4>IOSL D HD^PSODISP1

 ..I $P($G(^PSRX(RXN,"P",NODE,0)),"^",19),DUD Q

 ..I $P($G(^PSRX(RXN,"P",NODE,0)),"^",9)'=SITE Q

 ..I $P($G(^PSRX(RXN,"P",NODE,0)),"^",16)]"" Q

 ..S XY=$P(^PSRX(RXN,"STA"),"^") I (XY=3)!(XY=4)!(XY=13) Q

 ..I $P($G(^PSRX(RXN,"P",NODE,0)),"^",19) D   D CP1^PSODISP1

 ...W !,$P(^PSRX(RXN,0),"^"),?16,"Partial #"_NODE S Y=$P(^PSRX(RXN,"P",NODE,0),"^",19) X ^DD("DD") W ?29,$S(Y["@":$P(Y,"@"),1:Y),?50,"Yes"

 ..I '$P(^PSRX(RXN,"P",NODE,0),"^",19) D  Q:'$G(LBLP)  W !,$P(^PSRX(RXN,0),"^"),?16,"Partial #"_NODE,?50,"No" D CP1^PSODISP1 S UNREL=UNREL+1 K LBLP

 ...F LB=0:0 S LB=$O(^PSRX(RXN,"L",LB)) Q:'LB  I $P(^PSRX(RXN,"L",LB,0),"^",2)=(99-NODE) S LBLP=1

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSODISP2   1014     printed  Apr 09, 2024@21:36:06                                                                                                                                                                                                    Page 2

PSODISP2  ;BHAM ISC/SAB - report of released scripts ; 03/29/93 16:49

 +1       ;;7.0;OUTPATIENT PHARMACY;;DEC 1997

 +2        SET (RXN,ND)=0

           SET BDT=BEGDT-1

FOR

               SET BDT=$ORDER(^PSRX("ADP",BDT))

               if 'BDT!(BDT>ENDDT)

                   QUIT

FOR

                   SET RXN=$ORDER(^PSRX("ADP",BDT,RXN))

                   if 'RXN

                       QUIT

                   Begin DoDot:1

 +3                    FOR

                           SET ND=$ORDER(^PSRX("ADP",BDT,RXN,ND))

                           if 'ND!($GET(^PSRX(RXN,0))']"")

                               QUIT

                           SET PAR=1

                           SET NODE=ND

                           Begin DoDot:2

 +4                            IF $PIECE($GET(^PSRX(RXN,"P",NODE,0)),"^",19)

                                   IF DUD

                                       QUIT

 +5                            IF $PIECE($GET(^PSRX(RXN,"P",NODE,0)),"^",9)'=SITE

                                   QUIT

 +6                            IF $PIECE($GET(^PSRX(RXN,"P",NODE,0)),"^",16)]""

                                   QUIT

 +7                            SET XY=$PIECE(^PSRX(RXN,"STA"),"^")

                               IF (XY=3)!(XY=4)!(XY=13)

                                   QUIT

 +8                            IF $PIECE($GET(^PSRX(RXN,"P",NODE,0)),"^",19)

                                   Begin DoDot:3

 +9                                    WRITE !,$PIECE(^PSRX(RXN,0),"^"),?16,"Partial #"_NODE

                                       SET Y=$PIECE(^PSRX(RXN,"P",NODE,0),"^",19)

                                       XECUTE ^DD("DD")

                                       WRITE ?29,$SELECT(Y["@":$PIECE(Y,"@"),1:Y),?50,"Yes"

                                   End DoDot:3

                                   DO CP1^PSODISP1

 +10                           IF '$PIECE(^PSRX(RXN,"P",NODE,0),"^",19)

                                   Begin DoDot:3

 +11                                   FOR LB=0:0

                                           SET LB=$ORDER(^PSRX(RXN,"L",LB))

                                           if 'LB

                                               QUIT

                                           IF $PIECE(^PSRX(RXN,"L",LB,0),"^",2)=(99-NODE)

                                               SET LBLP=1

                                   End DoDot:3

                                   if '$GET(LBLP)

                                       QUIT

                                   WRITE !,$PIECE(^PSRX(RXN,0),"^"),?16,"Partial #"_NODE,?50,"No"

                                   DO CP1^PSODISP1

                                   SET UNREL=UNREL+1

                                   KILL LBLP

                           End DoDot:2

                           KILL LB,LBLP

                           IF $Y+4>IOSL

                               DO HD^PSODISP1

                   End DoDot:1

 +12       QUIT

PSODISP2.m