DEVICE: HOME// 0;80;999  SSH VIRTUAL TERMINAL

MailMan message for FISHER,BRADLEY  DEVELOPER
Printed at FORUM.VA.GOV  10/16/17@13:20
Subj: PSO*7*497 TEST v1  [#86147425] 10/09/17@12:44  2355 lines
From: NPM   [#86147425]  In 'IN' basket.   Page 1
-------------------------------------------------------------------------------
$TXT Created by FISHER,BRADLEY at DNS    (KIDS) on Monday, 10/09/
17 at 11:30
=============================================================================
Run Date: OCT 09, 2017                     Designation: PSO*7*497
Package : PSO - OUTPATIENT PHARMACY           Priority: Mandatory
Version : 7                                     Status: Under Development
=============================================================================

Associated patches: (v)PSO*7*454   <<= must be installed BEFORE `PSO*7*497'
                    (v)PSO*7*475   <<= must be installed BEFORE `PSO*7*497'
                    (v)PSO*7*479   <<= must be installed BEFORE `PSO*7*497'
                    (v)PSO*7*488   <<= must be installed BEFORE `PSO*7*497'

Subject: ONEVA PHARMACY CRITICAL DEFECTS

Category: 
  - Routine
  - Data Dictionary

Description:
============

 The PSO*7.0*497 patch addresses the MPDU OneVA Pharmacy critical defects. 
 This patch resolves critical defects for the following items:
 1.) Auto-suspend
 2.) Blocking prescriptions that contain a trade name
 3.) Blocking refills for titration prescriptions
 4.) Access controls - check to ensure the user has the PSORPH key in 
     order to remotely refill or partial fill prescription.
 5.) Movement of the OneVA pharmacy flag from file 59 (Outpatient 
     site) to file 59.7 (Pharmacy Site). This includes updates to the logic
     that checks the status of the flag for remote prescription processing.
  
 Patch Components:
 -----------------
  
 Files & Fields Associated:
  
 File Name (Number)         Field Name (Number)     New/Modified/Deleted
 ------------------         -------------------     --------------------
 PHARMACY SYSTEM (#59.7)    ONEVA PHARMACY FLAG             New
                            (#101)
  
 Forms Associated:
 -----------------
 N/A
  
 List Templates Associated:
 --------------------------
 N/A
  
  
 Mail Groups Associated:
 -----------------------
 N/A
  
  
 Options Associated:
 -------------------
 N/A
  
  
 Protocols Associated:
  
 Protocol Name               New/Modified/Deleted
 -------------               -------------------- 
 PSO LM REFILL REMOTE ORDER      Modified
 PSO LM REMOTE ORDER MENU        Modified
 PSO LM REMOTE PARTIAL           Modified
  
 Remote Procedure Calls:
 -----------------------
 N/A
  
 Security Keys Associated:
 -------------------------
 N/A
  
 Templates Associated:
 ---------------------
 N/A
  
 Additional Information:
 -----------------------
 N/A
  
 New Service Requests (NSRs):
 ----------------------------  
 N/A
  
 Patient Safety Issues (PSIs):
 -----------------------------
 N/A
  
 Remedy Ticket(s) & Overview:
 ----------------------------
  
 1. I12092772FY17 - ONEVA PHARMACY FILL -- INITIATED BY USER WITHOUT PSORPH
  
 Problem: 
 --------
 The system allowed a pharmacy student (w/o PSORPH) to fill a OneVa refill 
 from another site. The system is allowing a non-pharmacist to make a
 determination about what drug from the local drug file will be dispensed
 to satisfy the remote rx (i.e a clinical decision). Also, we are concerned
 that all resulting displays (and the fileman field labels in the
 underlying data) list this user as "the pharmacist" who completed the
 activity.
  
 Resolution: 
 -----------
 The action protocols for refilling and partially filling remote 
 prescriptions has been modified to include screening logic that checks
 will inactivate the action if the user does not posess the PSORPH key. Add
 screening logic to the associated menu protocol so the action protocols
 will activate.
     
 Technical Resolution: 
 ---------------------
 Screening logic added to PSO LM REFILL REMOTE ORDER and PSO LM REMOTE 
 PARTIAL:
  
 I $$PSORPH^PSORRX2(DUZ)
  
 Screening logic added to PSO LM REMOTE ORDER MENU to activate screening 
 logic on action protocols:
  
 I 1 X:$D(^ORD(101,+$P(^ORD(101,DA(1),10,DA,0),"""^""",1),24)) ^(24)
  
  
 2. I12204814FY17 - OneVA Prescription - Blank Activity, Suspended Refill 
                    Request
   
 Problem: 
 --------
 Finding blank activity and a suspense action on a refill requested from
 another site via OneVA software. Please refer to associated tickets 
 R12129538FY17, I12150112FY17 , and I12125069FY17.
  
 Scenario:
 1.) A prescription is originally filled at a 'host' site.
 2.) Some gap in time that exceeds the days supply.
 3.) The prescription is refilled again at the 'host' site.
 4.) A subsequent 'remote' refill is attempted by a dispensing site other
     than the 'host' site.
 5.) This causes the prescription at the 'host' site to be placed in
     suspense due to the current algorithm not stopping the prescription
     from being filled.
  
 It has been identified that logic associated with the correct check for a
 'fill too soon' scenario (i.e auto-suspend) was writing results to the
 screen in a background processing scenario. Instead, the logic should
 have built a return message and quit processing. This message should
 have then been sent back to the remote site trying to refill the host
 site prescription.
  
  
 Resolution: 
 -----------
 Routine PSORREF0 has been modified to correctly check for the auto-suspend
 Scenario. If the requested fill date is less than the next possible fill
 date on the prescription, a message is created and the prescription refill
 process stops.
     
 Technical Resolution: 
 ---------------------
 Modification at EDATE+7^PSORREF0. Commented out checks that do not apply 
 and modified the final check so we are not checking the "EAOK" parameter
 or the auto-suspend parameter. The EAOK and auto-suspend parameters do not
 apply to OneVA pharmacy. Commented code is being left in place for
 reference by future Developers/support.
  
 ; PSO*7*497 - removing this check, as it is not needed.
 ;I 
 '$P(PSOPAR,"^",6),'$D(PSOREF("EAOK")),$P(PSOREF("RX3"),"^",2)>PSOREF("FILL
 DATE") D
 ;. S PSOX1=(PSOREF("NUMBER")+1)*PSOREF("DAYS SUPPLY")-10
 ;. ; PSO*7*497 - replacing line below with one that follows 
 (auto-suspend defect - do not allow bypass)
 ;. ;W !?5,$C(7),"LESS THAN ",PSOX1," DAYS FOR ",PSOREF("NUMBER")+1," 
 FILLS",! D DIR K PSOX1
 ;. S PSORMSG(1)="LESS THAN "_PSOX1_" DAYS FOR "_PSOREF("NUMBER")+1_" 
 FILLS" S (PSOREF("DFLG"),PSOMHV)=1 K PSOX1
 ; PSO(7*497 - replacing line below with the one that follows - EAOK 
 check and auto-suspend flag are irrelevant for oneva pharmacy
 ;I 
 '$P(PSOPAR,"^",6),$G(PSOREF("EAOK"))=0,$P(PSOREF("RX3"),"^",2)>PSOREF("FIL
 L DATE") D
 I $P(PSOREF("RX3"),"^",2)>PSOREF("FILL DATE") D
 . ; PSO*7*497 - replacing line below with one that follows (auto-suspend 
 defect)
 . ;S Y=$P(PSOREF("RX3"),"^",2) D DD^%DT W !!,$C(7),"Cannot be refilled 
 until "_Y_"." S (PSOREF("DFLG"),PSOMHV)=1 K Y
 . S Y=$P(PSOREF("RX3"),"^",2) D DD^%DT S PSORMSG(1)="Cannot be refilled 
 until "_Y_"." S (PSOREF("DFLG"),PSOMHV)=1 K Y
  
  
 3. I12239583FY17 - OneVA and Drug TRADE NAME usage
  
 Problem: 
 --------
 The OneVA pharmacy software cannot properly handle the TRADE NAME field 
 associated with a prescription.
  
  
 Resolution: 
 -----------
 Routine PSORREF has been modified to block prescriptions that contain a 
 trade name from being refilled by a non-host site pharmacy (i.e.
 dispensing or remote pharmacy). When a prescription containing a trade
 name is blocked, a message is sent to the dispensing pharmacy indicating
 the drug cannot be refilled or partially filled because it contains a
 trade name.
     
 Technical Resolution: 
 ---------------------
 REMREF+15-19^PSORREF:
  
  ; PSO*7*497 - trade name block/titration block
  I $$GET1^DIQ(52,RRXIEN,6.5,"E")]"" D  Q
  .D RET0
  .S RET(1)="This prescription cannot be refilled or partial filled 
   because it has a value"
  .S RET(2)="entered in the Rx trade name field.  Please follow local
   policy for obtaining"
  .S RET(3)="a new prescription."
  
 PAR+19^PSORRPA1
  
  ; PSO*7*497 - trade name block
  I $$GET1^DIQ(52,RRXIEN,6.5,"E")]"" D  Q
  .S VALMSG(1)="This prescription cannot be refilled or partial filled be
   cause it has a value"
  .S VALMSG(2)="entered in the Rx trade name field.  Please follow local
   policy for obtaining"
  .S VALMSG(3)="a new prescription."
  ; PSO*7*497 - end trade name block
  
  
 4.) TITRATION - need ticket information.
  
 Problem: 
 --------
 Prescriptions that are a 'titration' type of prescription can be refilled 
 by a Non-host (remote/dispensing) facility. Only partial fills should be
 allowed for The 'titration' prescription.
  
 Resolution: 
 -----------
 Routine PSORREF has been modified to block the refill of a titration type
 Prescription and inform the user to issue a partial fill request.
     
 Technical Resolution: 
 ---------------------
 REMREF+20^PSORREF:
  
 I $$TITRX^PSOUTL(RRXIEN)="t" S RET(1)="Cannot refill prescription - type 
 is Titration. You may request a partial fill." D RET0 Q
  
 5.) - Moving the OneVA Pharmacy Flag
  
 Problem:
 --------
 It has been requested that the OneVA Pharmacy flag be moved from the 
 OUTPATIENT SITE file (#59) to the PHARMACY SYSTEM file (#59.7). It has
 also been requested that the [PSS SYS EDIT] function be modified to
 include the new ONEVA PHARMACY FLAG field in the prompting sequence for
 users. The new location is in the Pharmacy System file (#59.7), and is
 stored in the ONEVA PHARMACY FLAG field (#101).
  
 Resolution:
 -----------
 PSORX1,PSORRPA1, and PSORREF have been modified to look at the new 
 location for the OneVA pharmacy flag. 
  
 Technical Resolution:
 ---------------------
 OERR+25^PSORX1
  
 .I '$$GET1^DIQ(59.7,1,101,"I") D  Q
  
  
 PAR+5^PSORRPA1
  
 I '$$GET1^DIQ(59.7,1,101,"I") D  Q
  
 REMREF+10^PSORREF
  
 I '$$GET1^DIQ(59.7,1,101,"I") D  Q
  
  
 Test Sites:
 ----------
 N/A
  
  
 Documentation Retrieval Instructions
 ====================================
 Updated documentation describing the new functionality introduced by this 
 patch are available.
  
 The preferred method is to retrieve files from download.DNS      .DNS   .
 This transmits the files from the first available server. Sites may also 
 elect to retrieve files directly from a specific server. 
  
 Sites may retrieve the documentation directly using Secure File Transfer 
 Protocol (SFTP) from the ANONYMOUS.SOFTWARE directory at the following OI
 Field Offices:
  
    
 Hines:                  DNS     .URL           
 Salt Lake City:               .URL       
  
  
 Documentation can also be found on the VA Software Documentation Library 
 at:
 http://URL            /
  
 Title                         File Name                       FTP Mode
 -----------------------------------------------------------------------
 <Documentation title>       
  
  
 Patch Installation:
  
  
 Pre/Post Installation Overview:
 -------------------------------
 There are no pre-post installation instructions for this patch.
  
  
 Pre-Installation Instructions:
 ------------------------------
 N/A
  
 This patch may be installed with users on the system although it is 
 recommended that it be installed during non-peak hours to minimize
 potential disruption to users.  This patch should take less than 5 
 minutes 
 to install.
  
  
 Installation Instructions:
 --------------------------
 1.  Choose the PackMan message containing this patch.
  
 2.  Choose the INSTALL/CHECK MESSAGE PackMan option.
  
 3.  From the Kernel Installation and Distribution System Menu, select
     the Installation Menu.  From this menu, you may elect to use the
     following options. When prompted for the INSTALL NAME enter the patch 
     #(ex. PSO*7.0*497):
     a.  Backup a Transport Global - This option will create a backup
         message of any routines exported with this patch. It will not
         backup any other changes such as DDs or templates.
     b.  Compare Transport Global to Current System - This option will
         allow you to view all changes that will be made when this patch
         is installed.  It compares all components of this patch
         (routines, DDs, templates, etc.).
     c.  Verify Checksums in Transport Global - This option will allow
         you to ensure the integrity of the routines that are in the
         transport global.
      
 4.  From the Installation Menu, select the Install Package(s) option and
     choose the patch to install.
  
 5.  When prompted 'Want KIDS to Rebuild Menu Trees Upon Completion of
     Install? NO//', answer 'YES'.    
  
 6.  When prompted 'Want KIDS to INHIBIT LOGONs during the install?
     NO//', answer 'NO'.
  
 7.  When prompted 'Want to DISABLE Scheduled Options, Menu Options, 
     and Protocols? NO//', answer 'NO'.
  
  
 Post-Installation Instructions:
 -------------------------------
 N/A

Routine Information:
====================
The second line of each of these routines now looks like:
 ;;7.0;OUTPATIENT PHARMACY;**[Patch List]**;DEC 1997;Build 22

The checksums below are new checksums, and
 can be checked with CHECK1^XTSUMBLD.

Routine Name: PSORREF
    Before: B44094138   After: B49315727  **454,475,497**
Routine Name: PSORREF0
    Before: B46515290   After: B43141161  **454,497**
Routine Name: PSORRPA1
    Before: B75343267   After: B80588571  **454,475,497**
Routine Name: PSORRX2
    Before: B34725424   After: B35129325  **454,479,497**
Routine Name: PSORX1
    Before: B83034701   After: B82991230  **7,22,23,57,62,46,74,71,90,
                                           95,115,117,146,139,135,182,195,
                                           233,268,300,170,320,326,324,
                                           334,251,454,488,497**
 
Routine list of preceding patches: 475, 479, 488

=============================================================================
User Information:
Entered By  : FISHER,BRADLEY                Date Entered  : AUG 01, 2017
Completed By:                               Date Completed: 
Released By :                               Date Released : 
=============================================================================


Packman Mail Message:
=====================

$END TXT
$KID PSO*7.0*497
**INSTALL NAME**
PSO*7.0*497
"BLD",9861,0)
PSO*7.0*497^OUTPATIENT PHARMACY^0^3171009^y
"BLD",9861,4,0)
^9.64PA^59.7^1
"BLD",9861,4,59.7,0)
59.7
"BLD",9861,4,59.7,2,0)
^9.641^59.7^1
"BLD",9861,4,59.7,2,59.7,0)
PHARMACY SYSTEM  (File-top level)
"BLD",9861,4,59.7,2,59.7,1,0)
^9.6411^101^1
"BLD",9861,4,59.7,2,59.7,1,101,0)
ONEVA PHARMACY FLAG
"BLD",9861,4,59.7,222)
y^y^p^^^^n^^n
"BLD",9861,4,59.7,224)

"BLD",9861,4,"APDD",59.7,59.7)

"BLD",9861,4,"APDD",59.7,59.7,101)

"BLD",9861,4,"B",59.7,59.7)

"BLD",9861,6.3)
22
"BLD",9861,"ABPKG")
n
"BLD",9861,"KRN",0)
^9.67PA^779.2^20
"BLD",9861,"KRN",.4,0)
.4
"BLD",9861,"KRN",.401,0)
.401
"BLD",9861,"KRN",.402,0)
.402
"BLD",9861,"KRN",.403,0)
.403
"BLD",9861,"KRN",.5,0)
.5
"BLD",9861,"KRN",.84,0)
.84
"BLD",9861,"KRN",3.6,0)
3.6
"BLD",9861,"KRN",3.8,0)
3.8
"BLD",9861,"KRN",9.2,0)
9.2
"BLD",9861,"KRN",9.8,0)
9.8
"BLD",9861,"KRN",9.8,"NM",0)
^9.68A^6^5
"BLD",9861,"KRN",9.8,"NM",1,0)
PSORREF^^0^B49315727
"BLD",9861,"KRN",9.8,"NM",2,0)
PSORRPA1^^0^B80588571
"BLD",9861,"KRN",9.8,"NM",3,0)
PSORREF0^^0^B43141161
"BLD",9861,"KRN",9.8,"NM",5,0)
PSORX1^^0^B82991230
"BLD",9861,"KRN",9.8,"NM",6,0)
PSORRX2^^0^B35129325
"BLD",9861,"KRN",9.8,"NM","B","PSORREF",1)

"BLD",9861,"KRN",9.8,"NM","B","PSORREF0",3)

"BLD",9861,"KRN",9.8,"NM","B","PSORRPA1",2)

"BLD",9861,"KRN",9.8,"NM","B","PSORRX2",6)

"BLD",9861,"KRN",9.8,"NM","B","PSORX1",5)

"BLD",9861,"KRN",19,0)
19
"BLD",9861,"KRN",19.1,0)
19.1
"BLD",9861,"KRN",101,0)
101
"BLD",9861,"KRN",101,"NM",0)
^9.68A^3^3
"BLD",9861,"KRN",101,"NM",1,0)
PSO LM REMOTE PARTIAL^^0
"BLD",9861,"KRN",101,"NM",2,0)
PSO LM REFILL REMOTE ORDER^^0
"BLD",9861,"KRN",101,"NM",3,0)
PSO LM REMOTE ORDER MENU^^0
"BLD",9861,"KRN",101,"NM","B","PSO LM REFILL REMOTE ORDER",2)

"BLD",9861,"KRN",101,"NM","B","PSO LM REMOTE ORDER MENU",3)

"BLD",9861,"KRN",101,"NM","B","PSO LM REMOTE PARTIAL",1)

"BLD",9861,"KRN",409.61,0)
409.61
"BLD",9861,"KRN",771,0)
771
"BLD",9861,"KRN",779.2,0)
779.2
"BLD",9861,"KRN",870,0)
870
"BLD",9861,"KRN",8989.51,0)
8989.51
"BLD",9861,"KRN",8989.52,0)
8989.52
"BLD",9861,"KRN",8994,0)
8994
"BLD",9861,"KRN","B",.4,.4)

"BLD",9861,"KRN","B",.401,.401)

"BLD",9861,"KRN","B",.402,.402)

"BLD",9861,"KRN","B",.403,.403)

"BLD",9861,"KRN","B",.5,.5)

"BLD",9861,"KRN","B",.84,.84)

"BLD",9861,"KRN","B",3.6,3.6)

"BLD",9861,"KRN","B",3.8,3.8)

"BLD",9861,"KRN","B",9.2,9.2)

"BLD",9861,"KRN","B",9.8,9.8)

"BLD",9861,"KRN","B",19,19)

"BLD",9861,"KRN","B",19.1,19.1)

"BLD",9861,"KRN","B",101,101)

"BLD",9861,"KRN","B",409.61,409.61)

"BLD",9861,"KRN","B",771,771)

"BLD",9861,"KRN","B",779.2,779.2)

"BLD",9861,"KRN","B",870,870)

"BLD",9861,"KRN","B",8989.51,8989.51)

"BLD",9861,"KRN","B",8989.52,8989.52)

"BLD",9861,"KRN","B",8994,8994)

"BLD",9861,"QDEF")
^^^^NO^^^^NO^^NO
"BLD",9861,"QUES",0)
^9.62^^
"BLD",9861,"REQB",0)
^9.611^4^4
"BLD",9861,"REQB",1,0)
PSO*7.0*475^2
"BLD",9861,"REQB",2,0)
PSO*7.0*454^2
"BLD",9861,"REQB",3,0)
PSO*7.0*479^2
"BLD",9861,"REQB",4,0)
PSO*7.0*488^2
"BLD",9861,"REQB","B","PSO*7.0*454",2)

"BLD",9861,"REQB","B","PSO*7.0*475",1)

"BLD",9861,"REQB","B","PSO*7.0*479",3)

"BLD",9861,"REQB","B","PSO*7.0*488",4)

"FIA",59.7)
PHARMACY SYSTEM
"FIA",59.7,0)
^PS(59.7,
"FIA",59.7,0,0)
59.7
"FIA",59.7,0,1)
y^y^p^^^^n^^n
"FIA",59.7,0,10)

"FIA",59.7,0,11)

"FIA",59.7,0,"RLRO")

"FIA",59.7,0,"VR")
7.0^PSO
"FIA",59.7,59.7)
1
"FIA",59.7,59.7,101)

"KRN",101,7819,-1)
0^3
"KRN",101,7819,0)
PSO LM REMOTE ORDER MENU^Remote Order Menu^^M^^^^^^^^OUTPATIENT PHARMACY
"KRN",101,7819,4)
45
"KRN",101,7819,10,0)
^101.01PA^2^2
"KRN",101,7819,10,1,0)
7820^RF^1^
"KRN",101,7819,10,1,"^")
PSO LM REFILL REMOTE ORDER
"KRN",101,7819,10,2,0)
7821^PR^2^
"KRN",101,7819,10,2,"^")
PSO LM REMOTE PARTIAL
"KRN",101,7819,24)
I 1 X:$D(^ORD(101,+$P(^ORD(101,DA(1),10,DA,0),"""^""",1),24)) ^(24)
"KRN",101,7819,26)
D SHOW^VALM
"KRN",101,7819,28)
Select Action:
"KRN",101,7819,99)
64551,40563
"KRN",101,7820,-1)
0^2
"KRN",101,7820,0)
PSO LM REFILL REMOTE ORDER^Refill Rx from Another VA Pharmacy^^A^^^^^^^^
"KRN",101,7820,2,0)
^101.02A^1^1
"KRN",101,7820,2,1,0)
RF
"KRN",101,7820,2,"B","RF",1)

"KRN",101,7820,20)
D REFREQ^PSORRX1
"KRN",101,7820,24)
I $$PSORPH^PSORRX2(DUZ)
"KRN",101,7820,99)
64159,81275
"KRN",101,7821,-1)
0^1
"KRN",101,7821,0)
PSO LM REMOTE PARTIAL^Partial Fill Rx from Another VA Pharmacy^^A^^^^^^^^
"KRN",101,7821,20)
D PARTIAL^PSORRX1
"KRN",101,7821,24)
I $$PSORPH^PSORRX2(DUZ)
"KRN",101,7821,99)
64551,40563
"MBREQ")
0
"ORD",15,101)
101;15;;;PRO^XPDTA;PROF1^XPDIA;PROE1^XPDIA;PROF2^XPDIA;;PRODEL^XPDIA
"ORD",15,101,0)
PROTOCOL
"PKG",170,-1)
1^1
"PKG",170,0)
OUTPATIENT PHARMACY^PSO^OUTPATIENT LABELS, PROFILE, INVENTORY, PRESCRIPTIONS
"PKG",170,20,0)
^9.402P^^
"PKG",170,22,0)
^9.49I^1^1
"PKG",170,22,1,0)
7.0^2971216^2981113^1
"PKG",170,22,1,"PAH",1,0)
497^3171009
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPI1",0)
YO
"QUES","XPI1","??")
^D INHIBIT^XPDH
"QUES","XPI1","A")
Want KIDS to INHIBIT LOGONs during the install
"QUES","XPI1","B")
NO
"QUES","XPI1","M")
D XPI1^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")

"QUES","XPM1","M")
D XPM1^XPDIQ
"QUES","XPO1",0)
Y
"QUES","XPO1","??")
^D MENU^XPDH
"QUES","XPO1","A")
Want KIDS to Rebuild Menu Trees Upon Completion of Install
"QUES","XPO1","B")
NO
"QUES","XPO1","M")
D XPO1^XPDIQ
"QUES","XPZ1",0)
Y
"QUES","XPZ1","??")
^D OPT^XPDH
"QUES","XPZ1","A")
Want to DISABLE Scheduled Options, Menu Options, and Protocols
"QUES","XPZ1","B")
NO
"QUES","XPZ1","M")
D XPZ1^XPDIQ
"QUES","XPZ2",0)
Y
"QUES","XPZ2","??")
^D RTN^XPDH
"QUES","XPZ2","A")
Want to MOVE routines to other CPUs
"QUES","XPZ2","B")
NO
"QUES","XPZ2","M")
D XPZ2^XPDIQ
"RTN")
5
"RTN","PSORREF")
0^1^B49315727^B44094138
"RTN","PSORREF",1,0)
PSORREF ;AITC/BWF - Remote RX retrieval API ;12/12/16 3:21pm
"RTN","PSORREF",2,0)
 ;;7.0;OUTPATIENT PHARMACY;**454,475,497**;DEC 1997;Build 22
"RTN","PSORREF",3,0)
 ;
"RTN","PSORREF",4,0)
 Q
"RTN","PSORREF",5,0)
 ; RET    - return data
"RTN","PSORREF",6,0)
 ; RXNUM  - RX Number from remote system
"RTN","PSORREF",7,0)
 ; FDATE  - Fill Date
"RTN","PSORREF",8,0)
 ; MW     - Mail/Window - Default of 'W' for now.
"RTN","PSORREF",9,0)
 ; RPHARM - Pharmacist from remote site
"RTN","PSORREF",10,0)
 ; RPHONE - Contact number
"RTN","PSORREF",11,0)
 ; RSITE  - Filling site number
"RTN","PSORREF",12,0)
 ;
"RTN","PSORREF",13,0)
REMREF(RET,RXNUM,FDATE,MW,RPHARM,RPHONE,RSITE,RX0,RX2,RXSTA,RPROV,RSIG,RREF0,RO
R1,RX3) ;
"RTN","PSORREF",14,0)
 ;
"RTN","PSORREF",15,0)
 N MSG,BACK,PSOPAR,RRXIEN,PSOSIEN,DSUPP,LASTREF,XTMPLOC,PASSLOC,HFSIEN,FULLPTH,
HFSDONE,PTHDAT,PTHPIECE,FOUND,STRT,STATION,FTGOPEN,PPL1,PSOSITE
"RTN","PSORREF",16,0)
 N PSOX,PTHFILE,SITENUM,X,X1,X2,HDRUG,CSVAL,PSISSDT,TFILLS,OFFSET,CHKDT,DINACT,
DEL,FTGSTRT,PDIR,PFIL,PSODTCUT,PSOEXREP,PSOPHDUZ
"RTN","PSORREF",17,0)
 N PSODFDIR,PSOFNAME,PAR,DELARR,RREFIEN
"RTN","PSORREF",18,0)
 N PSOBBC,PSOBBC1,PSODIR,PSOMVH
"RTN","PSORREF",19,0)
 ; check 3rd party payer rejects. Send message to initiating site if applicable
.
"RTN","PSORREF",20,0)
 S $ETRAP="D ^%ZTER Q"
"RTN","PSORREF",21,0)
 S RET(0)=""
"RTN","PSORREF",22,0)
 S RRXIEN=$O(^PSRX("B",RXNUM,0)),PSOSIEN=$$GET1^DIQ(52,RRXIEN,20,"I")
"RTN","PSORREF",23,0)
 I '$$GET1^DIQ(59.7,1,101,"I") D  Q
"RTN","PSORREF",24,0)
 .S RET(1)="The OneVA pharmacy flag is turned 'OFF' at this facility."
"RTN","PSORREF",25,0)
 .S RET(2)="Unable to process refill/partial fill requests."
"RTN","PSORREF",26,0)
 .D RET0
"RTN","PSORREF",27,0)
 ; PSO*7*497 - trade name block/titration block
"RTN","PSORREF",28,0)
 I $$GET1^DIQ(52,RRXIEN,6.5,"E")]"" D  Q
"RTN","PSORREF",29,0)
 .D RET0
"RTN","PSORREF",30,0)
 .S RET(1)="This prescription cannot be refilled or partial filled because it h
as a value"
"RTN","PSORREF",31,0)
 .S RET(2)="entered in the Rx trade name field.  Please follow local policy for
 obtaining"
"RTN","PSORREF",32,0)
 .S RET(3)="a new prescription."
"RTN","PSORREF",33,0)
 I $$TITRX^PSOUTL(RRXIEN)="t" S RET(1)="Cannot refill prescription - type is Ti
tration. You may request a partial fill." D RET0 Q
"RTN","PSORREF",34,0)
 ; PSO*7*497 - end trade name/titration block
"RTN","PSORREF",35,0)
 S PSOPHDUZ=$$GET1^DIQ(52,RRXIEN,23,"I") I 'PSOPHDUZ S PSOPHDUZ=.5
"RTN","PSORREF",36,0)
 S HDRUG=$$GET1^DIQ(52,RRXIEN,6,"I")
"RTN","PSORREF",37,0)
 ; quit if drug is inactive
"RTN","PSORREF",38,0)
 S DINACT=$$GET1^DIQ(50,HDRUG,100,"I")
"RTN","PSORREF",39,0)
 I DINACT>0,DINACT<$$NOW^XLFDT S RET(1)="Drug is inactive for Rx# "_RXNUM_". Ca
nnot refill." D RET0 Q
"RTN","PSORREF",40,0)
 S CSVAL=$$GET1^DIQ(50,HDRUG,3,"E"),CSVAL=$E(CSVAL,1)
"RTN","PSORREF",41,0)
 I CSVAL,CSVAL>0,CSVAL<6 D RET0 S RET(1)="Rx #"_RXNUM_" cannot be refilled.",RE
T(2)="The associated drug is considered a controlled substance",RET(3)="at the 
host facility." Q
"RTN","PSORREF",42,0)
 S PSOPAR=$G(^PS(59,PSOSIEN,1)),PSOSITE=PSOSIEN
"RTN","PSORREF",43,0)
 S RPHONE=$G(RPHONE,"")
"RTN","PSORREF",44,0)
 ; check to see if this action will throw the prescription into suspense. If so
, quit and return a message
"RTN","PSORREF",45,0)
 S DSUPP=$$GET1^DIQ(52,RRXIEN,8,"I")
"RTN","PSORREF",46,0)
 S X2=-120,X1=DT D C^%DTC S PSODTCUT=X
"RTN","PSORREF",47,0)
 S (PSODFN,PSOREF("PSODFN"))=$$GET1^DIQ(52,RRXIEN,2,"I") K PSOSD D ^PSOBUILD
"RTN","PSORREF",48,0)
 N RXN K PSORX("FILL DATE") S PSOFROM="REFILL" S PSOREF("DFLG")=0,PSOREF("IRXN"
)=$O(^PSRX("B",RXNUM,0)),PSOREF("QFLG")=0
"RTN","PSORREF",49,0)
 I $$LMREJ^PSOREJU1(RXNUM,,.MSG,.BACK) S RET(1)=MSG D RET0 Q
"RTN","PSORREF",50,0)
 S PSORX("FILL DATE")=FDATE
"RTN","PSORREF",51,0)
 K PSOID D START^PSORREF1(FDATE) I PSOREF("DFLG") D EOJ Q
"RTN","PSORREF",52,0)
 ; check ability to refill given issue date/days supply
"RTN","PSORREF",53,0)
 S PSISSDT=$$GET1^DIQ(52,RRXIEN,1,"I")
"RTN","PSORREF",54,0)
 S TFILLS=$O(^PSRX(RRXIEN,1,"A"),-1)+1
"RTN","PSORREF",55,0)
 S OFFSET=DSUPP*TFILLS,OFFSET=OFFSET-10
"RTN","PSORREF",56,0)
 S CHKDT=$$FMADD^XLFDT(PSISSDT,OFFSET)
"RTN","PSORREF",57,0)
 I PSORX("FILL DATE")<CHKDT D RET0 S RET(1)="Cannot refill Rx# "_RXNUM_". Next 
possible fill date is "_$$FMTE^XLFDT(CHKDT,"5D") Q
"RTN","PSORREF",58,0)
 I PSORX("FILL DATE")>$$GET1^DIQ(52,RRXIEN,26,"I") D RET0 S RET(1)="Cannot refi
ll Rx# "_RXNUM_".",RET(2)="Cannot refill after expiration date "_$$GET1^DIQ(52,
RRXIEN,11,"E") Q
"RTN","PSORREF",59,0)
 D PROCESS^PSORREF0(.RET)
"RTN","PSORREF",60,0)
 ; make sure not errors are returned
"RTN","PSORREF",61,0)
 I $D(RET(1)) D EOJ Q
"RTN","PSORREF",62,0)
 I '$D(RET(1)) D
"RTN","PSORREF",63,0)
 .; bwf 8/14/14 - set up needed variables for label printing
"RTN","PSORREF",64,0)
 .S PSODFN=$P(^PSRX(RRXIEN,0),U,2)
"RTN","PSORREF",65,0)
 .S PSORX("IRXN")=RXNUM
"RTN","PSORREF",66,0)
 .S PSORX("PSOL",1)=RRXIEN_","
"RTN","PSORREF",67,0)
 .S PSORX("MAIL/WINDOW")="WINDOW"
"RTN","PSORREF",68,0)
 .S PSORX("NAME")=$$GET1^DIQ(2,PSODFN,.01)
"RTN","PSORREF",69,0)
 .S PSORX("QFLG")=0
"RTN","PSORREF",70,0)
 .S PSORX("METHOD OF PICKUP")=""
"RTN","PSORREF",71,0)
 .S PSOX=$G(^PS(55,PSODFN,"PS")) I PSOX]"" S PSORX("PATIENT STATUS")=$P($G(^PS(
53,PSOX,0)),"^")
"RTN","PSORREF",72,0)
 .S PPL1=RRXIEN
"RTN","PSORREF",73,0)
 .; bwf 8/14/14 - end setup for label printing.
"RTN","PSORREF",74,0)
 .S PSODFDIR=$$DEFDIR^%ZISH()
"RTN","PSORREF",75,0)
 .S PSOFNAME="PSOLBL_"_RXNUM_"_"_PSOSITE_"_"_DT_".DAT"
"RTN","PSORREF",76,0)
 .S FULLPTH=PSODFDIR_PSOFNAME
"RTN","PSORREF",77,0)
 .S HFSDONE=0,PTHDAT=""
"RTN","PSORREF",78,0)
 .; preserve IO
"RTN","PSORREF",79,0)
 .D SAVDEV^%ZISUTL("ONEVAHLIO")
"RTN","PSORREF",80,0)
 .S DELARR("PSOLBL_"_RXNUM_"_"_PSOSITE_"_"_DT_".DAT")="" S DEL=$$DEL^%ZISH(PSOD
FDIR,$NA(DELARR))
"RTN","PSORREF",81,0)
 .S PSOEXREP=1
"RTN","PSORREF",82,0)
 .; call out to generate label
"RTN","PSORREF",83,0)
 .D LABEL^PSORWRAP(RRXIEN,"HFS",PSOSITE,PSOPHDUZ,"",PSOFNAME)
"RTN","PSORREF",84,0)
 .S XTMPLOC="^XTMP(""PSORLBL"","_HLINSTN_","_+RXNUM_",1,0)"
"RTN","PSORREF",85,0)
 .S PASSLOC="XTMP(""PSORLBL"","_HLINSTN_","_+RXNUM_")"
"RTN","PSORREF",86,0)
 .K ^XTMP("PSORLBL",HLINSTN,+RXNUM,0)
"RTN","PSORREF",87,0)
 .S ^XTMP("PSORLBL",HLINSTN,+RXNUM,0)=DT_U_$$FMADD^XLFDT(DT,30)
"RTN","PSORREF",88,0)
 .; looks like we have to wait a moment before the file shows up.
"RTN","PSORREF",89,0)
 .S FTGSTRT=$$NOW^XLFDT,(FOUND,FTGOPEN)=0
"RTN","PSORREF",90,0)
 .N PAR S PAR=0
"RTN","PSORREF",91,0)
 .F  D  Q:$$NOW^XLFDT>$$FMADD^XLFDT(FTGSTRT,,,,15)!(FOUND)!(FTGOPEN)
"RTN","PSORREF",92,0)
 ..S FTGOPEN=$$FTG^%ZISH(PSODFDIR,PSOFNAME,XTMPLOC,4)
"RTN","PSORREF",93,0)
 ..I $O(^XTMP("PSORLBL",HLINSTN,+RXNUM,0)) S FOUND=1
"RTN","PSORREF",94,0)
 .S DELARR("PSOLBL_"_RXNUM_"_"_PSOSITE_"_"_DT_".DAT")="" S DEL=$$DEL^%ZISH(PSOD
FDIR,$NA(DELARR))
"RTN","PSORREF",95,0)
 .; restore IO
"RTN","PSORREF",96,0)
 .D USE^%ZISUTL("ONEVAHLIO"),RMDEV^%ZISUTL("ONEVAHLIO")
"RTN","PSORREF",97,0)
 .D UPDREF(.RET,RRXIEN,RPHARM,RPHONE,RSITE,PASSLOC)
"RTN","PSORREF",98,0)
 .S RET(1)="Rx # "_RXNUM_" refilled."
"RTN","PSORREF",99,0)
 .S RX0=$G(^PSRX(RRXIEN,0)),RX2=$G(^PSRX(RRXIEN,2)),RX3=$G(^PSRX(RRXIEN,3))
"RTN","PSORREF",100,0)
 .S RXSTA=$G(^PSRX(RRXIEN,"STA")),RPROV=$$GET1^DIQ(200,$P(RX0,U,4),.01,"E")_U_$
$GET1^DIQ(200,$P(RX0,U,16),.01,"E")
"RTN","PSORREF",101,0)
 .S RSIG=$G(^PSRX(RRXIEN,"SIG"))
"RTN","PSORREF",102,0)
 .S RREFIEN=$O(^PSRX(RRXIEN,1,"A"),-1)
"RTN","PSORREF",103,0)
 .I RREFIEN S RREF0=$G(^PSRX(RRXIEN,1,RREFIEN,0))
"RTN","PSORREF",104,0)
 .S ROR1=$G(^PSRX(RRXIEN,"OR1"))
"RTN","PSORREF",105,0)
 D EOJ
"RTN","PSORREF",106,0)
 Q
"RTN","PSORREF",107,0)
EOJ ;
"RTN","PSORREF",108,0)
 D RET0
"RTN","PSORREF",109,0)
 K PSOMSG,PSOREF,PSORX("BAR CODE"),PSOLIST,LFD,MAX,MIN,NODE,PS,PSOERR,REF,RF,RX
O,RXN,RXP,RXS,SD,VAERR,PSORX("FILL DATE")
"RTN","PSORREF",110,0)
 K PSOFROM,PSODFN,PSORX
"RTN","PSORREF",111,0)
 Q
"RTN","PSORREF",112,0)
Subj: PSO*7*497 TEST v1  [#86147425]   Page 2
-------------------------------------------------------------------------------
 ; build ret(0) if needed
"RTN","PSORREF",113,0)
RET0 ;
"RTN","PSORREF",114,0)
 I '$L(RET(0)) S RET(0)=0_U_RXNUM_U_RRXIEN_U_U_FDATE,$P(RET(0),U,15)=$G(RPHARM)
,$P(RET(0),U,16)=$G(RPHONE),$P(RET(0),U,17)=$G(RSITE)
"RTN","PSORREF",115,0)
 Q
"RTN","PSORREF",116,0)
 ;
"RTN","PSORREF",117,0)
ULK ;
"RTN","PSORREF",118,0)
 Q
"RTN","PSORREF",119,0)
 ; successful refill. Update data, and build response
"RTN","PSORREF",120,0)
UPDREF(PSOMSG,PSOIEN,RPHARM,RPHONE,RSITE,PASSLOC) ;
"RTN","PSORREF",121,0)
 N REFIEN,REFIENS,REFDATA,FIL,RXNUM,RFILLDT,QTY,DSUPP,CLERK,LOGDATE,IDIV,EDIV,D
ISPDT,NDC,FDA,DNAME,DIEN,DAT
"RTN","PSORREF",122,0)
 S FIL=52.1
"RTN","PSORREF",123,0)
 ; get last refill data node
"RTN","PSORREF",124,0)
 S REFIEN=$O(^PSRX(PSOIEN,1,"B",DT,""),-1)
"RTN","PSORREF",125,0)
 S RXNUM=$$GET1^DIQ(52,PSOIEN,.01,"E")
"RTN","PSORREF",126,0)
 S DNAME=$$GET1^DIQ(52,PSOIEN,6,"E")
"RTN","PSORREF",127,0)
 S DIEN=$$GET1^DIQ(52,PSOIEN,6,"I")
"RTN","PSORREF",128,0)
 S REFIENS=REFIEN_","_PSOIEN_","
"RTN","PSORREF",129,0)
 ; first, set in the remote pharmacist data
"RTN","PSORREF",130,0)
 S FDA(FIL,REFIENS,91)=RSITE
"RTN","PSORREF",131,0)
 S FDA(FIL,REFIENS,92)=RPHARM
"RTN","PSORREF",132,0)
 S FDA(FIL,REFIENS,93)=RPHONE
"RTN","PSORREF",133,0)
 D FILE^DIE(,"FDA") K FDA
"RTN","PSORREF",134,0)
 ; now query data and build RET(0) holding accurate information from the refill
 multiple
"RTN","PSORREF",135,0)
 D GETS^DIQ(FIL,REFIENS,"**","IE","REFDATA")
"RTN","PSORREF",136,0)
 S RFILLDT=$G(REFDATA(FIL,REFIENS,.01,"I"))
"RTN","PSORREF",137,0)
 S QTY=$G(REFDATA(FIL,REFIENS,1,"I"))
"RTN","PSORREF",138,0)
 S DSUPP=$G(REFDATA(FIL,REFIENS,1.1,"I"))
"RTN","PSORREF",139,0)
 S CLERK=$G(REFDATA(FIL,REFIENS,6,"E"))
"RTN","PSORREF",140,0)
 S LOGDATE=$G(REFDATA(FIL,REFIENS,7,"I"))
"RTN","PSORREF",141,0)
 ; internal division number (IEN to PSO SITE file)
"RTN","PSORREF",142,0)
 S IDIV=$G(REFDATA(FIL,REFIENS,8,"I"))
"RTN","PSORREF",143,0)
 S EDIV=$G(REFDATA(FIL,REFIENS,8,"E"))
"RTN","PSORREF",144,0)
 S DISPDT=$G(REFDATA(FIL,REFIENS,10.1,"I"))
"RTN","PSORREF",145,0)
 S NDC=$G(REFDATA(FIL,REFIENS,11,"E"))
"RTN","PSORREF",146,0)
 S RSITE=$G(REFDATA(FIL,REFIENS,91,"I"))
"RTN","PSORREF",147,0)
 S RPHARM=$G(REFDATA(FIL,REFIENS,92,"E"))
"RTN","PSORREF",148,0)
 S RPHONE=$G(REFDATA(FIL,REFIENS,93,"E"))
"RTN","PSORREF",149,0)
 S $P(DAT(1),U,3)=RXNUM,$P(DAT(1),U,4)=RSITE,$P(DAT(1),U,7)=QTY,$P(DAT(1),U,8)=
DISPDT,$P(DAT(1),U,9)=DNAME,$P(DAT(1),U,10)=DSUPP,$P(DAT(1),U,11)=RPHARM,$P(DAT
(1),U,12)=RFILLDT
"RTN","PSORREF",150,0)
 D LOGDATA^PSORWRAP($NA(DAT),"OR",,,PSOIEN)
"RTN","PSORREF",151,0)
 S PSOMSG(0)=1_U_RXNUM_U_PSOIEN_U_REFIEN_U_RFILLDT_U_DNAME_U_QTY_U_DSUPP_U_CLER
K_U_LOGDATE_U_IDIV_U_EDIV_U_DISPDT_U_NDC_U_RPHARM_U_RPHONE_U_RSITE_U_PASSLOC
"RTN","PSORREF",152,0)
 Q
"RTN","PSORREF0")
0^3^B43141161^B46515290
"RTN","PSORREF0",1,0)
PSORREF0 ;AITC/BWF  Remote RX refill API ;7/15/16 1:57am
"RTN","PSORREF0",2,0)
 ;;7.0;OUTPATIENT PHARMACY;**454,497**;DEC 1997;Build 22
"RTN","PSORREF0",3,0)
 ;
"RTN","PSORREF0",4,0)
 ;External reference to ^PSDRUG supported by DBIA 221
"RTN","PSORREF0",5,0)
 ;
"RTN","PSORREF0",6,0)
 ; Modified copy of ^PSOREF0 for the OneVA Pharmacy Project - remote prescripti
ons
"RTN","PSORREF0",7,0)
 ;
"RTN","PSORREF0",8,0)
 ;PSO*186 add check for DEA Special handling field refill restrictions
"RTN","PSORREF0",9,0)
 Q
"RTN","PSORREF0",10,0)
PROCESS(PSORMSG) ;
"RTN","PSORREF0",11,0)
 K PSODF S PSOREF("RX0")=^PSRX(PSOREF("IRXN"),0),PSOREF("RX2")=^(2),PSOREF("RX3
")=^(3),PSOREF("STA")=+$G(^("STA")),PSOREF("SIG")=$P($G(^("SIG")),"^"),PSOREF("
PSODFN")=$P(PSOREF("RX0"),"^",2)
"RTN","PSORREF0",12,0)
 S PSOREF("DAYS SUPPLY")=$P(PSOREF("RX0"),"^",8)
"RTN","PSORREF0",13,0)
 K ZD(PSOREF("IRXN"))   ;*306
"RTN","PSORREF0",14,0)
 S PSOREF("DFLG")=0 D DSPLY G:PSOREF("DFLG") PROCESSX
"RTN","PSORREF0",15,0)
 D CHECK G:$G(PSODF) PROCESS G:PSOREF("DFLG") PROCESSX D EN^PSOR52(.PSOREF)
"RTN","PSORREF0",16,0)
PROCESSX D:$G(PSOREF("OLD FILL DATE"))]"" SUSDATEK^PSOUTIL(.PSOREF)
"RTN","PSORREF0",17,0)
 Q
"RTN","PSORREF0",18,0)
DSPLY ;
"RTN","PSORREF0",19,0)
 K FSIG,BSIG I $P($G(^PSRX(PSOREF("IRXN"),"SIG")),"^",2) D FSIG^PSOUTLA("R",PSO
REF("IRXN"),54) F PSREV=1:1 Q:'$D(FSIG(PSREV))  S BSIG(PSREV)=FSIG(PSREV)
"RTN","PSORREF0",20,0)
 K FSIG,PSREV I '$P($G(^PSRX(PSOREF("IRXN"),"SIG")),"^",2) D EN2^PSOUTLA1(PSORE
F("IRXN"),54)
"RTN","PSORREF0",21,0)
 I $O(BSIG(1)) F PSREV=1:0 S PSREV=$O(BSIG(PSREV)) Q:'PSREV  W !?24,$G(BSIG(PSR
EV))
"RTN","PSORREF0",22,0)
 K BSIG,PSREV
"RTN","PSORREF0",23,0)
DSPLYX Q
"RTN","PSORREF0",24,0)
CHECK ;
"RTN","PSORREF0",25,0)
 N STA
"RTN","PSORREF0",26,0)
 I '$P(PSOPAR,"^",11),$G(^PSDRUG($P(PSOREF("RX0"),"^",6),"I"))]"",DT>$G(^("I"))
 D  G CKQ
"RTN","PSORREF0",27,0)
 .S PSORMSG(1)=" *** Drug is inactive for Rx # "_$P(PSOREF("RX0"),"^")_" cannot
 be refilled ***"
"RTN","PSORREF0",28,0)
 I PSOREF("PSODFN")'=PSODFN S PSORMSG(1)="Can't refill Rx # "_$P(PSOREF("RX0"),
"^")_", it is not for this patient." G CKQ
"RTN","PSORREF0",29,0)
 S (PSOX,PSOY,STA)=""
"RTN","PSORREF0",30,0)
 I $G(PSOSD) F  S STA=$O(PSOSD(STA)) Q:STA=""  F  S PSOX=$O(PSOSD(STA,PSOX)) Q:
PSOX']""!(PSOREF("DFLG"))  I PSOREF("IRXN")=+PSOSD(STA,PSOX) S PSOY=PSOSD(STA,P
SOX) I $P(PSOY,"^",4)]"" D
"RTN","PSORREF0",31,0)
 . S PSOREF("DFLG")=1 S:'$G(PSOERR) PSORMSG(1)="Cannot refill Rx # "_$P(PSOREF(
"RX0"),"^") S PSOREA=$P(PSOY,"^",4),PSOSTAT=PSOREF("STA")
"RTN","PSORREF0",32,0)
 . D STATUS(PSOREA,PSOSTAT,.PSORMSG) K PSOREA,PSOSTAT
"RTN","PSORREF0",33,0)
 . Q
"RTN","PSORREF0",34,0)
 I PSOY="" S PSORMSG(1)="Cannot refill, Rx is discontinued or expired.  Later R
x may exist." D  I $G(PSODF) Q
"RTN","PSORREF0",35,0)
 .D LOOK I $G(PSODF) Q
"RTN","PSORREF0",36,0)
 .S PSOREF("DFLG")=1
"RTN","PSORREF0",37,0)
 K PSOX,PSOY G:PSOREF("DFLG") CHECKX
"RTN","PSORREF0",38,0)
 I $O(^PS(52.5,"B",PSOREF("IRXN"),0)),'$G(^PS(52.5,+$O(^PS(52.5,"B",PSOREF("IRX
N"),0)),"P")) S PSORMSG(1)="Rx is in suspense and cannot be refilled" S PSOREF(
"DFLG")=1 G CHECKX
"RTN","PSORREF0",39,0)
 S PSOREF("RXSTATUS")=PSOREF("STA")
"RTN","PSORREF0",40,0)
 I PSOREF("RXSTATUS"),PSOREF("RXSTATUS")'=6 D  G CHECKX
"RTN","PSORREF0",41,0)
 . S PSOY=";"_PSOREF("RXSTATUS"),PSOX=$P(^DD(52,100,0),"^",3),PSOY=$F(PSOX,PSOY
),PSOY=$P($E(PSOX,PSOY,999),";",1)   ;IA#999
"RTN","PSORREF0",42,0)
 . S PSORMSG(1)="Rx is in "_PSOY_" status, cannot be refilled" S PSOREF("DFLG")
=1
"RTN","PSORREF0",43,0)
 D CHKDIV G:PSOREF("DFLG") CHECKX
"RTN","PSORREF0",44,0)
 D NUMBER I PSOREF("NUMBER")>$P(PSOREF("RX0"),"^",9) S PSORMSG(1)="Can't refill
, no refills remaining." S PSOREF("DFLG")=1 G CHECKX
"RTN","PSORREF0",45,0)
 ;PSO*7*186  check DEA, SPEC HNDLG field, in case changed, and apply
"RTN","PSORREF0",46,0)
 N PSODRG,PSODEA,PSODAY
"RTN","PSORREF0",47,0)
 S PSODRG=$G(^PSDRUG($P(PSOREF("RX0"),U,6),0)),PSODEA=$P(PSODRG,U,3)
"RTN","PSORREF0",48,0)
 S PSODAY=$P(PSOREF("RX0"),U,8)
"RTN","PSORREF0",49,0)
 I $$DEACHK^PSOUTLA1(PSOREF("IRXN"),PSODEA,PSODAY) D  G CHECKX
"RTN","PSORREF0",50,0)
 . S PSORMSG(1)="This drug has been changed, No refills allowed"
"RTN","PSORREF0",51,0)
 . S PSOREF("DFLG")=1
"RTN","PSORREF0",52,0)
 D DATES
"RTN","PSORREF0",53,0)
CHECKX Q
"RTN","PSORREF0",54,0)
CKQ ;
"RTN","PSORREF0",55,0)
 S PSOREF("DFLG")=1 D PAUSE^VALM1 G CHECKX
"RTN","PSORREF0",56,0)
 Q
"RTN","PSORREF0",57,0)
 ;
"RTN","PSORREF0",58,0)
 ; PSO*7*497 - quitting at CHKDIV function, the logic that was executed does no
t apply to OneVA Pharmacy, per Rob Silverman
"RTN","PSORREF0",59,0)
CHKDIV Q
"RTN","PSORREF0",60,0)
CHKDIVX Q
"RTN","PSORREF0",61,0)
 ;
"RTN","PSORREF0",62,0)
NUMBER K PSOX,PSOY S PSOREF("# OF REFILLS")=0
"RTN","PSORREF0",63,0)
 I $G(^PSRX(PSOREF("IRXN"),1,0))]"" F PSOX=0:0 S PSOX=$O(^PSRX(PSOREF("IRXN"),1
,PSOX)) Q:'PSOX  S PSOREF("# OF REFILLS")=PSOX
"RTN","PSORREF0",64,0)
 S PSOREF("NUMBER")=PSOREF("# OF REFILLS")+1
"RTN","PSORREF0",65,0)
 Q
"RTN","PSORREF0",66,0)
 ;
"RTN","PSORREF0",67,0)
DATES S PSOREF("STOP DATE")=$P(PSOREF("RX2"),"^",6) D NEXT^PSOUTIL(.PSOREF)
"RTN","PSORREF0",68,0)
 D:$G(PSOBBC("QFLG"))&($P(PSOPAR,"^",6)) EDATE Q:$G(PSOREF("DFLG"))
"RTN","PSORREF0",69,0)
 S PSOREF("FILL DATE")=$S($G(PSOREF("FILL DATE")):PSOREF("FILL DATE"),1:DT)
"RTN","PSORREF0",70,0)
 I $P(PSOPAR,"^",6),PSOREF("FILL DATE")<$P(PSOREF("RX3"),"^",2) D SUSDATE^PSOUT
IL(.PSOREF)
"RTN","PSORREF0",71,0)
 ;
"RTN","PSORREF0",72,0)
 I PSOREF("FILL DATE")>PSOREF("STOP DATE") D
"RTN","PSORREF0",73,0)
 . S PSORMSG(1)="Can't refill, Refill Date "_$E(PSOREF("FILL DATE"),4,5)_"/"_$E
(PSOREF("FILL DATE"),6,7)_"/"
"RTN","PSORREF0",74,0)
 . S PSORMSG(2)=$E(PSOREF("FILL DATE"),2,3)_" is past Expiration Date "_$E(PSOR
EF("STOP DATE"),4,5)_"/"_$E(PSOREF("STOP DATE"),6,7)_"/"
"RTN","PSORREF0",75,0)
 . S PSORMSG(3)=$E(PSOREF("STOP DATE"),2,3) S PSOREF("DFLG")=1
"RTN","PSORREF0",76,0)
EDATE S PSOREF("LAST REFILL DATE")=$P(PSOREF("RX3"),"^",1)
"RTN","PSORREF0",77,0)
 I PSOREF("LAST REFILL DATE"),PSOREF("FILL DATE")=PSOREF("LAST REFILL DATE") D 
 G DATESX
"RTN","PSORREF0",78,0)
 . S PSORMSG(1)="Can't refill, Fill Date already exists for "_$E(PSOREF("FILL D
ATE"),4,5)_"/"_$E(PSOREF("FILL DATE"),6,7)_"/"_$E(PSOREF("FILL DATE"),2,3)
"RTN","PSORREF0",79,0)
 . S PSOREF("DFLG")=1
"RTN","PSORREF0",80,0)
 I PSOREF("LAST REFILL DATE"),PSOREF("FILL DATE")<PSOREF("LAST REFILL DATE") D 
 G DATESX
"RTN","PSORREF0",81,0)
 . S PSORMSG(1)="Can't refill, later Refill Date already exists for "_$E(PSOREF
("LAST REFILL DATE"),4,5)_"/"_$E(PSOREF("LAST REFILL DATE"),6,7)_"/"_$E(PSOREF(
"LAST REFILL DATE"),2,3)
"RTN","PSORREF0",82,0)
 . S PSOREF("DFLG")=1
"RTN","PSORREF0",83,0)
 ; PSO*7*497 - removing this check, as it is not needed.
"RTN","PSORREF0",84,0)
 ;I '$P(PSOPAR,"^",6),'$D(PSOREF("EAOK")),$P(PSOREF("RX3"),"^",2)>PSOREF("FILL 
DATE") D
"RTN","PSORREF0",85,0)
 ;. S PSOX1=(PSOREF("NUMBER")+1)*PSOREF("DAYS SUPPLY")-10
"RTN","PSORREF0",86,0)
 ;. ; PSO*7*497 - replacing line below with one that follows (auto-suspend defe
ct - do not allow bypass)
"RTN","PSORREF0",87,0)
 ;. ;W !?5,$C(7),"LESS THAN ",PSOX1," DAYS FOR ",PSOREF("NUMBER")+1," FILLS",! 
D DIR K PSOX1
"RTN","PSORREF0",88,0)
 ;. S PSORMSG(1)="LESS THAN "_PSOX1_" DAYS FOR "_PSOREF("NUMBER")+1_" FILLS" S 
(PSOREF("DFLG"),PSOMHV)=1 K PSOX1
"RTN","PSORREF0",89,0)
 ; PSO(7*497 - replacing line below with the one that follows - EAOK check and 
auto-suspend flag are irrelevant for oneva pharmacy
"RTN","PSORREF0",90,0)
 ;I '$P(PSOPAR,"^",6),$G(PSOREF("EAOK"))=0,$P(PSOREF("RX3"),"^",2)>PSOREF("FILL
 DATE") D
"RTN","PSORREF0",91,0)
 I $P(PSOREF("RX3"),"^",2)>PSOREF("FILL DATE") D
"RTN","PSORREF0",92,0)
 . ; PSO*7*497 - replacing line below with one that follows (auto-suspend defec
t)
"RTN","PSORREF0",93,0)
 . ;S Y=$P(PSOREF("RX3"),"^",2) D DD^%DT W !!,$C(7),"Cannot be refilled until "
_Y_"." S (PSOREF("DFLG"),PSOMHV)=1 K Y
"RTN","PSORREF0",94,0)
 . S Y=$P(PSOREF("RX3"),"^",2) D DD^%DT S PSORMSG(1)="Cannot be refilled until 
"_Y_"." S (PSOREF("DFLG"))=1 K Y
"RTN","PSORREF0",95,0)
DATESX Q
"RTN","PSORREF0",96,0)
 ; PSO*497 - quit at DIR. This is not used for oneva pharmacy.
"RTN","PSORREF0",97,0)
DIR ;
"RTN","PSORREF0",98,0)
 Q
"RTN","PSORREF0",99,0)
 ;
"RTN","PSORREF0",100,0)
EN(PSOREF)         ; Entry Point for Batch Barcode Option
"RTN","PSORREF0",101,0)
 D PROCESS K DRUG,PSODF
"RTN","PSORREF0",102,0)
 Q
"RTN","PSORREF0",103,0)
LOOK ;this entry is used to try and find current med order
"RTN","PSORREF0",104,0)
 S (PSOY,STA,PSOX)="",DRUG=$P(^PSDRUG($P(^PSRX(PSOREF("IRXN"),0),"^",6),0),"^")
"RTN","PSORREF0",105,0)
 I $G(PSOSD) F  S STA=$O(PSOSD(STA)) Q:STA=""  F  S PSOX=$O(PSOSD(STA,PSOX)) Q:
PSOX']""  I DRUG=PSOX,+PSOSD(STA,PSOX) S PSOY=PSOSD(STA,PSOX),PSOREF("IRXN")=+P
SOSD(STA,PSOX),PSODF=1,PSOBBC("DONE")=PSOREF("IRXN")_"," Q
"RTN","PSORREF0",106,0)
 K DRUG
"RTN","PSORREF0",107,0)
 Q
"RTN","PSORREF0",108,0)
 ;
"RTN","PSORREF0",109,0)
STATUS(PSOREA,PSOSTAT,PSORMSG) ;
"RTN","PSORREF0",110,0)
 N DSMSG,PSOA,PSOB,TARGET
"RTN","PSORREF0",111,0)
 S DSMSG=PSORMSG(1)
"RTN","PSORREF0",112,0)
 I PSOREA["A" S DSMSG=DSMSG_" Inactive Drug."
"RTN","PSORREF0",113,0)
 I PSOREA["M" S DSMSG=DSMSG_" Drug no longer used by Outpatient."
"RTN","PSORREF0",114,0)
 I PSOREA["B" S DSMSG=DSMSG_" Narcotic Drug."
"RTN","PSORREF0",115,0)
 I PSOREA["C" S DSMSG=DSMSG_" Non-Renewable Drug."
"RTN","PSORREF0",116,0)
 I PSOREA["D" S DSMSG=DSMSG_" Non-Renewable Patient Status."
"RTN","PSORREF0",117,0)
 I PSOREA["E" S DSMSG=DSMSG_" Non-Verified Rx."
"RTN","PSORREF0",118,0)
 I PSOREA["F" S DSMSG=DSMSG_" Maximum of 26 Renewals."
"RTN","PSORREF0",119,0)
 I PSOREA["G" S DSMSG=DSMSG_" No refills left."
"RTN","PSORREF0",120,0)
 I PSOREA["Z" D
"RTN","PSORREF0",121,0)
 . S:PSOSTAT=4 PSOSTAT=1
"RTN","PSORREF0",122,0)
 . S PSOA=";"_PSOSTAT
"RTN","PSORREF0",123,0)
 . D FIELD^DID(52,100,,"POINTER","TARGET")
"RTN","PSORREF0",124,0)
 . S PSOB=$G(TARGET("POINTER"))
"RTN","PSORREF0",125,0)
 . Q:PSOB=""
"RTN","PSORREF0",126,0)
 . S PSOA=$F(PSOB,PSOA),PSOA=$P($E(PSOB,PSOA,999),";",1)
"RTN","PSORREF0",127,0)
 . S DSMSG=DSMSG_" Rx is in "_$P(PSOA,":",2)_" status."
"RTN","PSORREF0",128,0)
 . K PSOA,PSOB
"RTN","PSORREF0",129,0)
 . Q
"RTN","PSORREF0",130,0)
 S PSORMSG(1)=DSMSG
"RTN","PSORREF0",131,0)
 Q
"RTN","PSORRPA1")
0^2^B80588571^B75343267
"RTN","PSORRPA1",1,0)
PSORRPA1 ;AITC/BWF - remote partial prescriptions ;12/12/16 3:21pm
"RTN","PSORRPA1",2,0)
 ;;7.0;OUTPATIENT PHARMACY;**454,475,497**;DEC 1997;Build 22
"RTN","PSORRPA1",3,0)
 ;
"RTN","PSORRPA1",4,0)
 ;External references L,UL, PSOL, and PSOUL^PSSLOCK supported by DBIA 2789
"RTN","PSORRPA1",5,0)
 ;External reference to ^PSDRUG supported by DBIA 221
"RTN","PSORRPA1",6,0)
 ;External reference to ^DD(52 supported by DBIA 999
"RTN","PSORRPA1",7,0)
 ; bwf - Modified copy of PSORXPA1
"RTN","PSORRPA1",8,0)
 ; bwf - 2/24/14 adding PAR refill tag for API usage.
"RTN","PSORRPA1",9,0)
 ; VALMSG  - return data for remote facility
"RTN","PSORRPA1",10,0)
 ; RXNUM   - rx number
"RTN","PSORRPA1",11,0)
 ; PFDATE  - Partial Fill Date
"RTN","PSORRPA1",12,0)
 ; MW      - Mail or Window
"RTN","PSORRPA1",13,0)
 ; QTY     - Quantity
"RTN","PSORRPA1",14,0)
 ; DSUPP   - Days Supply
"RTN","PSORRPA1",15,0)
 ; REMARKS - Remarks entered by 'remote' (filling) facility.
"RTN","PSORRPA1",16,0)
 ; PHARM   - Remote pharmacist's name
"RTN","PSORRPA1",17,0)
 ; PHONE   - remote pharmacists phone number
"RTN","PSORRPA1",18,0)
 ; SITE    - remote filling site.
"RTN","PSORRPA1",19,0)
 ;
"RTN","PSORRPA1",20,0)
PAR(VALMSG,RXNUM,PFDATE,MW,QTY,DSUPP,REMARKS,PHARM,PHONE,SITE,RX0,RX2,RXSTA,RPR
OV,RSIG,RPAR0,ROR1,RX3,RREF0) ;
"RTN","PSORRPA1",21,0)
 N RRXIEN,PSOPAR,ORN,PSOLST,XTMPLOC,PASSLOC,HFSIEN,FULLPTH,HFSDONE,PTHDAT,PTHPI
ECE,DEL,DELARR,FTGOPEN,FOUND,FTGSTRT,FTGOPEN,STATION,HDRUG
"RTN","PSORRPA1",22,0)
 N PERR,PDIR,PFIL,CSVAL,C,D,E,NEWPFIEN,PFIEN,PFIENS,PSOEXREP,PSOFROM,DINACT,PSO
PHDUZ,PSODFDIR,PSOFNAME,PSOZ1,RREFIEN
"RTN","PSORRPA1",23,0)
 S $ETRAP="D ^%ZTER Q"
"RTN","PSORRPA1",24,0)
 S (RRXIEN,RXN)=$O(^PSRX("B",RXNUM,0)),PSOSIEN=$$GET1^DIQ(52,RRXIEN,20,"I")
"RTN","PSORRPA1",25,0)
 I '$$GET1^DIQ(59.7,1,101,"I") D  Q
"RTN","PSORRPA1",26,0)
 .S VALMSG(1)="The OneVA pharmacy flag is turned 'OFF' at this facility."
"RTN","PSORRPA1",27,0)
 .S VALMSG(2)="Unable to process refill/partial fill requests."
"RTN","PSORRPA1",28,0)
 .D PARFAIL(.VALMSG,RRXIEN,PHARM,PHONE,SITE)
"RTN","PSORRPA1",29,0)
 ; PSO*7*497 - trade name block
"RTN","PSORRPA1",30,0)
 I $$GET1^DIQ(52,RRXIEN,6.5,"E")]"" D  Q
"RTN","PSORRPA1",31,0)
 .D PARFAIL(.VALMSG,RRXIEN,PHARM,PHONE,SITE)
"RTN","PSORRPA1",32,0)
 .S VALMSG(1)="This prescription cannot be refilled or partial filled because i
t has a value"
"RTN","PSORRPA1",33,0)
 .S VALMSG(2)="entered in the Rx trade name field.  Please follow local policy 
for obtaining"
"RTN","PSORRPA1",34,0)
 .S VALMSG(3)="a new prescription."
"RTN","PSORRPA1",35,0)
 ; PSO*7*497 - end trade name block
"RTN","PSORRPA1",36,0)
 S HDRUG=$$GET1^DIQ(52,RRXIEN,6,"I")
"RTN","PSORRPA1",37,0)
 S DINACT=$$GET1^DIQ(50,HDRUG,100,"I")
"RTN","PSORRPA1",38,0)
 I DINACT>0,DINACT<$$NOW^XLFDT S VALMSG(1)="Drug is inactive for Rx# "_RXNUM_".
 Cannot process partial fill." D PARFAIL(.VALMSG,RRXIEN,PHARM,PHONE,SITE) Q
"RTN","PSORRPA1",39,0)
 S CSVAL=$$GET1^DIQ(50,HDRUG,3,"E"),CSVAL=$E(CSVAL,1)
"RTN","PSORRPA1",40,0)
 I CSVAL,CSVAL>0,CSVAL<6 D PARFAIL(.VALMSG,RRXIEN,PHARM,PHONE,SITE) S VALMSG(1)
="Rx #"_RXNUM_" cannot be partially filled. The associated drug is considered a
 controlled substance at the host facility." Q
"RTN","PSORRPA1",41,0)
 I $D(^PSRX(RRXIEN,"ADP",PFDATE,RRXIEN)) S VALMSG(1)="A partial fill already ex
ists for "_$$FMTE^XLFDT(PFDATE,"5D")_".",VALMSG(2)="Partial cannot be processed
" D PARFAIL(.VALMSG,RRXIEN,PHARM,PHONE,SITE) Q
"RTN","PSORRPA1",42,0)
 S PSOPAR=$G(^PS(59,PSOSIEN,1)),PSOSITE=PSOSIEN
"RTN","PSORRPA1",43,0)
 ; set up PSOLST
"RTN","PSORRPA1",44,0)
 S ORN=1,PSOLST(ORN)=52_U_RRXIEN_U_U
"RTN","PSORRPA1",45,0)
 S PSOPHDUZ=$$GET1^DIQ(52,RRXIEN,23,"I") I 'PSOPHDUZ S PSOPHDUZ=.5
"RTN","PSORRPA1",46,0)
 S PSORPDFN=+$P($G(^PSRX($P(PSOLST(ORN),"^",2),0)),"^",2)
"RTN","PSORRPA1",47,0)
 S DA=$P(PSOLST(ORN),"^",2),RX0=^PSRX(DA,0),J=DA,RX2=$G(^(2)),R3=$G(^(3)) S:'$G
(BBFLG) BBRX(1)=""
"RTN","PSORRPA1",48,0)
 N PSORF,PSOTRIC D TRIC^PSORXL1(DA) I PSOTRIC&($$STATUS^PSOBPSUT(DA,PSORF)'["PA
YABLE") D  Q
"RTN","PSORRPA1",49,0)
 . S VALMSG(1)="Partial cannot be filled on Tricare non-payable Rx."
"RTN","PSORRPA1",50,0)
 . D PARFAIL(.VALMSG,RRXIEN,PHARM,PHONE,SITE)
"RTN","PSORRPA1",51,0)
 I +$P($G(^PSRX(DA,2)),"^",6)<DT D
"RTN","PSORRPA1",52,0)
 .S:$P($G(^PSRX(DA,"STA")),"^")<12 $P(^PSRX(DA,"STA"),"^")=11
"RTN","PSORRPA1",53,0)
 .S COMM="Medication Expired on "_$E($P(^PSRX(DA,2),"^",6),4,5)_"/"_$E($P(^(2),
"^",6),6,7)_"/"_$E($P(^(2),"^",6),2,3)
"RTN","PSORRPA1",54,0)
 .S STAT="SC",PHARMST="ZE" D EN^PSOHLSN1(DA,STAT,PHARMST,COMM) K STAT,PHARMST,C
OMM,RX0,J,RX2,R3
"RTN","PSORRPA1",55,0)
 I +^PSRX(DA,"STA"),+^("STA")'=5,+^("STA")'=11 D  K DA D ULK Q
"RTN","PSORRPA1",56,0)
 .S C=";"_+^PSRX(DA,"STA")_":",X=$P(^DD(52,100,0),"^",3),E=$F(X,C),D=$P($E(X,E,
999),";")   ;IA#999
"RTN","PSORRPA1",57,0)
 .S VALMSG(1)="Prescription is in a "_D_" status."
"RTN","PSORRPA1",58,0)
 .D PARFAIL(.VALMSG,RRXIEN,PHARM,PHONE,SITE)
"RTN","PSORRPA1",59,0)
 I $G(PSXSYS),($O(^PS(52.5,"B",DA,""))) S PSOZ1=$O(^PS(52.5,"B",DA,"")) D
"RTN","PSORRPA1",60,0)
 .I $P($G(^PS(52.5,PSOZ1,0)),"^",7)="Q"!($P($G(^(0)),"^",7)="L") D
"RTN","PSORRPA1",61,0)
 ..S VALMSG(1)="A partial entered for this Rx cannot be suspended."
"RTN","PSORRPA1",62,0)
 ..S VALMSG(2)="A fill for this Rx is already suspended for CMOP transmission."
"RTN","PSORRPA1",63,0)
 ..S VALMSG(3)="You may pull this fill from suspense or enter a partial and pri
nt the label."
"RTN","PSORRPA1",64,0)
 ..D PARFAIL(.VALMSG,RRXIEN,PHARM,PHONE,SITE)
"RTN","PSORRPA1",65,0)
CLC S PSOCLC=PSOPHDUZ,PHYS=$P(^PSRX(DA,0),"^",4),DRG=$P(^(0),"^",6)
"RTN","PSORRPA1",66,0)
 I 'PHYS,$O(^PSRX(DA,1,0)) F I=0:0 S I=$O(^PSRX(DA,1,I)) Q:'I  S PHYS=$S($P(^PS
RX(DA,1,I,0),"^",17):$P(^PSRX(DA,1,I,0),"^",17),1:PHYS)
"RTN","PSORRPA1",67,0)
 S PSOPRZ=0 I $O(^PSRX(DA,"P",0)) N Z2 F Z2=0:0 S Z2=$O(^PSRX(DA,"P",Z2)) Q:'Z2
  S PSOPRZ=Z2
"RTN","PSORRPA1",68,0)
 I $D(RXPR(DA)),'$D(^PSRX(DA,"P",$G(RXPR(DA)))) D RMP^PSOCAN3
"RTN","PSORRPA1",69,0)
 ; bwf - save information into database, just as it would be through ^DIE
"RTN","PSORRPA1",70,0)
 S FDA(52.2,"+1,"_RRXIEN_",",.01)=PFDATE D UPDATE^DIE(,"FDA","NEWPFIEN","PERR")
 K FDA
"RTN","PSORRPA1",71,0)
 I $D(PERR) M VALMSG=PERR
"RTN","PSORRPA1",72,0)
 S PFIEN=$O(NEWPFIEN(0)),PFIEN=$G(NEWPFIEN(PFIEN))
"RTN","PSORRPA1",73,0)
 ; set Z1 variable as was done in the ^DIE call for later use.
"RTN","PSORRPA1",74,0)
 S Z1=PFIEN
"RTN","PSORRPA1",75,0)
 S PFIENS=PFIEN_","_RRXIEN_","
"RTN","PSORRPA1",76,0)
 ; set PM variable as was done in the ^DIE call for later use.
"RTN","PSORRPA1",77,0)
 I MW="M"!('$P($G(PSOPAR),U,12)) S PM=1
"RTN","PSORRPA1",78,0)
 S FDA(52.2,PFIENS,.02)=MW
"RTN","PSORRPA1",79,0)
 S FDA(52.2,PFIENS,.04)=QTY
"RTN","PSORRPA1",80,0)
 S FDA(52.2,PFIENS,.041)=DSUPP
"RTN","PSORRPA1",81,0)
 ; currently we have no local pharmacist. May need to add entry to file 200 for
 'REMOTE,PHARMACIST' or 'PHARMACIST,REMOTE'
"RTN","PSORRPA1",82,0)
 S FDA(52.2,PFIENS,.05)=PSOPHDUZ
"RTN","PSORRPA1",83,0)
 ; can we use DUZ as the clerk code, or will this need another value??
"RTN","PSORRPA1",84,0)
 S FDA(52.2,PFIENS,.07)=PSOPHDUZ
"RTN","PSORRPA1",85,0)
 S FDA(52.2,PFIENS,6)=PHYS
"RTN","PSORRPA1",86,0)
 S FDA(52.2,PFIENS,.08)=$$NOW^XLFDT
"RTN","PSORRPA1",87,0)
 S FDA(52.2,PFIENS,.09)=PSOSITE
"RTN","PSORRPA1",88,0)
 S FDA(52.2,PFIENS,.03)=REMARKS
"RTN","PSORRPA1",89,0)
 ;
"RTN","PSORRPA1",90,0)
 ; setting the partial fill date to the dispense date to match the 
"RTN","PSORRPA1",91,0)
 ; HL7 response
"RTN","PSORRPA1",92,0)
 S FDA(52.2,PFIENS,7.5)=PFDATE
"RTN","PSORRPA1",93,0)
 ;
"RTN","PSORRPA1",94,0)
 S RXPR(RRXIEN)=PFIEN,PSOZZ=1,PRMK=REMARKS
"RTN","PSORRPA1",95,0)
 ; file the rest of the data onto the newly created multiple.
"RTN","PSORRPA1",96,0)
 D FILE^DIE(,"FDA") K FDA
"RTN","PSORRPA1",97,0)
 I Z1,$G(PRMK)]"" D  D:$T(EN^PSOHDR)]"" EN^PSOHDR("PPAR",RXN) K DIE,RXN,RXF
"RTN","PSORRPA1",98,0)
 .D ACT
"RTN","PSORRPA1",99,0)
 .S ZD(RXN)=+^PSRX(RXN,"P",Z1,0),^PSRX(RXN,"TYPE")=Z1,$P(^PSRX(RXN,"P",Z1,0),"^
",11)=$P($G(^PSDRUG(DRG,660)),"^",6)
"RTN","PSORRPA1",100,0)
 S:'$D(PSOFROM) PSOFROM="PARTIAL" S BINGCRT=1 ;D:$D(BINGRTE)&($D(DISGROUP)) ^PS
OBING1 K BINGRTE,TM,TM1
"RTN","PSORRPA1",101,0)
 ; bwf 8/14/14 - set up needed variables for label printing
"RTN","PSORRPA1",102,0)
 S PSODFN=$P(^PSRX(RRXIEN,0),U,2)
"RTN","PSORRPA1",103,0)
 S PSORX("PSOL",1)=RRXIEN_","
"RTN","PSORRPA1",104,0)
 S PSORX("MAIL/WINDOW")="WINDOW"
"RTN","PSORRPA1",105,0)
 S PSORX("NAME")=$$GET1^DIQ(2,PSODFN,.01)
"RTN","PSORRPA1",106,0)
 S PSORX("QFLG")=0
"RTN","PSORRPA1",107,0)
 S PSORX("METHOD OF PICKUP")=""
"RTN","PSORRPA1",108,0)
 S PSOX=$G(^PS(55,PSODFN,"PS")) I PSOX]"" S PSORX("PATIENT STATUS")=$P($G(^PS(5
3,PSOX,0)),"^")
"RTN","PSORRPA1",109,0)
 N PPL1
"RTN","PSORRPA1",110,0)
 S PPL1=RRXIEN
"RTN","PSORRPA1",111,0)
 S HFSDONE=0,PTHDAT=""
"RTN","PSORRPA1",112,0)
 S PSODFDIR=$$DEFDIR^%ZISH()
"RTN","PSORRPA1",113,0)
 S PSOFNAME="PSOLBL_"_RXNUM_"_"_PSOSITE_"_"_DT_".DAT"
"RTN","PSORRPA1",114,0)
 S FULLPTH=PSODFDIR_PSOFNAME
"RTN","PSORRPA1",115,0)
 ; bwf 8/14/14 - end setup for label printing.
"RTN","PSORRPA1",116,0)
 ; preserve IO
"RTN","PSORRPA1",117,0)
 D SAVDEV^%ZISUTL("ONEVAHLIO")
"RTN","PSORRPA1",118,0)
 ; delete the file first to ensure there isn't one lingering around
"RTN","PSORRPA1",119,0)
 S DELARR("PSOLBL_"_RXNUM_"_"_PSOSITE_"_"_DT_".DAT")="" S DEL=$$DEL^%ZISH(PSODF
DIR,$NA(DELARR))
"RTN","PSORRPA1",120,0)
 S PSOEXREP=1
"RTN","PSORRPA1",121,0)
 ; call out to generate label
"RTN","PSORRPA1",122,0)
 D LABEL^PSORWRAP(RRXIEN,"HFS",PSOSITE,PSOPHDUZ,"",PSOFNAME)
"RTN","PSORRPA1",123,0)
 S XTMPLOC="^XTMP(""PSORLBL"","_HLINSTN_","_+RXNUM_",1,0)"
"RTN","PSORRPA1",124,0)
 S PASSLOC="XTMP(""PSORLBL"","_HLINSTN_","_+RXNUM_")"
"RTN","PSORRPA1",125,0)
 K ^XTMP("PSORLBL",HLINSTN,+RXNUM)
"RTN","PSORRPA1",126,0)
 S ^XTMP("PSORLBL",HLINSTN,+RXNUM,0)=DT_U_$$FMADD^XLFDT(DT,30)
"RTN","PSORRPA1",127,0)
 ; looks like we have to wait a moment before the file shows up.
"RTN","PSORRPA1",128,0)
 S FTGSTRT=$$NOW^XLFDT,(FOUND,FTGOPEN)=0
"RTN","PSORRPA1",129,0)
 N PAR S PAR=0
"RTN","PSORRPA1",130,0)
 F  D  Q:$$NOW^XLFDT>$$FMADD^XLFDT(FTGSTRT,,,,15)!(FOUND)!(FTGOPEN)
"RTN","PSORRPA1",131,0)
 .S FTGOPEN=$$FTG^%ZISH(PSODFDIR,PSOFNAME,XTMPLOC,4)
"RTN","PSORRPA1",132,0)
 .I $O(^XTMP("PSORLBL",HLINSTN,+RXNUM,0)) S FOUND=1
"RTN","PSORRPA1",133,0)
 S DELARR("PSOLBL_"_RXNUM_"_"_PSOSITE_"_"_DT_".DAT")="" S DEL=$$DEL^%ZISH(PSODF
DIR,$NA(DELARR))
"RTN","PSORRPA1",134,0)
 ; restore IO
"RTN","PSORRPA1",135,0)
 D USE^%ZISUTL("ONEVAHLIO"),RMDEV^%ZISUTL("ONEVAHLIO")
"RTN","PSORRPA1",136,0)
 D UPDPAR(.VALMSG,RRXIEN,PHARM,PHONE,SITE,PASSLOC)
"RTN","PSORRPA1",137,0)
 S RX0=$G(^PSRX(RRXIEN,0)),RX2=$G(^PSRX(RRXIEN,2)),RX3=$G(^PSRX(RRXIEN,3))
"RTN","PSORRPA1",138,0)
 S RXSTA=$G(^PSRX(RRXIEN,"STA")),RPROV=$$GET1^DIQ(200,$P(RX0,U,4),.01,"E")_U_$$
GET1^DIQ(200,$P(RX0,U,16),.01,"E")
"RTN","PSORRPA1",139,0)
 S RSIG=$G(^PSRX(RRXIEN,"SIG"))
"RTN","PSORRPA1",140,0)
 S RPAR0=$G(^PSRX(RRXIEN,"P",PFIEN,0))
"RTN","PSORRPA1",141,0)
 S ROR1=$G(^PSRX(RRXIEN,"OR1"))
"RTN","PSORRPA1",142,0)
 S RREFIEN=$O(^PSRX(RRXIEN,1,"A"),-1)
"RTN","PSORRPA1",143,0)
 I RREFIEN S RREF0=$G(^PSRX(RRXIEN,1,RREFIEN,0))
"RTN","PSORRPA1",144,0)
CLCX D ULK K DR,DIE,DRG,PPL,RXP,IOP,DA,PHYS,PSOPRZ,PSORX,PSOSIEN,PSOSITE,PSOX,P
SOZZ,PSXSYS,RXPR,ZD Q
"RTN","PSORRPA1",145,0)
 ;
"RTN","PSORRPA1",146,0)
KILL S DA=Z1,DIK="^PSRX("_RXN_",""P""," D ^DIK S ^PSRX(RXN,"TYPE")=0
"RTN","PSORRPA1",147,0)
 D ULK S VALMSG(1)="No Partial Fill Dispensed" D PARFAIL(.VALMSG,RRXIEN,PHARM,P
HONE,SITE) Q
"RTN","PSORRPA1",148,0)
KL K DFN,RFDAT,RLL,%,PRMK,PM,%Y,%X,D0,D1,DA,DI,DIC,DIE,DLAYGO,DQ,DR,I,II,J,JJJ,
N,PHYS,PS,PSDATE,RFL,RFL1,RXF,ST,ST0,Z,Z1,X,Y,PDT,PSL,PSNP
"RTN","PSORRPA1",149,0)
 K PSOM,PSOP,PSOD,PSOU,DIK,DUOUT,IFN,RXN,DRG,HRX,I1,PSOCLC,PSOLIST,PSOLST,PSPAR
,RXP D KVA^VADPT Q
"RTN","PSORRPA1",150,0)
ACT ;adds activity info for partial rx
"RTN","PSORRPA1",151,0)
 S RXF=0 F I=0:0 S I=$O(^PSRX(RRXIEN,1,I)) Q:'I  S RXF=I S:I>5 RXF=I+1
"RTN","PSORRPA1",152,0)
 S DA=0 F FDA=0:0 S FDA=$O(^PSRX(RRXIEN,"A",FDA)) Q:'FDA  S DA=FDA
"RTN","PSORRPA1",153,0)
 S DA=DA+1,^PSRX(RRXIEN,"A",0)="^52.3DA^"_DA_"^"_DA,^PSRX(RRXIEN,"A",DA,0)=DT_"
^"_"P"_"^"_PSOPHDUZ_"^"_RXF_"^"_PRMK
"RTN","PSORRPA1",154,0)
EX K RXF,I,FDA S DA=RXN
"RTN","PSORRPA1",155,0)
 Q
"RTN","PSORRPA1",156,0)
ULK ;
"RTN","PSORRPA1",157,0)
 K PSOMSG,PSOPLCK,PSORPDFN
"RTN","PSORRPA1",158,0)
 Q
"RTN","PSORRPA1",159,0)
PARFAIL(PSOMSG,PSOIEN,RPHARM,RPHONE,RSITE) ;
"RTN","PSORRPA1",160,0)
 S PSOMSG(0)=0_U_$$GET1^DIQ(52,PSOIEN,.01,"I")_U_PSOIEN,$P(PSOMSG(0),U,15)=RPHA
RM,$P(PSOMSG(0),U,16)=RPHONE,$P(PSOMSG(0),U,17)=RSITE
"RTN","PSORRPA1",161,0)
 Q
"RTN","PSORRPA1",162,0)
UPDPAR(PSOMSG,PSOIEN,RPHARM,RPHONE,RSITE,PASSLOC) ;
"RTN","PSORRPA1",163,0)
 N PARIEN,PARIENS,PARDATA,FIL,RXNUM,RFILLDT,QTY,DSUPP,CLERK,LOGDATE,IDIV,EDIV,D
ISPDT,NDC,FDA,DNAME,DIEN
"RTN","PSORRPA1",164,0)
 S FIL=52.2
"RTN","PSORRPA1",165,0)
 ; get last partial data node
"RTN","PSORRPA1",166,0)
 S PARIEN=$O(^PSRX(PSOIEN,"P",""),-1)
"RTN","PSORRPA1",167,0)
 S RXNUM=$$GET1^DIQ(52,PSOIEN,.01,"E")
"RTN","PSORRPA1",168,0)
 S DNAME=$$GET1^DIQ(52,PSOIEN,6,"E")
"RTN","PSORRPA1",169,0)
 S DIEN=$$GET1^DIQ(52,PSOIEN,6,"I")
"RTN","PSORRPA1",170,0)
 S PARIENS=PARIEN_","_PSOIEN_","
"RTN","PSORRPA1",171,0)
 ; first, set in the remote pharmacist data
"RTN","PSORRPA1",172,0)
 S FDA(52.2,PARIENS,91)=RSITE
"RTN","PSORRPA1",173,0)
 S FDA(52.2,PARIENS,92)=RPHARM
"RTN","PSORRPA1",174,0)
 S FDA(52.2,PARIENS,93)=RPHONE
"RTN","PSORRPA1",175,0)
 D FILE^DIE(,"FDA","MSG") K FDA,RPHARM,RPHONE,RSITE
"RTN","PSORRPA1",176,0)
 ; now query data and build RET(0) holding accurate information from the refill
 multiple
"RTN","PSORRPA1",177,0)
 D GETS^DIQ(FIL,PARIENS,"**","IE","PARDATA")
"RTN","PSORRPA1",178,0)
 S RFILLDT=$G(PARDATA(FIL,PARIENS,.01,"I"))
"RTN","PSORRPA1",179,0)
 S QTY=$G(PARDATA(FIL,PARIENS,.04,"I"))
"RTN","PSORRPA1",180,0)
 S DSUPP=$G(PARDATA(FIL,PARIENS,.041,"I"))
"RTN","PSORRPA1",181,0)
 S CLERK=$G(PARDATA(FIL,PARIENS,.07,"E"))
"RTN","PSORRPA1",182,0)
 S LOGDATE=$G(PARDATA(FIL,PARIENS,.08,"I"))
"RTN","PSORRPA1",183,0)
 ; internal division number (IEN to PSO SITE file)
"RTN","PSORRPA1",184,0)
 S IDIV=$G(PARDATA(FIL,PARIENS,.09,"I"))
"RTN","PSORRPA1",185,0)
 S EDIV=$G(PARDATA(FIL,PARIENS,.09,"E"))
"RTN","PSORRPA1",186,0)
 ;
"RTN","PSORRPA1",187,0)
 ; there is nothing in this field.
"RTN","PSORRPA1",188,0)
 ; HL7 is returning refill date in the RXD
"RTN","PSORRPA1",189,0)
 ; but trying to log the blank dispense date from file 52.2 into 52.09
"RTN","PSORRPA1",190,0)
 S DISPDT=$G(PARDATA(FIL,PARIENS,7.5,"I"))
"RTN","PSORRPA1",191,0)
 ;
"RTN","PSORRPA1",192,0)
 S NDC=$G(PARDATA(FIL,PARIENS,1,"E"))
"RTN","PSORRPA1",193,0)
 S RSITE=$G(PARDATA(FIL,PARIENS,91,"I"))
"RTN","PSORRPA1",194,0)
 S RPHARM=$G(PARDATA(FIL,PARIENS,92,"E"))
"RTN","PSORRPA1",195,0)
 S RPHONE=$G(PARDATA(FIL,PARIENS,93,"E"))
"RTN","PSORRPA1",196,0)
 S $P(DAT(1),U,3)=RXNUM,$P(DAT(1),U,4)=RSITE,$P(DAT(1),U,7)=QTY,$P(DAT(1),U,8)=
DISPDT,$P(DAT(1),U,9)=DNAME,$P(DAT(1),U,10)=DSUPP,$P(DAT(1),U,11)=RPHARM,$P(DAT
(1),U,12)=RFILLDT
"RTN","PSORRPA1",197,0)
 D LOGDATA^PSORWRAP($NA(DAT),"OP",,,PSOIEN)
"RTN","PSORRPA1",198,0)
 S PSOMSG(0)=1_U_RXNUM_U_PSOIEN_U_PARIEN_U_RFILLDT_U_DNAME_U_QTY_U_DSUPP_U_CLER
K_U_LOGDATE_U_IDIV_U_EDIV_U_DISPDT_U_NDC_U_RPHARM_U_RPHONE_U_RSITE_U_PASSLOC
"RTN","PSORRPA1",199,0)
 I '$L($G(PSOMSG(1))) S PSOMSG(1)="Partial complete for RX #"_RXNUM_"."
"RTN","PSORRPA1",200,0)
 Q
"RTN","PSORRX2")
0^6^B35129325^B34725424
"RTN","PSORRX2",1,0)
PSORRX2 ;AITC/BWF - Remote RX driver ;8/30/16 12:00am
"RTN","PSORRX2",2,0)
 ;;7.0;OUTPATIENT PHARMACY;**454,479,497**;DEC 1997;Build 22
"RTN","PSORRX2",3,0)
 ;
"RTN","PSORRX2",4,0)
 Q
"RTN","PSORRX2",5,0)
 ; read response from refill site
"RTN","PSORRX2",6,0)
READMSG(HLDAT,TYPE,LOCDRUG) ;
"RTN","PSORRX2",7,0)
 N ORFS,ORCS,ORRS,ORES,ORSS,HLQUIT,ORQUIT,OREMSG1,OREMSG2,ORSMSG,ORSMSG,GBLLOC,
LBLOOP,LBTXT,LBLOVF,DIR,ORERR,MSGDONE,MSGCNT,MSGTXT
"RTN","PSORRX2",8,0)
 S ORFS=$G(HL("FS")),ORCS=$E($G(HL("ECH")),1),ORRS=$E($G(HL("ECH")),2),ORES=$E(
$G(HL("ECH")),3),ORSS=$E($G(HL("ECH")),4)
"RTN","PSORRX2",9,0)
 S TYPE=$G(TYPE,"")
"RTN","PSORRX2",10,0)
 S HLQUIT=0,ORQUIT="",OREMSG1="",OREMSG2="",ORERR=""
"RTN","PSORRX2",11,0)
 F  X HLNEXT Q:HLQUIT'>0!(ORQUIT'="")  D
"RTN","PSORRX2",12,0)
 .N LOOP
"RTN","PSORRX2",13,0)
 .S LOOP=0 F  S LOOP=$O(HLNODE(LOOP)) Q:LOOP=""  S HLNODE=HLNODE_HLNODE(LOOP)
"RTN","PSORRX2",14,0)
 .I $E(HLNODE,1,3)="MSA"&($P(HLNODE,ORFS,2)'="AA") S ORERR=$P(HLNODE,ORFS,4)
"RTN","PSORRX2",15,0)
 .I $E(HLNODE,1,3)="ERR" S OREMSG1=$P(HLNODE,ORFS,9)
"RTN","PSORRX2",16,0)
 .I $E(HLNODE,1,3)="NTE" D
"RTN","PSORRX2",17,0)
 ..D REFNTE(.HLNODE,.HLDAT)
"RTN","PSORRX2",18,0)
 ..S ORSMSG=$P(@HLDAT@(1),ORFS)
"RTN","PSORRX2",19,0)
 .I $E(HLNODE,1,3)="PID" D
"RTN","PSORRX2",20,0)
 ..S @HLDAT@(0)=$$FMADD^XLFDT($$NOW^XLFDT,2)_U_$$NOW^XLFDT
"RTN","PSORRX2",21,0)
 ..D REFPID(.HLNODE,.HLDAT)
"RTN","PSORRX2",22,0)
 .I $E(HLNODE,1,3)="ORC" D
"RTN","PSORRX2",23,0)
 ..D REFORC(.HLNODE,.HLDAT,TYPE)
"RTN","PSORRX2",24,0)
 .I $E(HLNODE,1,3)="RXD" D
"RTN","PSORRX2",25,0)
 ..D REFRXD(.HLNODE,.HLDAT,TYPE)
"RTN","PSORRX2",26,0)
 I '$L(ORERR),'$L(OREMSG1) D
"RTN","PSORRX2",27,0)
 .I '$D(@HLDAT) S ORERR="No data was returned from the target vista." Q
"RTN","PSORRX2",28,0)
 .W !!,"TRANSACTION SUCCESSFUL...  The "_$S($G(PRXNUM):"partial ",1:"refill ")_
"for RX #"_RRXNUM_" has been recorded on"
"RTN","PSORRX2",29,0)
 .W !,"the prescription at the host system."
"RTN","PSORRX2",30,0)
 .W !!,"Select a printer to generate the label or '^' to bypass printing.",!
"RTN","PSORRX2",31,0)
 .D LOGDATA^PSORWRAP(.HLDAT,TYPE,LOCDRUG,"")
"RTN","PSORRX2",32,0)
 I $L(ORERR) D
"RTN","PSORRX2",33,0)
 . K PSORRBLD  ; no need to rebuild worklist
"RTN","PSORRX2",34,0)
 . I ORERR="Invalid Receiving Application" S ORERR="OneVA software not installe
d at host site"  ; This error is returned if patch is not installed at remote/h
ost site.  Making it more user friendly.
"RTN","PSORRX2",35,0)
 . W !!,ORERR
"RTN","PSORRX2",36,0)
 . S DIR(0)="FO",DIR("A")="Press RETURN to continue"
"RTN","PSORRX2",37,0)
 . D ^DIR
"RTN","PSORRX2",38,0)
 I OREMSG1'="" D
"RTN","PSORRX2",39,0)
 . K PSORRBLD  ; no need to rebuild worklist
"RTN","PSORRX2",40,0)
 . W !!,OREMSG1_". "_$S($L(OREMSG2):OREMSG2_".",1:""),!
"RTN","PSORRX2",41,0)
 . I '$D(ORSMSG) S DIR(0)="FO",DIR("A")="Press RETURN to continue" D ^DIR
"RTN","PSORRX2",42,0)
 I $D(ORSMSG) D
"RTN","PSORRX2",43,0)
 .S MSGDONE=0
"RTN","PSORRX2",44,0)
 .F MSGCNT=1:1 D  Q:MSGDONE
"RTN","PSORRX2",45,0)
 ..S MSGTXT=$P(ORSMSG,"|",MSGCNT) I MSGTXT']"" S MSGDONE=1 Q
"RTN","PSORRX2",46,0)
 ..W !,MSGTXT
"RTN","PSORRX2",47,0)
 .S DIR(0)="FO",DIR("A")="Press RETURN to continue" D ^DIR
"RTN","PSORRX2",48,0)
 Q
"RTN","PSORRX2",49,0)
 ; HLDAT(1)=MESSAGE^PATIENT DFN^RX NUMBER^REMOTE SITE#^FILL/PARTIAL DATE^PHARMA
CIST NAME^QUANTITY^DISPENSE DATE^DRUG NAME^DAYS SUPPLY
"RTN","PSORRX2",50,0)
REFNTE(DATA,HLDAT) ;
"RTN","PSORRX2",51,0)
 ; Message details
"RTN","PSORRX2",52,0)
 N NTETYP,NTETEXT,NTETYPE
"RTN","PSORRX2",53,0)
 S NTETYPE=$P(DATA,ORFS,3)
"RTN","PSORRX2",54,0)
 S NTETEXT=$P(DATA,ORFS,4)
"RTN","PSORRX2",55,0)
 I NTETYPE="L" D
"RTN","PSORRX2",56,0)
 .I $L($P($G(@HLDAT@(1)),U)) S $P(@HLDAT@(1),U)=$P($G(@HLDAT@(1)),U)_"|"_NTETEX
T Q
"RTN","PSORRX2",57,0)
 .S $P(@HLDAT@(1),U)=NTETEXT
"RTN","PSORRX2",58,0)
 I NTETYPE="O" D
"RTN","PSORRX2",59,0)
 .S @HLDAT@("LBL",$O(@HLDAT@("LBL",""),-1)+1)=NTETEXT
"RTN","PSORRX2",60,0)
 Q
"RTN","PSORRX2",61,0)
 ;
"RTN","PSORRX2",62,0)
REFPID(DATA,HLDAT) ;
"RTN","PSORRX2",63,0)
 ; patient IEN from remote site
"RTN","PSORRX2",64,0)
 S $P(@HLDAT@(1),U,2)=$P($P($P(DATA,ORFS,4),ORCS,11),ORRS,2)
"RTN","PSORRX2",65,0)
 Q
"RTN","PSORRX2",66,0)
 ;
"RTN","PSORRX2",67,0)
REFORC(DATA,HLDAT,TYPE) ;
"RTN","PSORRX2",68,0)
 N RXNUM,RXSITE,RXDATE,PHARMLN,PHARMFN,REQSITE,PHONE,PHNAME,PNAME,RPDATE,RPROV
"RTN","PSORRX2",69,0)
 S RXNUM=$P($P(DATA,ORFS,3),ORCS)
"RTN","PSORRX2",70,0)
 S RXSITE=$P($P(DATA,ORFS,14),ORCS,4)
"RTN","PSORRX2",71,0)
 S RPDATE=$P(DATA,ORFS,10)
"RTN","PSORRX2",72,0)
 S RPROV=$P(DATA,ORFS,12)
"RTN","PSORRX2",73,0)
 S PHNAME=$P(DATA,ORFS,11)
"RTN","PSORRX2",74,0)
 S $P(@HLDAT@(1),U,3)=RXNUM
"RTN","PSORRX2",75,0)
 S $P(@HLDAT@(1),U,4)=RXSITE
"RTN","PSORRX2",76,0)
 S $P(@HLDAT@(1),U,5)=RPDATE
"RTN","PSORRX2",77,0)
 S $P(@HLDAT@(1),U,6)=PHNAME
"RTN","PSORRX2",78,0)
 S $P(@HLDAT@("RX0"),U)=RXNUM,$P(@HLDAT@("RX0"),U,2)=DFN,$P(@HLDAT@("RX0"),U,5)
=$P($P($P(DATA,ORFS,22),ORCS,8),ORSS,2),$P(@HLDAT@("RX0"),U,6)=LOCDRUG
Subj: PSO*7*497 TEST v1  [#86147425]   Page 3
-------------------------------------------------------------------------------
"RTN","PSORRX2",79,0)
 S $P(@HLDAT@("RX0"),U,4)=$P($P($P(DATA,ORFS,20),ORRS,1),ORCS,2)
"RTN","PSORRX2",80,0)
 S $P(@HLDAT@("RX0"),U,13)=$P(DATA,ORFS,16),$P(@HLDAT@("RX0"),U,19)=""
"RTN","PSORRX2",81,0)
 ; dont forget copies in p18, if needed
"RTN","PSORRX2",82,0)
 S $P(@HLDAT@("RX2"),U,2)=RPDATE,$P(@HLDAT@("RX2"),U,10)=$P($P($P(DATA,ORFS,20)
,ORRS,2),ORCS,2)
"RTN","PSORRX2",83,0)
 S $P(@HLDAT@("RX3"),U)=$P(DATA,ORFS,28)
"RTN","PSORRX2",84,0)
 I TYPE="RF" D
"RTN","PSORRX2",85,0)
 .S $P(@HLDAT@("RREF0"),U)=RPDATE,$P(@HLDAT@("RREF0"),U,2)="W",$P(@HLDAT@("RREF
0"),U,7)=$P($P($P(DATA,ORFS,20),ORRS,3),ORCS,2)
"RTN","PSORRX2",86,0)
 .S $P(@HLDAT@("RREF0"),U,17)=$P($P($P(DATA,ORFS,20),ORRS,4),ORCS,2)
"RTN","PSORRX2",87,0)
 I TYPE="PR" D
"RTN","PSORRX2",88,0)
 .S $P(@HLDAT@("RPAR0"),U)=RPDATE,$P(@HLDAT@("RPAR0"),U,2)="W",$P(@HLDAT@("RPAR
0"),U,7)=$P($P($P(DATA,ORFS,20),ORRS,3),ORCS,2)
"RTN","PSORRX2",89,0)
 .S $P(@HLDAT@("RPAR0"),U,17)=$P($P($P(DATA,ORFS,20),ORRS,4),ORCS,2)
"RTN","PSORRX2",90,0)
 S $P(@HLDAT@("ROR1"),U,5)=$P($P($P(DATA,ORFS,20),ORRS,5),ORCS,2)
"RTN","PSORRX2",91,0)
 S @HLDAT@("RXSTA")=$P($P(DATA,ORFS,26),ORCS),@HLDAT@("RXSTA2")=$P($P(DATA,ORFS
,26),ORCS,2)
"RTN","PSORRX2",92,0)
 S @HLDAT@("PATST")=$P($P(DATA,ORFS,26),ORCS,4)
"RTN","PSORRX2",93,0)
 ; HOST INFO
"RTN","PSORRX2",94,0)
 ; P1 - NAME, P2 - ADDRESS~~CITY~STATE~ZIP, P3 - PHONE NUMBER, P4 - HOST SITE N
UMBER
"RTN","PSORRX2",95,0)
 S $P(DATA,ORFS,23)=$P($P(DATA,ORFS,23),ORSS)_ORSS_$P($P(DATA,ORFS,23),ORSS,3,5
)
"RTN","PSORRX2",96,0)
 S @HLDAT@("HINFO")=$P($P(DATA,ORFS,22),ORCS)_U_$P(DATA,ORFS,23)_U_$P(DATA,ORFS
,24)
"RTN","PSORRX2",97,0)
 S $P(@HLDAT@("HINFO"),U,4)=RXSITE
"RTN","PSORRX2",98,0)
 S $P(@HLDAT@("HINFO"),U,5)=$P($P($P(DATA,ORFS,22),ORCS,8),ORSS,2)  ;Clinic
"RTN","PSORRX2",99,0)
 Q
"RTN","PSORRX2",100,0)
REFRXD(DATA,HLDAT,TYPE)  ;
"RTN","PSORRX2",101,0)
 N QTY,DSUPP,DNAME,HINFO,SIG1D,SIGDAT,SIGNUM,SIGTXT,I
"RTN","PSORRX2",102,0)
 S ($P(@HLDAT@(1),U,7),$P(@HLDAT@("RX0"),U,7))=$P(DATA,ORFS,5)  ; quantity
"RTN","PSORRX2",103,0)
 S $P(@HLDAT@(1),U,8)=$P(DATA,ORFS,4) ; dispense date
"RTN","PSORRX2",104,0)
 S $P(@HLDAT@(1),U,9)=$P($P(DATA,ORFS,3),ORCS,1) ; drug name
"RTN","PSORRX2",105,0)
 S ($P(@HLDAT@(1),U,10),$P(@HLDAT@("RX0"),U,8))=$P(DATA,ORFS,13) ; days supply
"RTN","PSORRX2",106,0)
 S $P(@HLDAT@("RX0"),U,9)=$P(DATA,ORFS,9),$P(@HLDAT@("RX0"),U,11)="W"
"RTN","PSORRX2",107,0)
 S $P(@HLDAT@("RX0"),U,18)=$P(DATA,ORFS,23)  ; Copies
"RTN","PSORRX2",108,0)
 S $P(@HLDAT@("RX2"),U,6)=$P(DATA,ORFS,20)  ; Rx Expiration Date 
"RTN","PSORRX2",109,0)
 ;
"RTN","PSORRX2",110,0)
 I TYPE="RF" D
"RTN","PSORRX2",111,0)
 .S $P(@HLDAT@("RREF0"),U,4)=$P(DATA,ORFS,5),$P(@HLDAT@("RREF0"),U,10)=$P(DATA,
ORFS,13)
"RTN","PSORRX2",112,0)
 .S @HLDAT@("RFIEN")=$P($P(DATA,ORFS,8),":",3)
"RTN","PSORRX2",113,0)
 I TYPE="PR" D
"RTN","PSORRX2",114,0)
 .S $P(@HLDAT@("RPAR0"),U,4)=$P(DATA,ORFS,5),$P(@HLDAT@("RPAR0"),U,10)=$P(DATA,
ORFS,13)
"RTN","PSORRX2",115,0)
 .S @HLDAT@("PARIEN")=$P($P(DATA,ORFS,8),":",3)
"RTN","PSORRX2",116,0)
 ;
"RTN","PSORRX2",117,0)
 S @HLDAT@("RSIG")=$P($P($P(DATA,ORFS,16),ORRS,1),ORCS,2)_U_$P($P($P(DATA,ORFS,
16),ORRS,1),ORCS)
"RTN","PSORRX2",118,0)
 S @HLDAT@("RIEN")=$P($P(DATA,ORFS,8),":")
"RTN","PSORRX2",119,0)
 ;I '$P($G(@HLDAT@("RSIG")),U,2) Q
"RTN","PSORRX2",120,0)
 S SIG1D=0
"RTN","PSORRX2",121,0)
 F I=2:1 D  Q:SIG1D
"RTN","PSORRX2",122,0)
 .S SIGDAT=$P($P(DATA,ORFS,16),ORRS,I) I SIGDAT']"" S SIG1D=1 Q
"RTN","PSORRX2",123,0)
 .S SIGNUM=$P(SIGDAT,ORCS),SIGNUM=$P(SIGNUM,"_",2),SIGTXT=$P(SIGDAT,ORCS,2) Q:'
SIGNUM
"RTN","PSORRX2",124,0)
 .S @HLDAT@("RSIG1",SIGNUM)=SIGTXT
"RTN","PSORRX2",125,0)
 Q
"RTN","PSORRX2",126,0)
PSORPH(DUZ) ;
"RTN","PSORRX2",127,0)
 I $D(^XUSEC("PSORPH",DUZ)) Q 1
"RTN","PSORRX2",128,0)
 Q 0
"RTN","PSORX1")
0^5^B82991230^B83034701
"RTN","PSORX1",1,0)
PSORX1 ;BIR/SAB-medication processing driver ;8/17/16 5:10pm
"RTN","PSORX1",2,0)
 ;;7.0;OUTPATIENT PHARMACY;**7,22,23,57,62,46,74,71,90,95,115,117,146,139,135,1
82,195,233,268,300,170,320,326,324,334,251,454,488,497**;DEC 1997;Build 22
"RTN","PSORX1",3,0)
 ;
"RTN","PSORX1",4,0)
 ;External reference ^PS(55 supported by DBIA 2228
"RTN","PSORX1",5,0)
 ;External reference ^DIC(31 supported by DBIA 658
"RTN","PSORX1",6,0)
 ;External reference ^DPT(D0,.372 supported by DBIA 1476
"RTN","PSORX1",7,0)
 ;External reference DISPPRF^DGPFAPI supported by DBIA #4563
"RTN","PSORX1",8,0)
 ;External reference ^ORRDI1 is supported by DBIA 4659
"RTN","PSORX1",9,0)
 ;External reference ^XTMP("ORRDI" is supported by DBIA 4660
"RTN","PSORX1",10,0)
 ;External reference ^PSUHL supported by DBIA 4803
"RTN","PSORX1",11,0)
 ;
"RTN","PSORX1",12,0)
 ;PSO*195 add call to display Patient Record Flag (DISPPRF^DGPFAPI)
"RTN","PSORX1",13,0)
 ;
"RTN","PSORX1",14,0)
START K PSOQFLG,PSOID,PSOFIN,PSOQUIT,PSODRUG,^TMP($J,"PSOTDD"),^TMP("PSORXPO",$
J),^TMP("PSORXBO",$J)
"RTN","PSORX1",15,0)
 I '$G(PSOONEVA) N PSOONEVA S PSOONEVA=1
"RTN","PSORX1",16,0)
 D EOJ S (PSOBCK,PSOERR)=1 D INIT G:PSORX("QFLG") END
"RTN","PSORX1",17,0)
 D PT G:$G(PSORX("QFLG")) END D FULL^VALM1 I $G(NOPROC) K NOPROC G NX
"RTN","PSORX1",18,0)
 ;call to add bingo board data to file 52.11
"RTN","PSORX1",19,0)
 F SLPPL=0:0 S SLPPL=$O(RXRS(SLPPL)) Q:'SLPPL  D
"RTN","PSORX1",20,0)
 .I $P($G(^PSRX(SLPPL,"STA")),"^")'=5 K RXRS(SLPPL) Q
"RTN","PSORX1",21,0)
 .S RXREC=SLPPL D WIND^PSOSUPOE I $G(PBINGRTE) D BBADD^PSOSUPOE S (BINGCRT,BING
RTE)=1 S:$G(PSOFROM)'="NEW" PSOFROM="REFILL"
"RTN","PSORX1",22,0)
 K TM,TM1 I $G(PSORX("PSOL",1))]""!($D(RXRS)) D ^PSORXL K PSORX
"RTN","PSORX1",23,0)
 G:$G(NOBG) NX
"RTN","PSORX1",24,0)
 S TM=$P(^TMP("PSOBB",$J),"^"),TM1=$P(^TMP("PSOBB",$J),"^",2) K ^TMP("PSOBB",$J
)
"RTN","PSORX1",25,0)
 I $G(PSOFROM)="NEW"!($G(PSOFROM)="REFILL")!($G(PSOFROM)="PARTIAL")!($G(PSOFROM
)="UNHOLD") D:$D(BINGCRT)&($D(BINGRTE)&($D(DISGROUP))) ^PSOBING1 K BINGCRT,BING
RTE,BBRX,BBFLG
"RTN","PSORX1",26,0)
NX I $G(POERR("DEAD"))!$G(PSOQFLG) D EOJ G START
"RTN","PSORX1",27,0)
 D EOJ G START
"RTN","PSORX1",28,0)
END Q
"RTN","PSORX1",29,0)
 ;---------------------------------------------------------
"RTN","PSORX1",30,0)
INIT ;
"RTN","PSORX1",31,0)
 S PSORX("QFLG")=0
"RTN","PSORX1",32,0)
 D:'$D(PSOPAR) ^PSOLSET I '$D(PSOPAR) S PSORX("QFLG")=1
"RTN","PSORX1",33,0)
 I $P($G(PSOPAR),"^",2),'$D(^XUSEC("PSORPH",DUZ)) S PSORX("VERIFY")=1
"RTN","PSORX1",34,0)
INITX Q
"RTN","PSORX1",35,0)
 ;
"RTN","PSORX1",36,0)
PT ;
"RTN","PSORX1",37,0)
 K ^TMP("PSORXDC",$J),^TMP($J,"PSEXC","OUT"),CLOZPAT,DIC,PSODFN,PSOPTLK
"RTN","PSORX1",38,0)
 S PSORX("QFLG")=0,DIC(0)="QEAM" D EN^PSOPATLK S Y=PSOPTLK
"RTN","PSORX1",39,0)
 I +Y'>0 S PSORX("QFLG")=1 G PTX
"RTN","PSORX1",40,0)
OERR N:$G(MEDP) PAT,POERR K PSOXFLG S (DFN,PSODFN)=+Y,PSORX("NAME")=$P(Y,"^",2)
"RTN","PSORX1",41,0)
 K NPPROC,PSOQFLG,DIC,DR,DIQ S DIC=2,DA=PSODFN,DR=.351,DIQ="PSOPTPST" D EN^DIQ1
"RTN","PSORX1",42,0)
 K DIC,DA,DR,DIQ D DEAD^PSOPTPST I $G(PSOQFLG) S NOPROC=1 Q
"RTN","PSORX1",43,0)
 ;PSO*195 move SSN write to here and add DISPPRF call
"RTN","PSORX1",44,0)
 S SSN=$P(^DPT(PSODFN,0),"^",9) W !!?10,$C(7),PSORX("NAME")
"RTN","PSORX1",45,0)
 W " ("_$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)_")" K SSN
"RTN","PSORX1",46,0)
 I $G(XQY0)["PSO LMOE FINISH",'$G(MEDP),$D(^TMP($J,"PSOFLPO",PSODFN)) D
"RTN","PSORX1",47,0)
 .I '$D(IOINORM)!('$D(IOINHI)) S X="IORVOFF;IORVON;IOINHI;IOINORM" D ENDR^%ZISS
"RTN","PSORX1",48,0)
 .W "  ",IORVON_IOINHI,"<This patient has flagged orders>",IOINORM_IORVOFF
"RTN","PSORX1",49,0)
 S PSONOAL="" D ALLERGY^PSOORUT2 D  I PSONOAL'="" D PAUSE
"RTN","PSORX1",50,0)
 .I PSONOAL'="" W !,$C(7),"     No Allergy Assessment!"
"RTN","PSORX1",51,0)
 D REMOTE
"RTN","PSORX1",52,0)
 ; bwf - 1/9/2014 - PHARMACY INNOVATIONS, adding call and on screen message to 
get remote rx's from MDWS.
"RTN","PSORX1",53,0)
 I $G(PSOONEVA) D
"RTN","PSORX1",54,0)
 .N TFL,TFILIST,TFLP,TFLSITE,TFLIEN,TFLCNT,TFLDUP
"RTN","PSORX1",55,0)
 .D TFL^VAFCTFU1(.TFL,PSODFN)
"RTN","PSORX1",56,0)
 .S TFLCNT=0
"RTN","PSORX1",57,0)
 .S TFILIST="^VAMC^M&ROC^M&ROC(M&RO)^OC^OPC^CBOC^PRRTP^DOM^HCS^MC(M)^MC(M&D)^MO
RC^NHC^VANPH^SOC^SARRTP^"  ; only exact matches
"RTN","PSORX1",58,0)
 .S TFLP=0 F  S TFLP=$O(TFL(TFLP)) Q:'TFLP!(TFLCNT=2)  D
"RTN","PSORX1",59,0)
 ..S TFLSITE=$P(TFL(TFLP),U) Q:TFLSITE=""
"RTN","PSORX1",60,0)
 ..Q:$D(TFLDUP(TFLSITE))
"RTN","PSORX1",61,0)
 ..S TFLDUP(TFLSITE)=""
"RTN","PSORX1",62,0)
 ..Q:TFILIST'[(U_$P(TFL(TFLP),U,5)_U)
"RTN","PSORX1",63,0)
 ..S TFLCNT=$G(TFLCNT)+1
"RTN","PSORX1",64,0)
 .I $G(TFLCNT)<2 Q
"RTN","PSORX1",65,0)
 .I '$$GET1^DIQ(59.7,1,101,"I") D  Q
"RTN","PSORX1",66,0)
 ..W !!,"The OneVA Pharmacy flag is turned off. Queries will NOT"
"RTN","PSORX1",67,0)
 ..W !,"be made to other VA Pharmacy locations.",!
"RTN","PSORX1",68,0)
 .K DIR S DIR(0)="Y",DIR("B")="YES",DIR("A")="locations",DIR("A",1)="Would you 
like to query prescriptions from other OneVA Pharmacy" D ^DIR
"RTN","PSORX1",69,0)
 .K DIR
"RTN","PSORX1",70,0)
 .Q:'Y
"RTN","PSORX1",71,0)
 .W !!,"Please wait. Checking for prescriptions at other VA Pharmacy locations.
 This may take a moment...",!
"RTN","PSORX1",72,0)
 .D REMOTERX^PSORRX1(PSODFN,PSOSITE)
"RTN","PSORX1",73,0)
 N PSOUPDT
"RTN","PSORX1",74,0)
 S PSOUPDT=1
"RTN","PSORX1",75,0)
 I $G(XQY0)["PSO LMOE FINISH" S PSOUPDT=0
"RTN","PSORX1",76,0)
 D CHKADDR^PSOBAI(PSODFN,1,PSOUPDT)
"RTN","PSORX1",77,0)
 D:($G(XQY0)["PSO LMOE FINISH")&('$G(SNGLPAT)) DISPPRF^DGPFAPI(PSODFN)
"RTN","PSORX1",78,0)
 ;
"RTN","PSORX1",79,0)
 I $P($G(^PS(55,PSODFN,"LAN")),"^") W !?10,"Patient has another language prefer
ence!",! H 3
"RTN","PSORX1",80,0)
 I $G(^PS(55,"ASTALK",PSODFN)) W !,"Patient is enrolled to receive ScripTalk 't
alking' prescription labels.",! H 2 D MAIL
"RTN","PSORX1",81,0)
 D NOW^%DTC S TM=$E(%,1,12),TM1=$P(TM,".",2) S ^TMP("PSOBB",$J)=TM_"^"_TM1
"RTN","PSORX1",82,0)
 ;Call to display remote/local prescriptions
"RTN","PSORX1",83,0)
 I '$G(PSOFIN) D RDICHK^PSORMRX(PSODFN)
"RTN","PSORX1",84,0)
 S PSOQFLG=0,DIC="^PS(55,",DLAYGO=55
"RTN","PSORX1",85,0)
 I '$D(^PS(55,PSODFN,0)) D
"RTN","PSORX1",86,0)
 .K DD,DO S DIC(0)="L",(DINUM,X)=PSODFN D FILE^DICN D:Y<1  K DIC,DA,DR,DD,DO
"RTN","PSORX1",87,0)
 ..S $P(^PS(55,PSODFN,0),"^")=PSODFN K DIK S DA=PSODFN,DIK="^PS(55,",DIK(1)=.01
 D EN^DIK K DIK
"RTN","PSORX1",88,0)
 D RXSTA
"RTN","PSORX1",89,0)
 S PSOLOUD=1 D:$P($G(^PS(55,PSODFN,0)),"^",6)'=2 EN^PSOHLUP(PSODFN) K PSOLOUD
"RTN","PSORX1",90,0)
 I $G(^PS(55,PSODFN,"PS"))']"" D  I $G(POERR("QFLG")) G EOJ
"RTN","PSORX1",91,0)
 .L +^PS(55,PSODFN):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) I '$T W $C(
7),!!,"Patient Data is Being Edited by Another User!",! S POERR("QFLG")=1 S:$G(
PSOFIN) PSOQUIT=1 Q
"RTN","PSORX1",92,0)
 .S PSOXFLG=1,SSN=$P(^DPT(PSODFN,0),"^",9) W !!?10,$C(7),PSORX("NAME")_" ("_$E(
SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)_")",! K SSN
"RTN","PSORX1",93,0)
 .S DIE=55,DR=".02;.03;.04;.05;1;D ELIG^PSORX1;3;50;106;106.1",DA=PSODFN W !!,?
5,">>PHARMACY PATIENT DATA<<",! D ^DIE L -^PS(55,PSODFN)
"RTN","PSORX1",94,0)
 S PSOX=$G(^PS(55,PSODFN,"PS")) I PSOX]"" S PSORX("PATIENT STATUS")=$P($G(^PS(5
3,PSOX,0)),"^")
"RTN","PSORX1",95,0)
 I $G(^PS(55,PSODFN,"PS"))']"" D  I $G(POERR("QFLG")) G EOJ
"RTN","PSORX1",96,0)
 .W !!,"Patient Status Required!!",! D ELIG
"RTN","PSORX1",97,0)
 .W ! K POERR("QFLG"),DIC,DR,DIE S DIC("A")="RX PATIENT STATUS: ",DIC(0)="QEAMZ
",DIC=53 D ^DIC K DIC
"RTN","PSORX1",98,0)
 .I $D(DIRUT)!(Y=-1) D  Q
"RTN","PSORX1",99,0)
 ..W $C(7),"Required Data!",! S POERR("QFLG")=1 S:$G(PSOFIN) PSOQUIT=1
"RTN","PSORX1",100,0)
 ..I $O(^PS(55,PSODFN,0))="" S DA=PSODFN,DIK="^PS(55," D ^DIK
"RTN","PSORX1",101,0)
 .S ^PS(55,PSODFN,"PS")=+Y,PSORX("PATIENT STATUS")=$P(^PS(53,+Y,0),"^")
"RTN","PSORX1",102,0)
 .K DIRUT,DTOUT,DUOUT,X,Y,DA
"RTN","PSORX1",103,0)
 Q:$G(PSOFIN)
"RTN","PSORX1",104,0)
 D ^PSOBUILD
"RTN","PSORX1",105,0)
 F PT="GET","DEAD","INP","CNH","TPB","ADDRESS","COPAY" S RTN=PT_"^PSOPTPST" D @
RTN Q:$G(POERR("DEAD"))!($G(PSOQFLG))
"RTN","PSORX1",106,0)
 I $G(POERR("DEAD")) S POERR("QFLG")=1 F II=0:0 S II=$O(^PS(52.41,"P",PSODFN,II
)) D:$P($G(^PS(52.41,II,0)),"^",3)'="DC"&($P($G(^(0)),"^",3)'="DE") DC^PSOORFI2
"RTN","PSORX1",107,0)
 K PSOERR("DEAD"),II I $G(PSOQFLG) S POERR("QFLG")=1 G EOJ Q
"RTN","PSORX1",108,0)
 S (PAT,PSOXXDFN)=PSODFN,POERR=1 D ^PSOORUT2,BLD^PSOORUT1,EN^PSOLMUTL
"RTN","PSORX1",109,0)
 D CLEAR^VALM1 G:$G(PSOQUIT) PTX D EN^PSOLMAO
"RTN","PSORX1",110,0)
 S (DFN,PSODFN)=PSOXXDFN K DIE,DIC,DLAYGO,DR,DA,PSOX,PSORXED
"RTN","PSORX1",111,0)
 I $O(RXFL("")),$P(^PS(55,PSODFN,0),"^",7)="" D
"RTN","PSORX1",112,0)
 . N %
"RTN","PSORX1",113,0)
 . D NOW^%DTC
"RTN","PSORX1",114,0)
 . S $P(^PS(55,PSODFN,0),"^",7)=$E(%,1,12),$P(^(0),"^",8)="A" D LOGDFN^PSUHL(PS
ODFN)
"RTN","PSORX1",115,0)
PTX ;
"RTN","PSORX1",116,0)
 K X,Y,^TMP("PS",$J),^TMP($J,"PSEXC","OUT"),C,DEA,PRC,PSCNT,PSOACT,PSOCLC,PSOCS
,PSOCT,PSOFINFL,PSOHD,PSOLST,PSOOPT,PSOPF,PSOX,PSOX1,PSOXXDFN,SIGOK,STP,STR,PSO
PTLK
"RTN","PSORX1",117,0)
 Q
"RTN","PSORX1",118,0)
EOJ ;
"RTN","PSORX1",119,0)
 I $G(PSODFN) K ^TMP($J,"PSOINTERVENE",PSODFN)
"RTN","PSORX1",120,0)
 K PSOERR,PSOMED,PSORX,PSOSD,PSODRUG,PSODFN,PSOOPT,PSOBILL,PSOIBQS,PSOCPAY,PSOP
F,PSOPI,COMM,DGI,DGS,PT,PTDY,PTRF,RN,RTN,SERS,ST0,STAT,DFN,STOP,SLPPL,RXREC
"RTN","PSORX1",121,0)
 K:'$G(MEDP) PSOQFLG
"RTN","PSORX1",122,0)
 D KVA^VADPT,FULL^VALM1 K PSOLST,PSOXFLG,PSCNT,PSDIS,PSOAL,P1,LOG,%,%DT,%I,D0,D
AT,DFN,DRG,ORX,PSON,PSOPTPST,PSORX,PTST,PSOBCK,PSOID,PSOBXPUL
"RTN","PSORX1",123,0)
 K INCOM,SIG,SG,STP,RX0,RXN,RX2,RX3,RTS,C,DEAD,PS,PSOCLC,PSOCNT,PSOCT,PSODA,PSO
FROM,PSOHD,R3,REA,RF,RFD,RFM,RLD,RXNUM,RXP,RXPR,RXRP,RXRS,STR,POERR,VALMSG
"RTN","PSORX1",124,0)
 K ^TMP("PSORXDD",$J),^TMP("PSORXDC",$J),^TMP("PSOAL",$J),^TMP("PSOAO",$J),^TMP
("PSOSF",$J),^TMP("PSOPF",$J),^TMP("PSOPI",$J),^TMP("PSOPO",$J),^TMP("PSOHDR",$
J),^TMP("PSORXPO",$J)
"RTN","PSORX1",125,0)
 I '$G(MEDP),'$G(PSOQUIT) K PAT
"RTN","PSORX1",126,0)
 K ^TMP("PSORXBO",$J),PSORX,RFN,PSOXXDFN,VALM,VALMKEY,PSOBCK,SPOERR,PSOFLAG,VAL
MBCK,D,GMRA,GMRAL,GMRAREC,PSOSTA,PSODT,RXFL,NOBG,BBRX,BBFLG,^TMP($J,"PSOFLPO")
"RTN","PSORX1",127,0)
 K PPL,PPL1,PSOQFLAG ;*334 ADDED KILLS
"RTN","PSORX1",128,0)
 K ^XTMP("PSORRX1",$J),PSORCNT ;*454 added kill
"RTN","PSORX1",129,0)
 Q
"RTN","PSORX1",130,0)
ELIG ; shows eligibility and disabilities
"RTN","PSORX1",131,0)
 D ELIG^VADPT W !,"Eligibility: "_$P(VAEL(1),"^",2)_$S(+VAEL(3):"     SC%: "_$P
(VAEL(3),"^",2),1:"") S N=0 F  S N=$O(VAEL(1,N)) Q:'N  W !,?10,$P(VAEL(1,N),"^"
,2)
"RTN","PSORX1",132,0)
 W !,"Disabilities: " F I=0:0 S I=$O(^DPT(DFN,.372,I)) Q:'I  S I1=$S($D(^DPT(DF
N,.372,I,0)):^(0),1:"") D:+I1
"RTN","PSORX1",133,0)
 .S PSDIS=$S($P($G(^DIC(31,+I1,0)),"^")]""&($P($G(^(0)),"^",4)']""):$P(^(0),"^"
),$P($G(^DIC(31,+I1,0)),"^",4)]"":$P(^(0),"^",4),1:""),PSCNT=$P(I1,"^",2)
"RTN","PSORX1",134,0)
 .W:$L(PSDIS_"-"_PSCNT_"% ("_$S($P(I1,"^",3):"SC",1:"NSC")_"), ")>80 !,?15
"RTN","PSORX1",135,0)
 .W $S($G(PSDIS)]"":PSDIS_"-",1:"")_PSCNT_"% ("_$S($P(I1,"^",3):"SC",1:"NSC")_"
), "
"RTN","PSORX1",136,0)
 K N
"RTN","PSORX1",137,0)
 Q
"RTN","PSORX1",138,0)
PROFILE ;
"RTN","PSORX1",139,0)
 S (PSORX("REFILL"),PSORX("RENEW"))=0,PSOX="" D ^PSOBUILD
"RTN","PSORX1",140,0)
 I '$G(PSOSD) W !,"This patient has no prescriptions" S:'$D(DFN) DFN=PSODFN D G
MRA^PSODEM G PROFILEX
"RTN","PSORX1",141,0)
 S (PSODRG,PSOX)="" F  S PSODRG=$O(PSOSD(PSODRG)) Q:PSODRG=""  F  S PSOX=$O(PSO
SD(PSODRG,PSOX)) Q:PSOX=""  S:$P(PSOSD(PSODRG,PSOX),"^",3)="" PSORX("RENEW")=1 
S:$P(PSOSD(PSODRG,PSOX),"^",4)="" PSORX("REFILL")=1
"RTN","PSORX1",142,0)
 K PSOX
"RTN","PSORX1",143,0)
PROFILEX Q
"RTN","PSORX1",144,0)
 ;
"RTN","PSORX1",145,0)
MAIL ; MAKE SURE MAIL STATUS IS COMPATIBLE WITH SCRIPTALK PATIENT
"RTN","PSORX1",146,0)
 I $P($G(^PS(59,PSOSITE,"STALK")),"^")="" Q  ; NO SCRIPTALK PRINTER SET UP FOR 
THIS DIVISION
"RTN","PSORX1",147,0)
 N MAIL
"RTN","PSORX1",148,0)
 S MAIL=$G(^PS(55,PSODFN,0)) I $P(MAIL,"^",3)>1 Q
"RTN","PSORX1",149,0)
MAILP W !!,"REMINDER: CMOP does not fill ScripTalk prescriptions. Please select
 mail"
"RTN","PSORX1",150,0)
 W !,"status:  2 (DO NOT MAIL), 3 (LOCAL REGULAR MAIL) or 4 (LOCAL CERTFIED MAI
L)."
"RTN","PSORX1",151,0)
 R !,"MAIL: ",MAIL:120
"RTN","PSORX1",152,0)
 I MAIL?1"^".E Q
"RTN","PSORX1",153,0)
 I MAIL<2!(MAIL>4) W !,"INVALID MAIL SETTING - ENTER 2,3, OR 4" G MAILP
"RTN","PSORX1",154,0)
 W "  ",$S(MAIL=2:"DO NOT MAIL",MAIL=3:"LOCAL REGULAR MAIL",1:"LOCAL CERTIFIED 
MAIL")
"RTN","PSORX1",155,0)
 S $P(^PS(55,PSODFN,0),"^",3)=MAIL
"RTN","PSORX1",156,0)
 Q
"RTN","PSORX1",157,0)
REMOTE ; 
"RTN","PSORX1",158,0)
 I $T(HAVEHDR^ORRDI1)']"" Q
"RTN","PSORX1",159,0)
 I '$$HAVEHDR^ORRDI1 Q
"RTN","PSORX1",160,0)
 D HD^PSODDPR2():(($Y+5)'>IOSL)
"RTN","PSORX1",161,0)
 I $D(^XTMP("ORRDI","OUTAGE INFO","DOWN")) W !!,"Remote data not available - On
ly local order checks processed.",! D HD^PSODDPR2():(($Y+5)'>IOSL) Q
"RTN","PSORX1",162,0)
 Q
"RTN","PSORX1",163,0)
PAUSE ;
"RTN","PSORX1",164,0)
 W ! K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Ret
urn to continue" D ^DIR K DIR
"RTN","PSORX1",165,0)
 Q
"RTN","PSORX1",166,0)
 ;
"RTN","PSORX1",167,0)
RXSTA ; DISPLAY ELIGIBILITY & PROMPT FOR RX PATIENT STATUS
"RTN","PSORX1",168,0)
 N DA,PSOSTA
"RTN","PSORX1",169,0)
 I '$G(PSODFN) Q
"RTN","PSORX1",170,0)
 S DA=PSODFN,PSOSTA=$G(^PS(55,PSODFN,"PS"))
"RTN","PSORX1",171,0)
 I $G(XQY0)["PSO LMOE FINISH"!(XQY0["PSO LM BACKDOOR ORDERS") I PSOSTA]"" D
"RTN","PSORX1",172,0)
 .D ELIG^VADPT W !,"Eligibility: "_$P(VAEL(1),"^",2)_$S(+VAEL(3):"     SC%: "_$
P(VAEL(3),"^",2),1:"")
"RTN","PSORX1",173,0)
 .S N=0 F  S N=$O(VAEL(1,N)) Q:'N  W !,?10,$P(VAEL(1,N),"^",2)
"RTN","PSORX1",174,0)
 .S DIC("A")="RX PATIENT STATUS: ",DIC("B")=PSOSTA,DIC(0)="QEAMZ",DIC=53 D ^DIC
 K DIC
"RTN","PSORX1",175,0)
 .I +Y>0,+Y'=PSOSTA S DIE="^PS(55,",DR="3////"_+Y D ^DIE
"RTN","PSORX1",176,0)
 Q
"VER")
8.0^22.2
"^DD",59.7,59.7,101,0)
ONEVA PHARMACY FLAG^S^1:ON;0:OFF;^101;1^Q
"^DD",59.7,59.7,101,3)
Select '1' to turn on the OneVA Pharmacy remote prescription logic. Select '0' 
to turn it off.
"^DD",59.7,59.7,101,21,0)
^^6^6^3170822^
"^DD",59.7,59.7,101,21,1,0)
This flag controls the functionality of the OneVA Pharmacy remote 
"^DD",59.7,59.7,101,21,2,0)
prescription logic. If the flag is turned on, this facility will be able 
"^DD",59.7,59.7,101,21,3,0)
to query prescriptions from other facilities, and will accept incoming 
"^DD",59.7,59.7,101,21,4,0)
refill and partial fills from other VA medical facilities. If the flag is 
"^DD",59.7,59.7,101,21,5,0)
turned 'off', no queries will be made, and external refill/partial fill 
"^DD",59.7,59.7,101,21,6,0)
requests will be declined.
"^DD",59.7,59.7,101,"DT")
3170822
"BLD",9861,6)
1^
$END KID PSO*7.0*497

