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

PSOSPML7.m

Go to the documentation of this file.
  1. PSOSPML7 ;BIRM/MFR - Resend a Group of Selected Prescriptions ;10/10/12
  1. ;;7.0;OUTPATIENT PHARMACY;**625,630**;DEC 1997;Build 26
  1. ;
  1. ;
  1. ASK ; MANUAL BATCH EXPORT
  1. ;RETRIEVE FILTERS FROM USER
  1. D FULL^VALM1 S VALMBCK="R"
  1. N %DT,DIR,DIRUT,X,DIC,DTOUT,DUOUT,BEGINDT,ENDDT,PSOERROR
  1. N RECTYPE,STATE,QUIT,ARRAY,TAG,FILTER
  1. ;
  1. ; - Selection of STATE
  1. W ! S DIC("A")="STATE: ",DIC("S")="I $D(^PS(58.41,+Y,0))",DIC="^DIC(5,"
  1. S DIC("B")=$$GET1^DIQ(5,+$O(^PS(58.41,0)),.01)
  1. S DIC(0)="AEQMZ" D ^DIC I X="^"!(Y<0) Q
  1. S STATE=+Y
  1. BEGDT ;
  1. ; - Ask for Start DATE
  1. ; Note: The legislation allowing VA to report was published on 02/11/2013
  1. N XDT S XDT=$$FMADD^XLFDT(DT,-1)
  1. S %DT(0)=3130211,%DT="AEP",%DT("A")="Export Rx's Starting with RELEASE DATE (2/11/13 to "_$$FMTE^XLFDT(XDT,2)_"): "
  1. W ! D ^%DT
  1. I X="" W !!?5,"Starting RELEASE DATE is required or enter '^' to exit.",! G BEGDT
  1. I Y<0!($D(DTOUT)) Q
  1. I (Y=DT)!(Y>DT) W !!?5,"Only past dates are allowed." D PAUSE^PSOSPMU1 G BEGDT
  1. S BEGINDT=Y
  1. ;
  1. W !!?5,"Prescriptions released today will be included in the next scheduled batch."
  1. ;
  1. ENDDT ;
  1. ; - Ask for End DATE
  1. K %DT S %DT(0)=BEGINDT\1,%DT="AEP",%DT("B")="TODAY-1",%DT("A")="Export Rx's Ending with RELEASE DATE ("_$$FMTE^XLFDT(BEGINDT,2)_" to "_$$FMTE^XLFDT(XDT,2)_"): "
  1. W ! D ^%DT I Y<0!($D(DTOUT)) Q
  1. I (Y=DT)!(Y>DT) W !!?5,"The latest end date permitted is TODAY-1 (yesterday)." D PAUSE^PSOSPMU1 G ENDDT
  1. S ENDDT=Y
  1. ;
  1. S QUIT=0,FILTER="NC"
  1. D Q:QUIT
  1. . K DIR S DIR("A")="Filter Selection"
  1. . S DIR(0)="S^PA:Patient;PR:Prescriber;DR:Drug;DV:Division;RX:Prescription;NC:No Criteria"
  1. . S DIR("L",1)="Select prescriptions by one of the following criteria:"
  1. . S DIR("L",2)=" "
  1. . S DIR("L",3)=" PA Patient"
  1. . S DIR("L",4)=" PR Prescriber"
  1. . S DIR("L",5)=" DR Drug"
  1. . S DIR("L",6)=" DV Division"
  1. . S DIR("L",7)=" RX Prescription"
  1. . S DIR("L")=" NC No criteria (unfiltered). All Rx's within the date range selected."
  1. . D ^DIR I $D(DUOUT)!($D(DIRUT)) K DIRUT,DUOUT,DIR S QUIT=1 Q
  1. . S FILTER=Y
  1. ;
  1. K ARRAY
  1. S TAG=$S(FILTER="PA":"PATSEL",FILTER="PR":"PRESCSEL",FILTER="DR":"DRGSEL",FILTER="DV":"DIVSEL",FILTER="RX":"RXSEL",1:"NOCRITERIA")
  1. D @TAG
  1. I TAG'="NOCRITERIA",'$O(ARRAY(0)) Q
  1. D RTSEL
  1. Q:QUIT
  1. ; create and export the batch passing ARRAY which will be the iens of patients, prescribers, drugs, divisions, or prescriptions.
  1. ; If no filter criteria was selected then the ARRAY variable would equal "NC"
  1. D EXPORT^PSOSPML1(STATE,BEGINDT,ENDDT,"RL",RECTYPE,.ARRAY)
  1. Q
  1. ;
  1. NOCRITERIA ;
  1. ; No criteria was selected. All RXs will be sent within the given date range.
  1. S ARRAY="NC"
  1. Q
  1. ;
  1. PATSEL ;
  1. ; - Selection of PATIENTS
  1. N DIC,X,I,Y
  1. N DIR,DTOUT,DUOUT,DIROUT
  1. S DIC(0)="QEAM",DIC("A")="Select PATIENT: "
  1. W !!,"You may enter one or more PATIENTS in succession.",!
  1. F D PATLK S Y=PSOPTLK Q:+Y<1 S ARRAY(+Y)="" K PSOPTLK S DIC("A")="Another PATIENT: "
  1. I $G(PSOPTLK)="^" S QUIT=1 K ARRAY
  1. I $O(ARRAY(0)) S ARRAY="PA"
  1. Q
  1. ;
  1. PRESCSEL ;
  1. ; - Selection of PRESCRIBERS
  1. N DIC,X,I,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1. S DIC="^VA(200,",DIC(0)="QEAM"
  1. S DIC("W")="W "" "",$P(^(""PS""),""^"",9)"
  1. S DIC("A")="Select PRESCRIBER: "
  1. S DIC("S")="I $D(^(""PS"")),$P(^(""PS""),""^""),$S('$P(^(""PS""),""^"",4):1,1:$P(^(""PS""),""^"",4)'<DT)"
  1. W !!,"You may enter one or more PRESCRIBERS in succession.",!
  1. F D ^DIC D Q:QUIT
  1. . I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) K ARRAY S QUIT=1 Q
  1. . I +Y<1&'$O(ARRAY(0)) W !!,"Please enter at least one PRESCRIBER or '^' to exit.",! Q
  1. . I +Y<1 S QUIT=1 Q
  1. . S ARRAY(+Y)=""
  1. . S DIC("A")="Another PRESCRIBER: "
  1. I $O(ARRAY(0)) S ARRAY="PR"
  1. Q
  1. ;
  1. DIVSEL ; - Division selection (one, multiple or ALL)
  1. N DIC,DTOUT,DUOUT,DIROUT,Y,X,XX
  1. W !!,"You may enter one or more DIVISIONS in succession.",!
  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. S DIC="^PS(59,",DIC(0)="QEZAM",DIC("A")="Select DIVISION: "
  1. F D ^DIC D Q:QUIT
  1. . I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) K ARRAY S QUIT=1 Q
  1. . I +Y<1&'$O(ARRAY(0)) W !!,"Please enter at least one DIVISION or '^' to exit.",! Q
  1. . I +Y<1 S QUIT=1 Q
  1. . S ARRAY(+Y)=""
  1. . S DIC("A")="Another DIVISION: "
  1. I $O(ARRAY(0)) S ARRAY="DV"
  1. Q
  1. ;
  1. DRGSEL ;
  1. ; Prompt for drug
  1. N DIC,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1. S DIC(0)="AEMQ",DIC=50
  1. S DIC("S")="I $$CSDRUG^PSOSPML7(Y)"
  1. S DIC("A")="Select DRUG GENERIC NAME: "
  1. W !!,"You may enter one or more DRUGS in succession.",!
  1. F D ^DIC D Q:QUIT
  1. . I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) K ARRAY S QUIT=1 Q
  1. . I +Y<1&'$O(ARRAY(0)) W !!,"Please enter at least one DRUG or '^' to exit.",! Q
  1. . I +Y<1 S QUIT=1 Q
  1. . S ARRAY(+Y)=""
  1. . S DIC("A")="Another DRUG: "
  1. I $O(ARRAY(0)) S ARRAY="DR"
  1. Q
  1. ;
  1. RXSEL ;
  1. ; - Selection of prescriptions - Prescription prompt
  1. N DIR,X,Y,FILLNUM,SCREEN,DTOUT,DUOUT,DIROUT
  1. W !!,"You may enter one or more PRESCRIPTIONS in succession.",!
  1. F D RXSEL1 Q:QUIT
  1. I $O(ARRAY(0)) S ARRAY="RX"
  1. Q
  1. RXSEL1 ;
  1. s DIR("A")=$S('$O(ARRAY(0)):"Select PRESCRIPTION: ",1:"Another PRESCRIPTION: ")
  1. S DIR(0)="FAO^1:30",(DIR("?"),DIR("??"))="^D HLP^PSOSPML7"
  1. D ^DIR
  1. I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) K ARRAY S QUIT=1 Q
  1. I X=""&'$O(ARRAY(0)) W !!,"Please enter at least one PRESCRIPTION or '^' to exit.",! Q
  1. I X="" S QUIT=1 Q
  1. S X=$$UP^XLFSTR(X),QUIT=0
  1. I $E(X,1,2)'="E." S RXIEN=+$$RXLKP(X) I RXIEN<0 Q
  1. I $E(X,1,2)="E." D I QUIT S QUIT=0 Q
  1. . I $L(X)'=9 W !?5,"The ECME# must be 7 digits long!",$C(7) S QUIT=1 Q
  1. . S RXIEN=+$$RXNUM^PSOBPSU2($E(X,3,9)) I RXIEN<0 W " ??" S QUIT=1
  1. S FILLNUM=$$RXFILL^PSOSPMU2(RXIEN) I FILLNUM="^" S QUIT=1 Q
  1. S SCREEN=$$SCREEN^PSOSPMUT(RXIEN,FILLNUM)
  1. I +SCREEN D Q:$P(SCREEN,"^",3)="E"
  1. . W !!?1,$S($P(SCREEN,"^",3)="E":"ERROR",1:"WARNING"),": ",$P(SCREEN,"^",2),$C(7) D PAUSE^PSOSPMU1
  1. I '$$RXRLDT^PSOBPSUT(RXIEN,FILLNUM) D Q
  1. . W !!?1,"Cannot select. Prescription not RELEASED. " D PAUSE^PSOSPMU1
  1. I '$D(^PS(58.42,"ARX",RXIEN,FILLNUM)) D Q
  1. . W !!?1,"Cannot select. Prescription not previously in a transmission batch. " D PAUSE^PSOSPMU1
  1. S ARRAY(RXIEN,FILLNUM)=""
  1. ;
  1. Q
  1. ;
  1. FILTER(LIST,RXIEN,FILL) ; Filter Rx Fills based on User Entered Filter Criteria
  1. ; Input: FILTER - List of Filter(s) to be screened
  1. ;(LIST="PR" or "DR" or "PA" or "NC" or "RX", LIST(PROV IEN) or (LIST(PAT IEN) or LIST(RXIEN,FILL)
  1. ; (r) RX - Rx IEN (#52)
  1. ; (r) RFL - Refill #
  1. ;
  1. ; Output: 1 - Filter (Skip) | 0 - Don't Filter (Include)
  1. N RXRES
  1. S RXRES=0
  1. I LIST="NC" Q RXRES
  1. I LIST="RX",'$D(LIST(RXIEN,FILL)) S RXRES=1 Q RXRES
  1. I LIST="PR" D Q RXRES ;provider/prescriber filter
  1. . I '$D(LIST($$RXPRV(RXIEN,FILL))) S RXRES=1 Q
  1. . I '$D(^PS(58.42,"ARX",RXIEN,FILL)) S RXRES=1 Q ; fill not in a previously transmitted batch
  1. I LIST="DR" D Q RXRES
  1. . I '$D(LIST($$GET1^DIQ(52,RXIEN,6,"I"))) S RXRES=1 Q
  1. . I '$D(^PS(58.42,"ARX",RXIEN,FILL)) S RXRES=1 Q ; fill not in a previously transmitted batch
  1. I LIST="PA" D Q RXRES
  1. . I '$D(LIST($$GET1^DIQ(52,RXIEN,2,"I"))) S RXRES=1 Q
  1. . I '$D(^PS(58.42,"ARX",RXIEN,FILL)) S RXRES=1 Q ; fill not in a previously transmitted batch
  1. I LIST="DV" D Q RXRES
  1. . I '$D(LIST($$RXSITE^PSOBPSUT(RXIEN,FILL))) S RXRES=1 Q
  1. . I '$D(^PS(58.42,"ARX",RXIEN,FILL)) S RXRES=1 Q ; fill not in a previously transmitted batch
  1. I LIST="ARX",$D(^PS(58.42,"ARX",RXIEN,FILL)),$$CHKST^PSOSPML8(RXIEN,FILL,$G(LIST("STATE"))) Q 1
  1. Q RXRES
  1. ;
  1. RXPRV(RXIEN,FILL) ; Returns the Rx Fill Provider IEN
  1. ; Input: (r) RXIEN - Rx IEN (#52)
  1. ; (o) FILL - Refill # (Default: most recent - except Partial)
  1. ; Note: "P1", "P2"... represent partial fills
  1. ; Output: RXPRV - Rx Fill Provider IEN
  1. N RXPRV
  1. I '$G(RXIEN) Q ""
  1. I '$D(FILL) S FILL=$$LSTRFL(RXIEN)
  1. I FILL S RXPRV=$$GET1^DIQ(52.1,FILL_","_RXIEN,15,"I")
  1. I FILL["P" S RXPRV=$$GET1^DIQ(52.2,+$E(FILL,2,9)_","_RXIEN,6,"I")
  1. I '$G(RXPRV) S RXPRV=$$GET1^DIQ(52,RXIEN,4,"I")
  1. Q RXPRV
  1. ;
  1. LSTRFL(RX) ; - Returns the latest fill for the Rx
  1. ; Input: (r) RX - Rx IEN (#52)
  1. ;Output: LSTRFL - Most recent refill #
  1. N I,LSTRFL
  1. S (I,LSTRFL)=0 F S I=$O(^PSRX(RX,1,I)) Q:'I S LSTRFL=I
  1. Q LSTRFL
  1. ;
  1. ;
  1. HLP ; Help Text for the VIEW PRESCRIPTION prompt
  1. W !," A prescription number or ECME number may be entered. To look-up a"
  1. W !," prescription by the ECME number, please enter ""E."" followed by the ECME"
  1. W !," number with or without any leading zeros."
  1. D LKP("?")
  1. Q
  1. ;
  1. LKP(INPUT) ; - Performs Lookup on the PRESCRIPTION file
  1. N DIC,X,Y
  1. S DIC="^PSRX(",DIC(0)="QE",D="B",X=INPUT
  1. S DIC("S")="I $$CSRX^PSOSPML7(Y)"
  1. D IX^DIC
  1. Q Y
  1. ;
  1. RXLKP(RXNUM) ; - Peforms Lookup on the PRESCRIPTION file
  1. N DIC,X,Y,D
  1. S DIC="^PSRX(",DIC(0)="QE",D="B",X=RXNUM
  1. D IX^DIC
  1. Q Y
  1. ;
  1. CSRX(RXIEN) ; Controlled Substance Rx?
  1. ; Input: RXIEN - PRESCRIPTION file (#52) pointer
  1. ;Output: $$CS - 1:YES / 0:NO
  1. N DRGIEN,DEA
  1. S DRGIEN=$P($G(^PSRX(RXIEN,0)),U,6) I 'DRGIEN Q 0
  1. S DEA=$P($G(^PSDRUG(DRGIEN,0)),U,3) ; retrieve DEA special handling code(s)
  1. I (DEA'["0"),(DEA'["M"),(DEA["2")!(DEA["3")!(DEA["4")!(DEA["5") Q 1
  1. Q 0
  1. ;
  1. RTSEL ;
  1. ; - Selection of record type
  1. S RECTYPE="N",QUIT=0
  1. D Q:QUIT
  1. . K DIR S DIR("A")="Record Type"
  1. . S DIR("L",1)="Enter the type of record to be sent for released prescription fills:"
  1. . S DIR("L",2)=" "
  1. . S DIR(0)="S^N:NEW;R:REVISE"
  1. . S DIR("L",3)=" N NEW"
  1. . S DIR("L")=" R REVISE"
  1. . S DIR("?",1)="NEW is used for records that were rejected and NOT sent to the State database."
  1. . S DIR("?")="REVISE is used only for records that were rejected but were still sent to the State database."
  1. . S DIR("B")="NEW" D ^DIR I $D(DUOUT)!($D(DIRUT)) K DIRUT,DUOUT,DIR S QUIT=1 Q
  1. . S RECTYPE=Y
  1. Q
  1. CSDRUG(IEN) ;Controlled Substance drug?
  1. ; Input: DRGIEN - DRUG file (#50) pointer
  1. ;Output: $$CS - 1:YES / 0:NO
  1. N DEA
  1. Q:'IEN 0
  1. S DEA=$P($G(^PSDRUG(IEN,0)),U,3)
  1. I (DEA'["0"),(DEA'["M"),(DEA["2")!(DEA["3")!(DEA["4")!(DEA["5") Q 1
  1. Q 0
  1. ;
  1. PATLK ;Entry point - Prompts for Patient, Prescription Number or Barcode
  1. ;
  1. ; Input - DIC(0) & DIC("A") [Optional]
  1. ; Used by DIR if defined by the calling routine.
  1. ;
  1. ; Output - PSOPTLK [Processed user response]
  1. ;
  1. K PSOPTLK,PAGE
  1. S DIR(0)="FOU"_$S($D(DIC("A")):"A",1:"")_"^^K:$$PATVAL^PSOPATLK() X"
  1. S DIR("A")=$S($D(DIC("A")):DIC("A"),1:"Select PATIENT NAME")
  1. S (DIR("?"),DIR("??"))="^D PATHLP^PSOPATLK"
  1. D ^DIR
  1. I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S Y="^"
  1. I Y=""&'$O(ARRAY(0)) W !!,"Please enter at least one PATIENT or '^' to exit.",! G PATLK
  1. M PSOPTLK=Y
  1. Q