PSOBPSRP ;BHM/LE - Ignored Rejects Report ;03/01/07
;;7.0;OUTPATIENT PHARMACY;**260,345,352**;13 Feb 97;Build 5
;
EN N PSOSD,PSOED,PSOST,PSOSRT,PSOAPT,PSODRUG,PSODIV,PSODRG,PSOST,PSOOC,PSOU,PSOUSER,PSOAPT,PSOIBP,Y
N OK,X,C,%DT,PSOSIT
;
DIV ; - Ask for Division
D SEL^PSOREJU1("DIVISION","^PS(59,",.PSODIV,$$GET1^DIQ(59,+$G(PSOSITE),.01)) Q:$G(PSODIV)="^"
I $G(PSODIV)="ALL" S PSOSIT=1 K PSODIV
;
BEGD ; - Ask for FROM DATE DOCUMENTED
S %DT(0)=-DT,%DT="AEP",%DT("A")="BEGIN REJECT DATE: "
W ! D ^%DT I Y<0!($D(DTOUT)) G END
S PSOSD=Y\1-.00001
;
ENDT ; - Ask for TO DATE DOCUMENTED
S %DT(0)=PSOSD+1\1,%DT("A")="END REJECT DATE: "
W ! D ^%DT I Y<0!($D(DTOUT)) G END
S PSOED=Y\1+.99999
;
SORT ; - Ask for SORT BY
K DIR S DIR("B")="PATIENT" D HL1("A")
SORT1 S PSOSRT="",(PSOAPT)=1,(PSOST,PSOOC)="B"
S DIR("A")="SORT BY",DIR(0)="FO" D HL1("?")
W ! D ^DIR K DIR I $D(DIRUT) G END
;
S OK=1,C=15 W !
F PSOIBP=1:1:$L(Y,",") D ;352 CHANGED ALL VARIABLES OF 'I' TO PSOIBP
. S X=$P(Y,",",PSOIBP) S:X'?.N X=$$TRNS(X) I PSOSRT[X Q
. W !?(C-10),$S(PSOIBP=1:"SORT BY ",1:"THEN BY ") S C=C+5
. I X<1!(X>3) W X,"???",$C(7) S OK=0 Q
. W $P("PATIENT^DRUG^USER","^",X)
. S PSOSRT=PSOSRT_","_X
I 'OK S DIR("B")=Y G SORT1
S $E(PSOSRT)=""
;
S OK=1
F PSOIBP=1:1:$L(PSOSRT,",") D I 'OK Q
. S X=$P(PSOSRT,",",PSOIBP) D @("SRT"_X)
I 'OK S DIR("B")="PATIENT" G SORT1
;
DEV W ! K %ZIS,IOP,POP,ZTSK S %ZIS="QM" D ^%ZIS K %ZIS I POP G END
;If user didn't select a particular sort, assume all values for that sort
S:'$G(PSOAPT)&('$D(PSOPT)) PSOAPT=1
S:'$G(PSODRUG)&('$D(PSODRG)) PSODRUG=1
S:'$G(PSOUSER)&('$D(PSOU)) PSOUSER=1
;
I $D(IO("Q")) D G END
. N G K IO("Q"),ZTIO,ZTSAVE,ZTDTH,ZTSK
. S ZTRTN="EN^PSOBPSR1",ZTDESC="Ignored Rejects Report"
. F G="PSOSD","PSOED","PSOSRT","PSOPT","PSODRG" S:$D(@G) ZTSAVE(G)=""
. F G="PSOST","PSOOC","PSOAPT","PSODRUG","PSOUSER","PSOSIT" S:$D(@G) ZTSAVE(G)=""
. S:$D(PSOPT) ZTSAVE("PSOPT(")="" S:$D(PSODRG) ZTSAVE("PSODRG(")=""
. S:$D(PSOU) ZTSAVE("PSOU(")="" S:$D(PSODIV) ZTSAVE("PSODIV(")=""
. D ^%ZTLOAD W:$D(ZTSK) !,"Report is Queued to print!" K ZTSK
;
G EN^PSOBPSR1
;
END Q
;
HL1(S) ; - Help for the SORT BY prompt
S DIR(S,1)=" Enter the SORT field(s) for this Report:"
S DIR(S,2)=" "
S DIR(S,3)=" 1 - PATIENT"
S DIR(S,4)=" 2 - DRUG"
S DIR(S,5)=" 3 - USER"
S DIR(S,6)=" "
S DIR(S,7)=" Or any combination of the above, separated by comma,"
S DIR(S,8)=" as in these examples:"
S DIR(S,9)=" "
S DIR(S,10)=" 2,1 - BY PATIENT, THEN DRUG"
S DIR(S,11)=" 3,1,2 - BY USER, THEN BY PATIENT, THEN BY DRUG"
S DIR(S,12)=" "
S DIR(S)=" "
Q
;
SRT1 ; - Selection of PATIENTS to print on the Report
N PSOIBP K PSOPT S PSOAPT=0 ;345 ADDED N PSOIBP
D SEL^PSOREJU1("PATIENT","^DPT(",.PSOPT) I $G(PSOPT)="^" S OK=0 Q
I $G(PSOPT)="ALL" S PSOAPT=1 K PSOPT
Q
;
SRT2 ; - Selection of Drugs to print on the Report
N PSOIBP K PSODRG S PSODRUG=0 ;345 ADDED N PSOIBP
D SEL^PSOREJU1("DRUG","^PSDRUG(",.PSODRG) I $G(PSODRG)="^" S OK=0 Q
I $G(PSODRG)="ALL" S PSODRUG=1 K PSODRG
Q
;
SRT3 ; - Selection of Users to print on the Report
N PSOIBP K PSOU S PSOUSER=0 ;345 ADDED N PSOIBP
D SEL^PSOREJU1("USER","^VA(200,",.PSOU) I $G(PSOU)="^" S OK=0 Q
I $G(PSOU)="ALL" S PSOUSER=1 K PSOU
Q
;
TRNS(X) ; - Translates Alpha into the corresponding Sorting Code
N L,UPX S L=$L(X),UPX=$$UP^XLFSTR(X)
I $E("PATIENT",1,L)=UPX Q 1
I $E("DRUG",1,L)=UPX Q 2
I $E("USER",1,L)=UPX Q 3
Q X
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOBPSRP 3583 printed Sep 23, 2025@20:01:14 Page 2
PSOBPSRP ;BHM/LE - Ignored Rejects Report ;03/01/07
+1 ;;7.0;OUTPATIENT PHARMACY;**260,345,352**;13 Feb 97;Build 5
+2 ;
EN NEW PSOSD,PSOED,PSOST,PSOSRT,PSOAPT,PSODRUG,PSODIV,PSODRG,PSOST,PSOOC,PSOU,PSOUSER,PSOAPT,PSOIBP,Y
+1 NEW OK,X,C,%DT,PSOSIT
+2 ;
DIV ; - Ask for Division
+1 DO SEL^PSOREJU1("DIVISION","^PS(59,",.PSODIV,$$GET1^DIQ(59,+$GET(PSOSITE),.01))
if $GET(PSODIV)="^"
QUIT
+2 IF $GET(PSODIV)="ALL"
SET PSOSIT=1
KILL PSODIV
+3 ;
BEGD ; - Ask for FROM DATE DOCUMENTED
+1 SET %DT(0)=-DT
SET %DT="AEP"
SET %DT("A")="BEGIN REJECT DATE: "
+2 WRITE !
DO ^%DT
IF Y<0!($DATA(DTOUT))
GOTO END
+3 SET PSOSD=Y\1-.00001
+4 ;
ENDT ; - Ask for TO DATE DOCUMENTED
+1 SET %DT(0)=PSOSD+1\1
SET %DT("A")="END REJECT DATE: "
+2 WRITE !
DO ^%DT
IF Y<0!($DATA(DTOUT))
GOTO END
+3 SET PSOED=Y\1+.99999
+4 ;
SORT ; - Ask for SORT BY
+1 KILL DIR
SET DIR("B")="PATIENT"
DO HL1("A")
SORT1 SET PSOSRT=""
SET (PSOAPT)=1
SET (PSOST,PSOOC)="B"
+1 SET DIR("A")="SORT BY"
SET DIR(0)="FO"
DO HL1("?")
+2 WRITE !
DO ^DIR
KILL DIR
IF $DATA(DIRUT)
GOTO END
+3 ;
+4 SET OK=1
SET C=15
WRITE !
+5 ;352 CHANGED ALL VARIABLES OF 'I' TO PSOIBP
FOR PSOIBP=1:1:$LENGTH(Y,",")
Begin DoDot:1
+6 SET X=$PIECE(Y,",",PSOIBP)
if X'?.N
SET X=$$TRNS(X)
IF PSOSRT[X
QUIT
+7 WRITE !?(C-10),$SELECT(PSOIBP=1:"SORT BY ",1:"THEN BY ")
SET C=C+5
+8 IF X<1!(X>3)
WRITE X,"???",$CHAR(7)
SET OK=0
QUIT
+9 WRITE $PIECE("PATIENT^DRUG^USER","^",X)
+10 SET PSOSRT=PSOSRT_","_X
End DoDot:1
+11 IF 'OK
SET DIR("B")=Y
GOTO SORT1
+12 SET $EXTRACT(PSOSRT)=""
+13 ;
+14 SET OK=1
+15 FOR PSOIBP=1:1:$LENGTH(PSOSRT,",")
Begin DoDot:1
+16 SET X=$PIECE(PSOSRT,",",PSOIBP)
DO @("SRT"_X)
End DoDot:1
IF 'OK
QUIT
+17 IF 'OK
SET DIR("B")="PATIENT"
GOTO SORT1
+18 ;
DEV WRITE !
KILL %ZIS,IOP,POP,ZTSK
SET %ZIS="QM"
DO ^%ZIS
KILL %ZIS
IF POP
GOTO END
+1 ;If user didn't select a particular sort, assume all values for that sort
+2 if '$GET(PSOAPT)&('$DATA(PSOPT))
SET PSOAPT=1
+3 if '$GET(PSODRUG)&('$DATA(PSODRG))
SET PSODRUG=1
+4 if '$GET(PSOUSER)&('$DATA(PSOU))
SET PSOUSER=1
+5 ;
+6 IF $DATA(IO("Q"))
Begin DoDot:1
+7 NEW G
KILL IO("Q"),ZTIO,ZTSAVE,ZTDTH,ZTSK
+8 SET ZTRTN="EN^PSOBPSR1"
SET ZTDESC="Ignored Rejects Report"
+9 FOR G="PSOSD","PSOED","PSOSRT","PSOPT","PSODRG"
if $DATA(@G)
SET ZTSAVE(G)=""
+10 FOR G="PSOST","PSOOC","PSOAPT","PSODRUG","PSOUSER","PSOSIT"
if $DATA(@G)
SET ZTSAVE(G)=""
+11 if $DATA(PSOPT)
SET ZTSAVE("PSOPT(")=""
if $DATA(PSODRG)
SET ZTSAVE("PSODRG(")=""
+12 if $DATA(PSOU)
SET ZTSAVE("PSOU(")=""
if $DATA(PSODIV)
SET ZTSAVE("PSODIV(")=""
+13 DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE !,"Report is Queued to print!"
KILL ZTSK
End DoDot:1
GOTO END
+14 ;
+15 GOTO EN^PSOBPSR1
+16 ;
END QUIT
+1 ;
HL1(S) ; - Help for the SORT BY prompt
+1 SET DIR(S,1)=" Enter the SORT field(s) for this Report:"
+2 SET DIR(S,2)=" "
+3 SET DIR(S,3)=" 1 - PATIENT"
+4 SET DIR(S,4)=" 2 - DRUG"
+5 SET DIR(S,5)=" 3 - USER"
+6 SET DIR(S,6)=" "
+7 SET DIR(S,7)=" Or any combination of the above, separated by comma,"
+8 SET DIR(S,8)=" as in these examples:"
+9 SET DIR(S,9)=" "
+10 SET DIR(S,10)=" 2,1 - BY PATIENT, THEN DRUG"
+11 SET DIR(S,11)=" 3,1,2 - BY USER, THEN BY PATIENT, THEN BY DRUG"
+12 SET DIR(S,12)=" "
+13 SET DIR(S)=" "
+14 QUIT
+15 ;
SRT1 ; - Selection of PATIENTS to print on the Report
+1 ;345 ADDED N PSOIBP
NEW PSOIBP
KILL PSOPT
SET PSOAPT=0
+2 DO SEL^PSOREJU1("PATIENT","^DPT(",.PSOPT)
IF $GET(PSOPT)="^"
SET OK=0
QUIT
+3 IF $GET(PSOPT)="ALL"
SET PSOAPT=1
KILL PSOPT
+4 QUIT
+5 ;
SRT2 ; - Selection of Drugs to print on the Report
+1 ;345 ADDED N PSOIBP
NEW PSOIBP
KILL PSODRG
SET PSODRUG=0
+2 DO SEL^PSOREJU1("DRUG","^PSDRUG(",.PSODRG)
IF $GET(PSODRG)="^"
SET OK=0
QUIT
+3 IF $GET(PSODRG)="ALL"
SET PSODRUG=1
KILL PSODRG
+4 QUIT
+5 ;
SRT3 ; - Selection of Users to print on the Report
+1 ;345 ADDED N PSOIBP
NEW PSOIBP
KILL PSOU
SET PSOUSER=0
+2 DO SEL^PSOREJU1("USER","^VA(200,",.PSOU)
IF $GET(PSOU)="^"
SET OK=0
QUIT
+3 IF $GET(PSOU)="ALL"
SET PSOUSER=1
KILL PSOU
+4 QUIT
+5 ;
TRNS(X) ; - Translates Alpha into the corresponding Sorting Code
+1 NEW L,UPX
SET L=$LENGTH(X)
SET UPX=$$UP^XLFSTR(X)
+2 IF $EXTRACT("PATIENT",1,L)=UPX
QUIT 1
+3 IF $EXTRACT("DRUG",1,L)=UPX
QUIT 2
+4 IF $EXTRACT("USER",1,L)=UPX
QUIT 3
+5 QUIT X
+6 ;
