- 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 Feb 18, 2025@23:51:25 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 ;