Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOBPSRP

PSOBPSRP.m

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