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

PSORLST.m

Go to the documentation of this file. 
  1. PSORLST ;BIRM/MFR - List of Patients/Prescriptions for Recall Notice ;12/30/09
  1.  ;;7.0;OUTPATIENT PHARMACY;**348,371**;DEC 1997;Build 12
  1.  ;
  1.  ; External reference to ^PSS50 supported by DBIA 4533
  1.  ; External reference to ^PSS50P7 supported by DBIA 4662
  1.  ; External reference to ^DPT supported by DBIA 10035
  1.  ; External reference to ^PSNDF(50.6 supported by DBIA 2079
  1.  ;
  1. START ; Prompt user for search/selection criteria.
  1.  N PSODTRNG,PSONDC,PSOMED,PSOXDED,PSODDRG,PSOOI,PSOGEN,DDRG,EXIT,PSODIV,PSORXDIV,PSODJ
  1.  N DIC,PSODEAD,OUTPUT,PSOSDIV,PSOTYPE
  1.  ;
  1.  ; - Division/Site selection
  1.  D DIVSEL(.PSOSDIV) I $G(PSOSDIV)="^" G EXIT
  1.  I $G(PSOSDIV)="ALL" S PSODIV=0 F  S PSODIV=$O(^PS(59,PSODIV)) Q:'PSODIV  S PSOSDIV(PSODIV)=""
  1.  ;
  1.  ; Date range selection
  1.  W ! S PSODTRNG=$$DTRNG("T-90","T") I PSODTRNG="^" G START
  1. LKTP ; Type of Drug Lookup
  1.  S PSOMED=$$MED() W ! I PSOMED<1 D EXIT W !! G START
  1.  I PSOMED=1 D NDC(.PSONDC) I $D(PSONDC)<10 D EXIT G LKTP
  1.  I PSOMED=2!(PSOMED=3) D DDRG(.PSODDRG,PSOMED) I ($D(PSODDRG)<10) D EXIT G LKTP
  1.  I PSOMED=4 D GENERIC(.PSODDRG) I $D(PSODDRG)<10 D EXIT G LKTP
  1.  I PSOMED=5 D ORDITEM(.PSODDRG) I $D(PSODDRG)<10 D EXIT G LKTP
  1.  ; Exclude Deceased Patients?
  1.  W ! S PSOXDED=$$EXCL() I PSOXDED="^" G START
  1.  ;
  1.  D MARGIN
  1.  W ! D DEV I $G(EXIT) D EXIT G START
  1.  D EXCMSG I $G(DUOUT) D EXIT G START
  1.  ;
  1. QUE ; Entry point for queued report. Begin processing based on user's selection criteria.
  1.  U IO
  1.  D PROCESS^PSORLST2
  1.  G START
  1.  ;
  1. EXIT ; Quit.
  1.  Q
  1.  ;
  1. DTRNG(BGN,END) ; Date Range Selection
  1.  ;Input: (o) BGN - Default Begin Date 
  1.  ;       (o) END - Default End Date 
  1.  N %DT,DTOUT,DUOUT,DTRNG,X,Y
  1.  S DTRNG=""
  1.  S %DT="AEST",%DT("A")="From Release Date: ",%DT("B")=$G(BGN) K:$G(BGN)="" %DT("B") D ^%DT
  1.  I $G(DUOUT)!$G(DTOUT)!($G(Y)=-1) Q "^"
  1.  S $P(DTRNG,U)=Y
  1.  W ! K %DT
  1.  S %DT="AEST",%DT("A")="To Release Date: ",%DT("B")=$G(END),%DT(0)=Y K:$G(END)="" %DT("B") D ^%DT
  1.  I $G(DUOUT)!$G(DTOUT)!($G(Y)=-1) Q "^"
  1.  S $P(DTRNG,U,2)=Y
  1.  Q DTRNG
  1.  ;
  1. EXCL() ; Exclude Deceased Patients
  1.  ; Input: (o) EXCLUDE - "Y"es or "N"o
  1.  K DIR,X,Y S DIR("A")="Exclude Deceased Patients"
  1.  S DIR(0)="Y",DIR("B")="YES" D ^DIR K DIR
  1.  Q Y
  1.  ;
  1. MED() ; Select Medication(s)
  1.  ; Medication Selection (NDC/Dispense Drug/Generic Drug)
  1.  K DIR,Y,X
  1.  S DIR(0)="S^1:NDC;2:DISPENSE DRUG AND LOT NUMBER;3:DISPENSE DRUG;4:VA GENERIC NAME;5:ORDERABLE ITEM"
  1.  S DIR("A")="Select 1-5 ",DIR("?")="Choose a drug selection method."
  1.  D ^DIR
  1.  Q Y
  1.  ;
  1. NDC(NDC) ; Select NDC
  1.  K NDC
  1.  F  Q:Y<1  D
  1.  .K DIR,X,Y
  1.  .S DIR("A")="NDC"
  1.  .S DIR(0)="FO^5:13"
  1.  .S DIR("?")="Answer must be from 5 to 20 characters, in correct NDC format ( e.g., 4-4-2, 5-3-2, 5-4-1, 5-4-2, or 6-4-2)"
  1.  .D ^DIR
  1.  .I Y'="",$TR($TR(Y,"-","")," ","")="" W !,DIR("?") S Y=1 Q
  1.  .I Y>0 S NDC($TR($TR(Y,"-","")," ",""))=1
  1.  I '$D(NDC) W !!," *** NO NDC SELECTED ***"
  1.  Q
  1.  ;
  1. DDRG(PSODDRG,LOTSEL) ; Select Dispense Drug
  1.  K DIC
  1.  S DIC=50,DIC(0)="QVAEZ",DIC("A")="Dispense Drug: "
  1.  S DIC("S")="I $S($G(^(""I"")):0,1:1)"
  1.  F  Q:(Y<1)!$G(EXIT)  K X,Y D ^DIC I Y>0 S PSODDRG(+Y)=$P(Y,"^",2) I LOTSEL=2 D LOT(+Y,.PSODDRG,Y(0,0))
  1.  I '$D(PSODDRG) W !!," *** NO MEDICATION SELECTED ***"
  1.  Q
  1.  ;
  1. LOT(DRGNO,DRGARR,DRGNAM) ; Enter Lot Number(s)
  1.  N X,Y,LOT,EXIT,PSOLOTAR
  1.  F  Q:$G(EXIT)  D
  1.  .K DIR,Y,X
  1.  .S DIR("A")="Lot # ",DIR(0)="FO^2:20"
  1.  .D ^DIR S:$G(DUOUT) EXIT=1 W !
  1.  .I $L(Y)>1 S PSOLOTAR(Y)="",DRGARR(DRGNO,Y)="" Q
  1.  .I Y="",$D(PSOLOTAR)>1 S EXIT=1
  1.  .Q:$D(PSOLOTAR)>1
  1.  .I '$G(EXIT),Y="" W !?5,"At least one Lot # must be entered" Q
  1.  I $G(EXIT),'$D(PSOLOTAR) K DRGARR(DRGNO),PSOLOTAR W !?27,"* No LOT # was entered *" D
  1.  .W !?((80-$L(DRGNAM))/2),DRGNAM,!?22,"will not be included on the report",!!
  1.  Q
  1.  ;
  1. GENERIC(PSODDRG) ; Select drug by VA GENERIC (file 50.6)
  1.  N GENUM,GENAM,DDRGLI,INACTDT,DDRGLIA
  1.  S INACTDT=$$FMADD^XLFDT(DT,-1)
  1. GLOOP ; Prompt loop
  1.  S DIC="^PSNDF(50.6,",DIC(0)="QMEAZ",DIC("A")="VA Generic Name: "
  1.  F  Q:($G(GENUM)<0)  K X,Y D ^DIC S GENUM=+Y I GENUM>0 S GENUM=+Y,GENAM=$P(Y,"^",2) D
  1.  .K ^TMP($J,"PSORLDN"),^TMP($J,"PSORLGN")
  1.  .D AND^PSS50(GENUM,INACTDT,,"PSORLGN")
  1.  .S DDRGLI=0 F  S DDRGLI=$O(^TMP($J,"PSORLGN",DDRGLI)) Q:'DDRGLI  D
  1.  ..D DATA^PSS50(DDRGLI,,INACTDT,,,"PSORLDN")
  1.  ..S DDRGLIA(DDRGLI)=$G(^TMP($J,"PSORLDN",DDRGLI,.01)) K ^TMP($J,"PSORLDN",DDRGLI)
  1.  .I $D(DDRGLIA)>1 D DDSEL(.DDRGLIA,.PSODDRG)
  1.  I '$D(PSODDRG) W !!," *** NO MEDICATION SELECTED ***"
  1.  Q
  1.  ;
  1. ORDITEM(PSODDRG) ; Select drug by ORDERABLE ITEM (file 50.7)
  1.  N OINUM,OINAM,OIDRGLI,INACTDT,OINUM,OIDRGLIA
  1.  S INACTDT=$$FMADD^XLFDT(DT,-1)
  1. OLOOP ; Prompt loop 
  1.  S DIC="50.7",DIC(0)="QMEAZ",DIC("A")="Orderable Item: ",DIC("S")="I $S($P($G(^(0)),""^"",4):0,1:1)"
  1.  F  Q:($G(OINUM)<0)  K X,Y D ^DIC S OINUM=+Y I OINUM>0 S OINAM=$P(Y,"^",2) D
  1.  .K ^TMP($J,"PSORLDN"),^TMP($J,"PSORLDOI")
  1.  .D DRGIEN^PSS50P7(OINUM,INACTDT,"PSORLOI")
  1.  .S OIDRGLI=0 F  S OIDRGLI=$O(^TMP($J,"PSORLOI",OIDRGLI)) Q:'OIDRGLI  D
  1.  ..D DATA^PSS50(OIDRGLI,,INACTDT,,,"PSORLDN")
  1.  ..S DDRGLIA(OIDRGLI)=$G(^TMP($J,"PSORLDN",OIDRGLI,.01)) K ^TMP($J,"PSORLDN",OIDRGLI)
  1.  .I $D(DDRGLIA)>1 D DDSEL(.DDRGLIA,.PSODDRG)
  1.  I '$D(PSODDRG) W !!," *** NO MEDICATION SELECTED ***"
  1.  Q
  1.  ;
  1. DDSEL(DDIN,DDOUT) ; Display selectable dispense drugs (DDIN), prompt for selection, save selected dispense drugs in DDOUT
  1.  K DIR
  1.  I $D(DDIN)<10 K DDIN Q
  1.  W !!?2,"Dispense Drugs"
  1.  W !?2,"---------------"
  1.  S (II,DD)=0 F II=1:1 S DD=$O(DDIN(DD)) Q:'DD  W !?3,II," - ",DDIN(DD)
  1.  W ! S II=II-1 S DIR(0)="L^1:"_II D ^DIR W !
  1.  S (II,DD)=0 F II=1:1 S DD=$O(DDIN(DD)) Q:'DD  I (","_Y_",")[(","_II_",") S DDOUT(DD)=DDIN(DD)
  1.  K DDIN
  1.  Q
  1.  ;
  1. DEV ; Prompt user for output device
  1.  K %ZIS,IOP,POP,ZTSK,EXIT S PSOION=$I,%ZIS="QM"
  1.  D ^%ZIS K %ZIS
  1.  I POP S IOP=PSOION D ^%ZIS K IOP,PSOION W !,"Please try later!" S EXIT=1
  1.  S X=0 X ^%ZOSF("RM")
  1.  K PSOION I $D(IO("Q")) D  S EXIT=1 Q
  1.  .S ZTDESC="List of Patient for Recall Notice",ZTRTN="QUE^PSORLST"
  1.  .F G="PSODTRNG","PSOXDED","PSOMED","PSODIV","PSODJ","PSONDC(","PSODDRG(","PSOSDIV(" S ZTSAVE(G)=""
  1.  .K IO("Q") D ^%ZTLOAD W:$D(ZTSK) !,"Report is Queued to print!" K ZTSK
  1.  Q
  1.  ;
  1. DIVSEL(ARRAY) ; - Division selection (one, multiple or ALL)
  1.  N DIC,DTOUT,DUOUT,QT,Y,X
  1.  W !!,"You may select a single or multiple Divisions,"
  1.  W !,"or enter ^ALL to select all Divisions.",!
  1.  I '$G(DT) N DT S DT=$$NOW^XLFDT()
  1.  S DIC("S")="I $S('$D(^PS(59,+Y,""I"")):1,'^(""I""):1,DT'>^(""I""):1,1:0)"
  1.  K ARRAY S DIC="^PS(59,",DIC(0)="QEZAM",DIC("A")="Division: "
  1.  F  D ^DIC Q:X=""  D  Q:$G(QT)
  1.  .I $$UP^XLFSTR(X)="^ALL" K ARRAY S ARRAY="ALL",QT=1 Q
  1.  .I $D(DTOUT)!$D(DUOUT) K ARRAY S ARRAY="^",QT=1 Q
  1.  .W "   ",$P(Y,"^",2),$S($D(ARRAY(+Y)):"       (already selected)",1:"")
  1.  .W ! S ARRAY(+Y)="",DIC("A")="ANOTHER ONE: " K DIC("B")
  1.  I '$D(ARRAY) S ARRAY="^"
  1.  Q
  1.  ;
  1. EXCMSG ;Display the message about capturing to an Excel file format
  1.  K DUOUT
  1.  Q:$E($G(IOST))'="C"
  1.  W !!?5,"Before continuing, please set up your terminal to capture the"
  1.  W !?5,"detailed report data. On some terminals, this can be done by"
  1.  W !?5,"clicking on the 'Tools' menu above, then click on 'Capture"
  1.  W !?5,"Incoming Data' to save to Desktop."
  1.  W !
  1.  W !?5,"     *** THIS REPORT MAY TAKE AWHILE TO RUN ***",!!
  1.  N DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR
  1.  W !
  1.  Q
  1.  ;
  1. MARGIN   ; Display message about margin and page length
  1.  I $G(PSODWFL) D
  1.  . W !!!?8,"** Users unfamiliar with sort templates should review **"
  1.  . W !?8,"**   sort template documentation before continuing.   **"
  1.  . K PSODFWL
  1.  W !!
  1.  W !?8,"**  To avoid undesired wrapping of the output data,    **"
  1.  W !?8,"**  please enter '0;512;999' at the 'DEVICE:' prompt.  **" ;371 change from 256 to 512.
  1.  W !?8,"**  You may need to set your Terminal Session Display  **" ;371 Add the next two lines.
  1.  W !?8,"**            Settings to 512 columns.                 **"
  1.  W !
  1.  Q
  1.  ;
  1. PSODED(RXIEN) ;
  1.  N PSODED
  1.  S PSODED=""
  1.  I $G(DFN) S PSODED=$S($G(^DPT(+$P(^PSRX(RXIEN,0),"^",2),.35)):"Y",1:"N")
  1.  Q PSODED