EPIP_PSO_PSS_IP21.KIDs

KIDS Distribution saved on Oct 24, 2018@15:43:05
PSO*7.0*452 and PSS*1.0*215
**KIDS**:PSO*7.0*452^PSS*1.0*215^

**INSTALL NAME**
PSO*7.0*452
"BLD",10177,0)
PSO*7.0*452^OUTPATIENT PHARMACY^0^3181024^y
"BLD",10177,1,0)
^^8^8^3181004^^
"BLD",10177,1,1,0)
Patch PSO*7*452 is part of a Multi Build with patch PSS*1.0*215.
"BLD",10177,1,2,0)
PSO*7.0*452 contains the routine changes.
"BLD",10177,1,3,0)
PSS*1.0*215 contains the DD changes.
"BLD",10177,1,4,0)
 
"BLD",10177,1,5,0)
The NSRs involved in this build are:
"BLD",10177,1,6,0)
NSR20150311 High Cost Rx Report;  NSR20151109 Pharmacy Print from Suspense
"BLD",10177,1,7,0)
by Category; NSR20150512 Early Warning Advisory for Approaching the 
"BLD",10177,1,8,0)
end of Rx Number Ranges; and NSR20151001 Pharmacy Patient Demographics.
"BLD",10177,4,0)
^9.64PA^^0
"BLD",10177,6.3)
56
"BLD",10177,"INID")
^y
"BLD",10177,"INIT")
PSOP452P
"BLD",10177,"KRN",0)
^9.67PA^779.2^20
"BLD",10177,"KRN",.4,0)
.4
"BLD",10177,"KRN",.4,"NM",0)
^9.68A^^0
"BLD",10177,"KRN",.401,0)
.401
"BLD",10177,"KRN",.401,"NM",0)
^9.68A^^0
"BLD",10177,"KRN",.402,0)
.402
"BLD",10177,"KRN",.402,"NM",0)
^9.68A^^0
"BLD",10177,"KRN",.403,0)
.403
"BLD",10177,"KRN",.403,"NM",0)
^9.68A^^
"BLD",10177,"KRN",.5,0)
.5
"BLD",10177,"KRN",.5,"NM",0)
^9.68A^^0
"BLD",10177,"KRN",.84,0)
.84
"BLD",10177,"KRN",3.6,0)
3.6
"BLD",10177,"KRN",3.8,0)
3.8
"BLD",10177,"KRN",3.8,"NM",0)
^9.68A^^0
"BLD",10177,"KRN",9.2,0)
9.2
"BLD",10177,"KRN",9.2,"NM",0)
^9.68A^^0
"BLD",10177,"KRN",9.8,0)
9.8
"BLD",10177,"KRN",9.8,"NM",0)
^9.68A^10^9
"BLD",10177,"KRN",9.8,"NM",1,0)
PSOEOPNW^^0^B11880159
"BLD",10177,"KRN",9.8,"NM",2,0)
PSOSITED^^0^B11480103
"BLD",10177,"KRN",9.8,"NM",4,0)
PSOSULB1^^0^B47930066
"BLD",10177,"KRN",9.8,"NM",5,0)
PSOSUCAT^^0^B81054236
"BLD",10177,"KRN",9.8,"NM",6,0)
PSODEM^^0^B21822724
"BLD",10177,"KRN",9.8,"NM",7,0)
PSODEMSB^^0^B62505884
"BLD",10177,"KRN",9.8,"NM",8,0)
PSODIR4^^0^B57253130
"BLD",10177,"KRN",9.8,"NM",9,0)
PSOCST10^^0^B20212856
"BLD",10177,"KRN",9.8,"NM",10,0)
PSOSULBL^^0^B105467816
"BLD",10177,"KRN",9.8,"NM","B","PSOCST10",9)

"BLD",10177,"KRN",9.8,"NM","B","PSODEM",6)

"BLD",10177,"KRN",9.8,"NM","B","PSODEMSB",7)

"BLD",10177,"KRN",9.8,"NM","B","PSODIR4",8)

"BLD",10177,"KRN",9.8,"NM","B","PSOEOPNW",1)

"BLD",10177,"KRN",9.8,"NM","B","PSOSITED",2)

"BLD",10177,"KRN",9.8,"NM","B","PSOSUCAT",5)

"BLD",10177,"KRN",9.8,"NM","B","PSOSULB1",4)

"BLD",10177,"KRN",9.8,"NM","B","PSOSULBL",10)

"BLD",10177,"KRN",19,0)
19
"BLD",10177,"KRN",19,"NM",0)
^9.68A^2^2
"BLD",10177,"KRN",19,"NM",1,0)
PSO CLINICAL ALERT ENTER/EDIT^^0
"BLD",10177,"KRN",19,"NM",2,0)
PSO RX NUMBERING WARNING^^0
"BLD",10177,"KRN",19,"NM","B","PSO CLINICAL ALERT ENTER/EDIT",1)

"BLD",10177,"KRN",19,"NM","B","PSO RX NUMBERING WARNING",2)

"BLD",10177,"KRN",19.1,0)
19.1
"BLD",10177,"KRN",19.1,"NM",0)
^9.68A^^0
"BLD",10177,"KRN",101,0)
101
"BLD",10177,"KRN",101,"NM",0)
^9.68A^^0
"BLD",10177,"KRN",409.61,0)
409.61
"BLD",10177,"KRN",409.61,"NM",0)
^9.68A^^0
"BLD",10177,"KRN",771,0)
771
"BLD",10177,"KRN",771,"NM",0)
^9.68A^^0
"BLD",10177,"KRN",779.2,0)
779.2
"BLD",10177,"KRN",870,0)
870
"BLD",10177,"KRN",870,"NM",0)
^9.68A^^0
"BLD",10177,"KRN",8989.51,0)
8989.51
"BLD",10177,"KRN",8989.52,0)
8989.52
"BLD",10177,"KRN",8994,0)
8994
"BLD",10177,"KRN","B",.4,.4)

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

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

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

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

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

"BLD",10177,"KRN","B",3.6,3.6)

"BLD",10177,"KRN","B",3.8,3.8)

"BLD",10177,"KRN","B",9.2,9.2)

"BLD",10177,"KRN","B",9.8,9.8)

"BLD",10177,"KRN","B",19,19)

"BLD",10177,"KRN","B",19.1,19.1)

"BLD",10177,"KRN","B",101,101)

"BLD",10177,"KRN","B",409.61,409.61)

"BLD",10177,"KRN","B",771,771)

"BLD",10177,"KRN","B",779.2,779.2)

"BLD",10177,"KRN","B",870,870)

"BLD",10177,"KRN","B",8989.51,8989.51)

"BLD",10177,"KRN","B",8989.52,8989.52)

"BLD",10177,"KRN","B",8994,8994)

"BLD",10177,"QDEF")
^^^^NO^^^^NO^^NO
"BLD",10177,"QUES",0)
^9.62^^
"BLD",10177,"REQB",0)
^9.611^5^4
"BLD",10177,"REQB",1,0)
PSO*7.0*398^2
"BLD",10177,"REQB",2,0)
PSO*7.0*500^2
"BLD",10177,"REQB",4,0)
PSO*7.0*448^2
"BLD",10177,"REQB",5,0)
PSO*7.0*539^2
"BLD",10177,"REQB","B","PSO*7.0*398",1)

"BLD",10177,"REQB","B","PSO*7.0*448",4)

"BLD",10177,"REQB","B","PSO*7.0*500",2)

"BLD",10177,"REQB","B","PSO*7.0*539",5)

"INIT")
PSOP452P
"KRN",19,2921973,-1)
0^2
"KRN",19,2921973,0)
PSO RX NUMBERING WARNING^End of Prescription Numbering Warning^^R^^^^^^^^
"KRN",19,2921973,1,0)
^19.06^7^7^3170724^^^^
"KRN",19,2921973,1,1,0)
Search the Outpatient Site (#59) for sites with less than 1000 numbers 
"KRN",19,2921973,1,2,0)
left.
"KRN",19,2921973,1,3,0)
 
"KRN",19,2921973,1,4,0)
NARCOTIC UPPER BOUND - LAST NARCOTIC NUMBER ISSUED
"KRN",19,2921973,1,5,0)
LAST PRESCRIPTION # NUMBER ISSUED - LAST PRESCRIPTION # NUMBER ISSUED
"KRN",19,2921973,1,6,0)
 
"KRN",19,2921973,1,7,0)
If less than 250, display *** EXTREMELY LOW ***
"KRN",19,2921973,25)
CHECK^PSOEOPNW
"KRN",19,2921973,200.9)
y
"KRN",19,2921973,"U")
END OF PRESCRIPTION NUMBERING 
"KRN",19,2921975,-1)
0^1
"KRN",19,2921975,0)
PSO CLINICAL ALERT ENTER/EDIT^Clinical Alert Enter/Edit^^R^^^^^^^^OUTPATIENT PHARMACY
"KRN",19,2921975,1,0)
^^11^11^3180622^
"KRN",19,2921975,1,1,0)
This option provides Enter/Edit of Clinical Alerts multiple (#109) in
"KRN",19,2921975,1,2,0)
Pharmacy Patient file (#55).
"KRN",19,2921975,1,3,0)
 
"KRN",19,2921975,1,4,0)
This option was developed for alerting pharmacy personnel of important
"KRN",19,2921975,1,5,0)
information (i.e., Drug to Drug interactions on research programs that the
"KRN",19,2921975,1,6,0)
normal software would not know about, etc.).
"KRN",19,2921975,1,7,0)
 
"KRN",19,2921975,1,8,0)
This option is only assigned to Pharmacy Supervisors.  The supervisor
"KRN",19,2921975,1,9,0)
enters the clinical alert and then this information is displayed in the
"KRN",19,2921975,1,10,0)
appropriate places.  Someone filling an order (or RX) would view this
"KRN",19,2921975,1,11,0)
information beforehand and act accordingly.
"KRN",19,2921975,25)
ENTER^PSODEMSB
"KRN",19,2921975,99.1)
64729,30553
"KRN",19,2921975,"U")
CLINICAL ALERT ENTER/EDIT
"MBREQ")
0
"ORD",18,19)
19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA
"ORD",18,19,0)
OPTION
"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)
452^3181024^520736441
"PKG",170,22,1,"PAH",1,1,0)
^^8^8^3181024
"PKG",170,22,1,"PAH",1,1,1,0)
Patch PSO*7*452 is part of a Multi Build with patch PSS*1.0*215.
"PKG",170,22,1,"PAH",1,1,2,0)
PSO*7.0*452 contains the routine changes.
"PKG",170,22,1,"PAH",1,1,3,0)
PSS*1.0*215 contains the DD changes.
"PKG",170,22,1,"PAH",1,1,4,0)
 
"PKG",170,22,1,"PAH",1,1,5,0)
The NSRs involved in this build are:
"PKG",170,22,1,"PAH",1,1,6,0)
NSR20150311 High Cost Rx Report;  NSR20151109 Pharmacy Print from Suspense
"PKG",170,22,1,"PAH",1,1,7,0)
by Category; NSR20150512 Early Warning Advisory for Approaching the 
"PKG",170,22,1,"PAH",1,1,8,0)
end of Rx Number Ranges; and NSR20151001 Pharmacy Patient Demographics.
"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")
10
"RTN","PSOCST10")
0^9^B20212856
"RTN","PSOCST10",1,0)
PSOCST10 ;BHAM ISC/SAB - high cost report ; 12/16/14 8:53am
"RTN","PSOCST10",2,0)
 ;;7.0;OUTPATIENT PHARMACY;**31,56,331,398,452**;DEC 1997;Build 56
"RTN","PSOCST10",3,0)
 ;this routine list rxs that cost over a specified $ amount for a specified date range
"RTN","PSOCST10",4,0)
 ;External Ref. ^PSDRUG( is supp. by DBIA# 221
"RTN","PSOCST10",5,0)
BEG W ! S %DT(0)=-DT,%DT("A")="Beginning Date: ",%DT="APE" D ^%DT G:Y<0!($D(DTOUT)) EXIT S (%DT(0),BEGDATE)=Y
"RTN","PSOCST10",6,0)
 W ! S %DT("A")="Ending Date: " D ^%DT G:Y<0!($D(DTOUT)) EXIT S ENDDATE=Y D:+$E(Y,6,7)=0 DTC
"RTN","PSOCST10",7,0)
MAX K DIR S DIR("A")="Dollar Limit ",DIR("B")=30,DIR(0)="N^0:9999:2",DIR("?")="Enter a dollar amount between 0-9999 with no more than two decimals or ^ quit"
"RTN","PSOCST10",8,0)
 D ^DIR K DIR G:$D(DIRUT) EXIT S MAX=Y
"RTN","PSOCST10",9,0)
 ; BEGIN prompt for selection of Outpatient Site(s) //rtw
"RTN","PSOCST10",10,0)
 N @($$DIR^PSODIR4()),PSOSITE D OPTSITE^PSODIR4(.PSOSITE,$T(+0),1) G:PSOSITE="^" EXIT
"RTN","PSOCST10",11,0)
 ; END  prompt for selection of Outpatient Site(s)
"RTN","PSOCST10",12,0)
DEV K %ZIS,IOP,POP,ZTSK S PSOION=ION,%ZIS="QM" D ^%ZIS K %ZIS I POP S IOP=PSOION D ^%ZIS K IOP,PSOION W !,"Please try later!" G EXIT
"RTN","PSOCST10",13,0)
 K PSOION I $D(IO("Q")) D  G EXIT
"RTN","PSOCST10",14,0)
 .S ZTDESC="Outpatient High Cost Report",ZTRTN="START^PSOCST10" F G="BEGDATE","ENDDATE","MAX" S:$D(@G) ZTSAVE(G)=""
"RTN","PSOCST10",15,0)
 .; Begin save & pass PSOSITE* to tasked entry point //rtw
"RTN","PSOCST10",16,0)
 .S ZTSAVE("PSOSITE*")=""
"RTN","PSOCST10",17,0)
 .; End  save & pass PSOSITE* to tasked entry point /rtw
"RTN","PSOCST10",18,0)
 .K IO("Q") D ^%ZTLOAD W:$D(ZTSK) !,"Report is Queued to print !!" K ZTSK
"RTN","PSOCST10",19,0)
START U IO S PAGE=1,(CNT,TCOST)=0 D HD
"RTN","PSOCST10",20,0)
 F NDT=BEGDATE:1:ENDDATE F PSOTY="AL","AM" S PSDT=NDT-1_".999999" D ST1 Q:$D(DIRUT)  ;*331
"RTN","PSOCST10",21,0)
 Q:$D(DIRUT)  D HD:($Y+4)>IOSL
"RTN","PSOCST10",22,0)
 D:'$D(DIRUT) FT
"RTN","PSOCST10",23,0)
EXIT W ! D ^%ZISC K XTYPE,DIR,DTOUT,DUOUT,DIROUT,DIRUT,^TMP($J),NDT,PSOTY,BEGDATE,CNT,COST,TCOST,DR0,DRCST,ENDDATE,MAX,PAGE,PGM,POP,PSDT,PSFILL,PSRXN,QTY,RX0,RX1,VAR,X,Y,%DT
"RTN","PSOCST10",24,0)
 S:$D(ZTQUEUED) ZTREQ="@" Q
"RTN","PSOCST10",25,0)
ST1 F  S PSDT=$O(^PSRX(PSOTY,PSDT)) Q:'PSDT!(PSDT>(NDT_".999999"))  D ST2 Q:$D(DIRUT)
"RTN","PSOCST10",26,0)
 Q
"RTN","PSOCST10",27,0)
ST2 S PSRXN=0 F  S PSRXN=$O(^PSRX(PSOTY,PSDT,PSRXN)) Q:'PSRXN  D ST3 Q:$D(DIRUT)
"RTN","PSOCST10",28,0)
 Q
"RTN","PSOCST10",29,0)
ST3 S PSFILL=""
"RTN","PSOCST10",30,0)
 F  S PSFILL=$O(^PSRX(PSOTY,PSDT,PSRXN,PSFILL)) Q:PSFILL=""  D CHK Q:$D(DIRUT)
"RTN","PSOCST10",31,0)
 Q
"RTN","PSOCST10",32,0)
CHK Q:'$D(^PSRX(PSRXN,0))!(+$P(^PSRX(PSRXN,"STA"),"^")=13)  S RX0=^(0) Q:'$D(^PSDRUG(+$P(RX0,"^",6),0))  S DR0=^(0)
"RTN","PSOCST10",33,0)
 I PSOTY="AL" S:PSFILL RX1=$G(^PSRX(PSRXN,1,PSFILL,0)) Q:PSFILL&($G(RX1)="")
"RTN","PSOCST10",34,0)
 I PSOTY="AM" Q:'$P($G(^PSRX(PSRXN,"P",PSFILL,0)),"^",19)  S RX1=^(0)
"RTN","PSOCST10",35,0)
 ; Begin to screen RX on selected Outpatient Site(s) ;rtw
"RTN","PSOCST10",36,0)
 Q:'$$DIVOK^PSODIR4(.PSOSITE,PSOTY,PSRXN,PSFILL)
"RTN","PSOCST10",37,0)
 ; End screen of RX on selected Outpatient Site(s) ;rtw
"RTN","PSOCST10",38,0)
 S DRCST=$S('PSFILL&(+$P(RX0,"^",17)):$P(RX0,"^",17),PSFILL&(+$P($G(RX1),"^",11)):$P($G(RX1),"^",11),1:0)
"RTN","PSOCST10",39,0)
 S QTY=$S('PSFILL:+$P(RX0,"^",7),1:+$P(RX1,"^",4))
"RTN","PSOCST10",40,0)
 I 'DRCST S DRCST=$S($P($G(^PSDRUG(+$P(RX0,"^",6),660)),"^",6):+$P(^(660),"^",6),1:0)
"RTN","PSOCST10",41,0)
 S COST=QTY*DRCST Q:COST<MAX
"RTN","PSOCST10",42,0)
 Q:$D(DIRUT)  D HD:($Y+4)>IOSL
"RTN","PSOCST10",43,0)
 Q:$D(DIRUT)  W !,$S(PSFILL&(PSOTY="AL"):"*",PSOTY="AM":"%",1:" ")_$P(RX0,"^"),?11,$E($P(DR0,"^"),"^",40),?51,$J(QTY,6),?60,$J(DRCST,6,3),?68,$J(COST,12,2) S CNT=CNT+1,TCOST=TCOST+COST
"RTN","PSOCST10",44,0)
 Q
"RTN","PSOCST10",45,0)
HD I PAGE>1,$E(IOST)="C" S DIR(0)="E",DIR("A")=" Press Return to Continue or ^ to Exit" D ^DIR K DIR
"RTN","PSOCST10",46,0)
 Q:$D(DIRUT)  W @IOF,!,"Fills That Cost at Least $"_MAX_" for the Period: " S Y=BEGDATE D DT^DIO2 W " to " S Y=ENDDATE D DT^DIO2 W ?72,"Page "_PAGE,!,"Run Date: " S Y=DT D DT^DIO2 S PAGE=PAGE+1
"RTN","PSOCST10",47,0)
 ; Begin display selected Outpatient Site(s) //rtw
"RTN","PSOCST10",48,0)
 N PSOLTIEN,PSOIEN59,PSOSTANM
"RTN","PSOCST10",49,0)
 W !,"Outpatient Site" I PSOSITE("PSOSCNT")>1 W "s"
"RTN","PSOCST10",50,0)
 W " Included in this Report: " I PSOSITE("PSOSCNT")>1 W !?2
"RTN","PSOCST10",51,0)
 S PSOLTIEN=$O(PSOSITE(":"),-1) ; Do not append a comma on last site
"RTN","PSOCST10",52,0)
 S PSOIEN59=0 F  S PSOIEN59=$O(PSOSITE(PSOIEN59)) Q:'PSOIEN59  D  ;
"RTN","PSOCST10",53,0)
 . ; Format PSOSTANM variable, for example: JOHN COCHRAN VAMC (657)
"RTN","PSOCST10",54,0)
 . S PSOSTANM=PSOSITE(PSOIEN59)_" ("_$$GET1^DIQ(59,PSOIEN59,.06)_")"
"RTN","PSOCST10",55,0)
 . I PSOIEN59'=PSOLTIEN S PSOSTANM=PSOSTANM_", " ; Format multiples sites w/comma separation
"RTN","PSOCST10",56,0)
 . I $X+($L(PSOSTANM)+2)>(IOM-1) W !?2 ; Issue line feed if IOM exceeded
"RTN","PSOCST10",57,0)
 . W PSOSTANM
"RTN","PSOCST10",58,0)
 ; End display selected Outpatient Site(s) //rtw
"RTN","PSOCST10",59,0)
 W !!,"Rx #",?11,"Drug",?54,"QTY",?59,"Un.Cost",?70,"Total Cost"
"RTN","PSOCST10",60,0)
 W ! F I=1:1:80 W "-"
"RTN","PSOCST10",61,0)
 Q
"RTN","PSOCST10",62,0)
FT W ! F I=1:1:80 W "-"
"RTN","PSOCST10",63,0)
 S TCOST="Total Cost = "_$FN(TCOST,",",2)
"RTN","PSOCST10",64,0)
 W !,"No. of Fills = "_CNT,?50,$J(TCOST,30)
"RTN","PSOCST10",65,0)
 W ! F I=1:1:80 W "-"
"RTN","PSOCST10",66,0)
 W !,"(* indicates a refill, % indicates a partial) "
"RTN","PSOCST10",67,0)
 Q
"RTN","PSOCST10",68,0)
DTC N DD,MM S DD=31,MM=+$E(Y,4,5) I MM'=12 S MM=MM+1,MM=$S(MM<10:"0",1:"")_MM,X2=Y,X1=$E(Y,1,3)_MM_"00" D ^%DTC S DD=X
"RTN","PSOCST10",69,0)
 S ENDDATE=Y+DD
"RTN","PSOCST10",70,0)
 Q
"RTN","PSODEM")
0^6^B21822724
"RTN","PSODEM",1,0)
PSODEM ;BHAM ISC/SAB - PATIENT DEMOGRAPHICS ; 02/17/93 12:29
"RTN","PSODEM",2,0)
 ;;7.0;OUTPATIENT PHARMACY;**5,19,233,258,326,390,411,402,500,452**;DEC 1997;Build 56
"RTN","PSODEM",3,0)
 ;External reference to ^GMRADPT supported by DBIA 10099
"RTN","PSODEM",4,0)
 ;External reference to ^DIC(31 supported by DBIA 658
"RTN","PSODEM",5,0)
 ;External reference to $$BSA^PSSDSAPI supported by DBIA 5425
"RTN","PSODEM",6,0)
 ;
"RTN","PSODEM",7,0)
 ;RTW BEGIN PATIENT DEMOGRAPHIC CHANGE INFORMATION---------------------------
"RTN","PSODEM",8,0)
 ;EPIP NSR20151001 PATIENT DEMOGRAPHICS and Clinical Alerts added  
"RTN","PSODEM",9,0)
 ;output, which will appear right after the Pharmacy Narrative:
"RTN","PSODEM",10,0)
 ;   * Primary Care Team and their office Phone
"RTN","PSODEM",11,0)
 ;   * PC Provider and Position
"RTN","PSODEM",12,0)
 ;   * PC Provider's pager and office phone number
"RTN","PSODEM",13,0)
 ;   * Current facility (or institution) of the Patient based on PC Team or appointment & visit history}  
"RTN","PSODEM",14,0)
 ;   * Patient file REMARKS
"RTN","PSODEM",15,0)
 ;   * Clinical Alerts (for example, when a patient part of a researh study)
"RTN","PSODEM",16,0)
 ;   * then pause the screen until the user pressed the <ENTER> key
"RTN","PSODEM",17,0)
 ;RTW END PATIENT DEMOGRAPHIC CHANGE INFORMATION---------------------------
"RTN","PSODEM",18,0)
GET S DFN=DA D 6^VADPT,PID^VADPT U IO W @IOF,!,VADM(1)
"RTN","PSODEM",19,0)
 I +VAPA(9) W !?5,"(TEMP ADDRESS from "_$P(VAPA(9),"^",2)_" till "_$S($P(VAPA(10),"^",2)]"":$P(VAPA(10),"^",2),1:"(no end date)")_")"
"RTN","PSODEM",20,0)
 W !,VAPA(1),?40,"DOB:   ",$S(+VADM(3):$P(VADM(3),"^",2),1:"UNKNOWN") W:VAPA(2)]"" !,VAPA(2) W:VAPA(3)]"" !,VAPA(3)
"RTN","PSODEM",21,0)
 W !,VAPA(4),?40,"PHONE: "_VAPA(8),!,$P(VAPA(5),"^",2)_"  "_$S(VAPA(11)]"":$P(VAPA(11),"^",2),1:VAPA(6)),?40,"ELIG:  "_$P(VAEL(1),"^",2) W:+VAEL(3) !?40,"SC%:   "_$P(VAEL(3),"^",2)
"RTN","PSODEM",22,0)
 I $D(^PS(55,DFN,0)) W:$P(^(0),"^",2) !,"CANNOT USE SAFETY CAPS." I +$P(^(0),"^",4) W ?40,"DIALYSIS PATIENT."
"RTN","PSODEM",23,0)
 I $G(^PS(55,DFN,1))]"" S X=^(1) W !!?5,"Pharmacy Narrative: " F I=1:1 Q:$P(X," ",I,99)=""  W:$X+$L($P(X," ",I))+$L(" ")>IOM ! W $P(X," ",I)," "
"RTN","PSODEM",24,0)
RE ;
"RTN","PSODEM",25,0)
 D DEMOG^PSODEMSB(DFN)  ;RTW PATIENT DEMOGRAPHIC CHANGE
"RTN","PSODEM",26,0)
 S (WT,HT)="",X="GMRVUTL" X ^%ZOSF("TEST") I $T D
"RTN","PSODEM",27,0)
 .F GMRVSTR="WT","HT" S VM=GMRVSTR D EN6^GMRVUTL S @VM=X,$P(@VM,"^")=$E($P(@VM,"^"),4,5)_"/"_$E($P(@VM,"^"),6,7)_"/"_($E($P(@VM,"^"),1,3)+1700)
"RTN","PSODEM",28,0)
 .S X=$P(WT,"^",8),Y=$J(X/2.2046226,0,2),$P(WT,"^",9)=Y,X=$P(HT,"^",8),Y=$J(2.54*X,0,2),$P(HT,"^",9)=Y
"RTN","PSODEM",29,0)
 Q:$G(POERR)
"RTN","PSODEM",30,0)
 W !!,"WEIGHT(Kg): " W:+$P(WT,"^",8) $P(WT,"^",9)_" ("_$P(WT,"^")_")" W ?41,"HEIGHT(cm): " W:$P(HT,"^",8) $P(HT,"^",9)_" ("_$P(HT,"^")_")" K VM,WT,HT
"RTN","PSODEM",31,0)
 ;
"RTN","PSODEM",32,0)
 ; Display CrCl/BSA - show serum creatinine if CrCl can't be calculated
"RTN","PSODEM",33,0)
CRCL S PSOBSA=$$BSA^PSSDSAPI(DFN),PSOBSA=$P(PSOBSA,"^",3),PSOBSA=$S(PSOBSA'>0:"_______",1:$J(PSOBSA,4,2))
"RTN","PSODEM",34,0)
 S RSLT=$$CRCL^PSOORUT2(DFN)
"RTN","PSODEM",35,0)
 ; RSLT -- DATE^CRCL^Serum Creatinine -- Ex.  11/25/11^68.7^1.1
"RTN","PSODEM",36,0)
 I ($P($G(RSLT),"^",2)["Not Found")&($P($G(RSLT),"^",3)<.01) S ZDSPL="  CrCL: "_$P(RSLT,"^",2)_" (CREAT: Not Found)"
"RTN","PSODEM",37,0)
 I ($P($G(RSLT),"^",2)["Not Found")&($P($G(RSLT),"^",3)>.01) S ZDSPL="  CrCL: "_$P(RSLT,"^",2)_"  (CREAT: "_$P($G(RSLT),"^",3)_"mg/dL "_$P($G(RSLT),"^")_")"
"RTN","PSODEM",38,0)
 I ($P($G(RSLT),"^",2)>0)&($P($G(RSLT),"^",3)>.01) S ZDSPL="  CrCL: "_$P(RSLT,"^",2)_"(est.)"_" (CREAT: "_$P($G(RSLT),"^",3)_"mg/dL "_$P($G(RSLT),"^")_")"
"RTN","PSODEM",39,0)
 W !,ZDSPL,?40," BSA (m2): ",PSOBSA K PSOBSA,ZDSPL,RSLT
"RTN","PSODEM",40,0)
 ;
"RTN","PSODEM",41,0)
 S PSLC=0 G MA:$P($G(^DPT(DFN,.17)),"^",2)'="I"
"RTN","PSODEM",42,0)
 I '$D(VAEL(1)) D ELIG^VADPT W !!,"ELIGIBILITY: ",$P(VAEL(1),"^",2) W:+VAEL(3) ?$X+5,"SC%: "_$P(VAEL(3),"^",2) S PSLC=PSLC+2
"RTN","PSODEM",43,0)
MA K SC W !,"DISABILITIES: " S PSLC=PSLC+2
"RTN","PSODEM",44,0)
 F I=0:0 S I=$O(^DPT(DFN,.372,I)) Q:'I  S I1=$S($D(^DPT(DFN,.372,I,0)):^(0),1:"") D:+I1
"RTN","PSODEM",45,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","PSODEM",46,0)
 .X:($X+$L(PSDIS)+7)>(IOM-8) "W !?14 S PSLC=PSLC+1" W PSDIS,"-",PSCNT,"% (",$S($P(I1,"^",3):"SC",1:"NSC"),"), "
"RTN","PSODEM",47,0)
 .I $E(IOST)="C",$Y+4>IOSL,$D(PSTYPE) K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR,DTOUT W @IOF,?13
"RTN","PSODEM",48,0)
 X "N X S X=""GMRADPT"" X ^%ZOSF(""TEST"") Q" I $T D:'$D(PSOPTPST) GMRA
"RTN","PSODEM",49,0)
Q  K SC,I1,VAROOT,Y,AL,I,X,Y,PSCNT,PSLC,PSDIS D:$G(PSTYPE)']"" KVA^VADPT Q
"RTN","PSODEM",50,0)
GMRA K ^TMP($J,"AL") S GMRA="0^0^111" D ^GMRADPT I GMRAL D
"RTN","PSODEM",51,0)
 .F DR=0:0 S DR=$O(GMRAL(DR)) Q:'DR  S ^TMP($J,"AL",$S('$P(GMRAL(DR),"^",5):1,1:2),$P(GMRAL(DR),"^",7),$P(GMRAL(DR),"^",2))=""
"RTN","PSODEM",52,0)
 .W !!,"ALLERGIES: " S (DR,TY)="" F I=0:0 S TY=$O(^TMP($J,"AL",1,TY)) Q:TY=""  F D=0:0 S DR=$O(^TMP($J,"AL",1,TY,DR)) Q:DR=""  W:$X+$L(DR)+$L(", ")>IOM !?11 W DR_", " D
"RTN","PSODEM",53,0)
 ..I $E(IOST)="C",$Y+4>IOSL,$D(PSTYPE) W ! K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR,DTOUT W @IOF,?18
"RTN","PSODEM",54,0)
 .W !!,"ADVERSE REACTIONS: " S (DR,TY)="" F I=0:0 S TY=$O(^TMP($J,"AL",2,TY)) Q:TY=""  F D=0:0 S DR=$O(^TMP($J,"AL",2,TY,DR)) Q:DR=""  W:$X+$L(DR)+$L(", ")>IOM !?19 W DR_", " D
"RTN","PSODEM",55,0)
 ..I $E(IOST)="C",$Y+4>IOSL,$D(PSTYPE) W ! K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR,DTOUT W @IOF,?18
"RTN","PSODEM",56,0)
 I $G(GMRAL)']"" F AD="ALLERGIES:","ADVERSE REACTIONS:" W !!,AD I $G(PSOFROM)="" F ADL=1:1:IOM-($L(AD)+5) W "_"
"RTN","PSODEM",57,0)
 I GMRAL=0 W !!,"ALLERGIES: NKA",!!,"ADVERSE REACTIONS:"
"RTN","PSODEM",58,0)
 W ! K TY,D,I,GMRA,GMRAL,DR,AD,ADL,^TMP($J,"AL") Q
"RTN","PSODEMSB")
0^7^B62505884
"RTN","PSODEMSB",1,0)
PSODEMSB ;EPIP/RTW - PSODEM subroutines ; 7/29/17 3:24pm
"RTN","PSODEMSB",2,0)
 ;;7.0;OUTPATIENT PHARMACY;**452**;Dec 1997;Build 56
"RTN","PSODEMSB",3,0)
 ;------------------------------------------------------------------
"RTN","PSODEMSB",4,0)
 ; External reference  to $$OUTPTTM^SDUTL3  supported by ICR  1252
"RTN","PSODEMSB",5,0)
 ; External reference  to ^DIE              supported by ICR  2022
"RTN","PSODEMSB",6,0)
 ; External references to $$GET1^DIQ        supported by ICR  2056
"RTN","PSODEMSB",7,0)
 ; External reference  to ^PS(55            supported by ICR  2228
"RTN","PSODEMSB",8,0)
 ; External reference  to $$GETALL^SCAPMCA  supported by ICR  2848
"RTN","PSODEMSB",9,0)
 ; External reference  to VST^ORWCV         supported by ICR  4211
"RTN","PSODEMSB",10,0)
 ; External reference  to $$SDAPI^SDMACA301 supported by ICR  4433
"RTN","PSODEMSB",11,0)
 ; External reference  to ^DD("DILOCKTM"    supported by ICR  4909
"RTN","PSODEMSB",12,0)
 ; External reference  to ^DIC              supported by ICR 10006
"RTN","PSODEMSB",13,0)
 ; External reference  to ^DIR              supported by ICR 10026
"RTN","PSODEMSB",14,0)
 ; External reference  to ^DPT(             supported by ICR 10035
"RTN","PSODEMSB",15,0)
 ; External reference  to ^VA(200           supported by ICR 10060
"RTN","PSODEMSB",16,0)
 ; External reference  to LOCK^DILF($NA(    supported by ICR  2054
"RTN","PSODEMSB",17,0)
 ;------------------------------------------------------------------
"RTN","PSODEMSB",18,0)
DEMOG(PSODFN) ;
"RTN","PSODEMSB",19,0)
 ;     Extend patient demographics with PC Team, Current Facility
"RTN","PSODEMSB",20,0)
 ;     Remarks, and Clinical Alerts, pause the screen until <Enter>
"RTN","PSODEMSB",21,0)
 ; Input:
"RTN","PSODEMSB",22,0)
 ;   DFN ; Required ; IEN of Patient file (#2) entry
"RTN","PSODEMSB",23,0)
 ;
"RTN","PSODEMSB",24,0)
 Q:$D(XQORNOD(0))
"RTN","PSODEMSB",25,0)
 N PSOTEAM,PSOCLINA,DIR,DIRUT,PG,X,Y
"RTN","PSODEMSB",26,0)
 I $G(XQY0)["PSO P",($I=$P) D  ;
"RTN","PSODEMSB",27,0)
 . W !
"RTN","PSODEMSB",28,0)
 . S DIR("T")=DTIME,DIR(0)="EA",DIR("A")="Press <Enter> to continue: " D ^DIR
"RTN","PSODEMSB",29,0)
 ;
"RTN","PSODEMSB",30,0)
 S PG=0
"RTN","PSODEMSB",31,0)
 D PCTEAM(PSODFN)
"RTN","PSODEMSB",32,0)
 I 'PSOTEAM W !! D HDR("Extended Patient Demographics:")
"RTN","PSODEMSB",33,0)
 D REMARKS(PSODFN)
"RTN","PSODEMSB",34,0)
 W !?1,"Assigned/Recent Facility: ",$$CURRFAC(PSODFN)
"RTN","PSODEMSB",35,0)
 D CA(PSODFN)
"RTN","PSODEMSB",36,0)
 Q:$D(DIRUT)
"RTN","PSODEMSB",37,0)
 I $G(XQY0)'["OR CPRS GUI CHART",($I=$P) D  ;
"RTN","PSODEMSB",38,0)
 . W !
"RTN","PSODEMSB",39,0)
 . S DIR("T")=DTIME,DIR(0)="EA",DIR("A")="Press <Enter> to continue: " D ^DIR
"RTN","PSODEMSB",40,0)
 Q
"RTN","PSODEMSB",41,0)
 ;------------------------------------------------------------------
"RTN","PSODEMSB",42,0)
CA(PSODFN) ; Print PHARMACY PATIENT CLINICAL ALERTS multiple field (#2)
"RTN","PSODEMSB",43,0)
 ; Input:
"RTN","PSODEMSB",44,0)
 ;   DFN ; Required ; IEN of Patient file (#2) entry
"RTN","PSODEMSB",45,0)
 ;
"RTN","PSODEMSB",46,0)
 N PSOFLAG1,PSODATER
"RTN","PSODEMSB",47,0)
 ;
"RTN","PSODEMSB",48,0)
 Q:'$G(PSODFN)  ; Quit, if no Patient IEN
"RTN","PSODEMSB",49,0)
 Q:'$P($G(^PS(55,PSODFN,2,0)),U,4)  ; No CLINICAL ALERTS
"RTN","PSODEMSB",50,0)
 ;
"RTN","PSODEMSB",51,0)
 S PSOFLAG1=1,PSOCLINA=0 ; First time flag to display field header
"RTN","PSODEMSB",52,0)
 ;
"RTN","PSODEMSB",53,0)
 ; PSODATER format DINUMed: 9999999.999999-CLINICAL ALERT DATE/TIME
"RTN","PSODEMSB",54,0)
 S PSODATER=0
"RTN","PSODEMSB",55,0)
 F  S PSODATER=$O(^PS(55,PSODFN,2,PSODATER)) Q:'PSODATER  D  Q:$D(DIRUT)  ;
"RTN","PSODEMSB",56,0)
 . I PSOFLAG1=1 W !!,"Clinical Alerts:" S PSOFLAG1=0
"RTN","PSODEMSB",57,0)
 . ; Display CLINICAL ALERT DATE/TIME (#.01) & CLINICAL ALERT (#1)
"RTN","PSODEMSB",58,0)
 . W !!,?2,$$GET1^DIQ(55.0109,PSODATER_","_PSODFN,.01)
"RTN","PSODEMSB",59,0)
 . W "  ",$$GET1^DIQ(55.0109,PSODATER_","_PSODFN,1)
"RTN","PSODEMSB",60,0)
 . I 'PG!($Y+7>IOSL),$O(^PS(55,PSODFN,2,PSODATER)) D HDR("Clinical Alerts:")
"RTN","PSODEMSB",61,0)
 Q
"RTN","PSODEMSB",62,0)
 ;------------------------------------------------------------------
"RTN","PSODEMSB",63,0)
HDR(HDR) ;
"RTN","PSODEMSB",64,0)
 N DIR
"RTN","PSODEMSB",65,0)
 W !
"RTN","PSODEMSB",66,0)
 I PG,($I=$P) S DIR("T")=DTIME,DIR(0)="EA",DIR("A")="Type <Enter> to continue or '^' to exit Clinical Alerts:" D ^DIR I $D(DIRUT) Q
"RTN","PSODEMSB",67,0)
 I HDR]"" W @IOF S PG=$G(PG)+1 W HDR,?70,"Page: ",PG,! S $Y=1
"RTN","PSODEMSB",68,0)
 Q
"RTN","PSODEMSB",69,0)
CURRFAC(PSODFN) ; Return: The Assigned/Recent Facility INSTITUTION for the Patient's DFN
"RTN","PSODEMSB",70,0)
 ; Input:
"RTN","PSODEMSB",71,0)
 ;   DFN ; Required ; IEN of Patient file (#2) entry
"RTN","PSODEMSB",72,0)
 ;
"RTN","PSODEMSB",73,0)
 N DATA,DTBEG,DTEND,FLAGQ,IEN4,ORVISIT,PCTEAM,PREVSCDT,RETURN,SUB
"RTN","PSODEMSB",74,0)
 ;
"RTN","PSODEMSB",75,0)
 S RETURN="" ; Default return value is null
"RTN","PSODEMSB",76,0)
 ;
"RTN","PSODEMSB",77,0)
 I $$GET1^DIQ(2,PSODFN,.351,"I") Q RETURN ; .351 Patient DATE OF DEATH
"RTN","PSODEMSB",78,0)
 ;
"RTN","PSODEMSB",79,0)
 ; The first choice for returning the INSTITUTION would be the
"RTN","PSODEMSB",80,0)
 ; INSTITUTION field (#.07) of the TEAM file (#404.51)
"RTN","PSODEMSB",81,0)
 ;
"RTN","PSODEMSB",82,0)
 S PCTEAM=$$OUTPTTM^SDUTL3(PSODFN,DT,1) ; IEN^NAME of file (#404.51) ; ICR #1252
"RTN","PSODEMSB",83,0)
 ; *** End   patch #1 change #1 by R2/Confer on 08/07/2015
"RTN","PSODEMSB",84,0)
 I +PCTEAM>0 D  Q RETURN
"RTN","PSODEMSB",85,0)
 . S RETURN=$$GET1^DIQ(404.51,+PCTEAM,.07) ; INSTITUTION [R*P4']
"RTN","PSODEMSB",86,0)
 ;
"RTN","PSODEMSB",87,0)
 ; Return future appointments and past visits for a patient
"RTN","PSODEMSB",88,0)
 ;
"RTN","PSODEMSB",89,0)
 S DTBEG=DT-20000 ; Begin with TODAY - 2 years
"RTN","PSODEMSB",90,0)
 S DTEND=DT+20000 ; End   with TODAY + 2 years
"RTN","PSODEMSB",91,0)
 D VST^ORWCV(.ORVISIT,PSODFN,DTBEG,DTEND) ; ICR #4211
"RTN","PSODEMSB",92,0)
 ;
"RTN","PSODEMSB",93,0)
 ; Process ORVISIT array in reverse chronological order.  Quantify
"RTN","PSODEMSB",94,0)
 ; visits & appointments based upon the INSTITUTION pointer field (#3)
"RTN","PSODEMSB",95,0)
 ; of the HOSPITAL LOCATION file (#44).  Once the count reaches
"RTN","PSODEMSB",96,0)
 ; 3 for a given INSTITUTION, that INSTITUION is returned.
"RTN","PSODEMSB",97,0)
 ;
"RTN","PSODEMSB",98,0)
 S FLAGQ=0 ; Quit flag, set to 1 once the Institution is determined
"RTN","PSODEMSB",99,0)
 S PREVSCDT="" ; Previous appt/visit date
"RTN","PSODEMSB",100,0)
 S SUB=":" ;.... Sequential number of ORVISIT array subscript
"RTN","PSODEMSB",101,0)
 F  S SUB=$O(ORVISIT(SUB),-1) Q:'SUB!FLAGQ  D  ;
"RTN","PSODEMSB",102,0)
 . N DATA,SC,SCDT
"RTN","PSODEMSB",103,0)
 . S DATA=ORVISIT(SUB)
"RTN","PSODEMSB",104,0)
 . S SC=$P($P(DATA,U),";",3) Q:'SC  ; HOSPITAL LOCATION file (#44) IEN
"RTN","PSODEMSB",105,0)
 . S IEN4=+$$GET1^DIQ(44,SC,3,"I") ; INSTITUTION file (#4) IEN
"RTN","PSODEMSB",106,0)
 . S SCDT=$P($P(DATA,U),";",2) Q:'SCDT  ; Appt/visit date (fm format)
"RTN","PSODEMSB",107,0)
 . S SCDT=$P(SCDT,".") ; Strip the time
"RTN","PSODEMSB",108,0)
 . Q:SCDT=PREVSCDT  ; Appt/visit must be a N day
"RTN","PSODEMSB",109,0)
 . I '$D(IEN4(IEN4)) S IEN4(IEN4)=0 ; Initialize INSTITUTION counter
"RTN","PSODEMSB",110,0)
 . S IEN4(IEN4)=IEN4(IEN4)+1 ; Quantify by INSTITUTION ien
"RTN","PSODEMSB",111,0)
 . I IEN4(IEN4)=3 D  Q  ; When count reaches 3, INSTITUTION found
"RTN","PSODEMSB",112,0)
 . . S RETURN=$$GET1^DIQ(4,IEN4,.01) ; INSTITUTION NAME (#.01)
"RTN","PSODEMSB",113,0)
 . . S FLAGQ=1
"RTN","PSODEMSB",114,0)
 . ;
"RTN","PSODEMSB",115,0)
 . S PREVSCDT=SCDT ; Save as previous appt/visit date
"RTN","PSODEMSB",116,0)
 ;
"RTN","PSODEMSB",117,0)
 ; IF  no PCTEAM INSTITUTION
"RTN","PSODEMSB",118,0)
 ; AND three appt/visits were not found for an INSTITUTION ien
"RTN","PSODEMSB",119,0)
 ; AND at least one appt/visit was found
"RTN","PSODEMSB",120,0)
 ; THEN
"RTN","PSODEMSB",121,0)
 ;     return the most recent appt/visit INSTITUTION
"RTN","PSODEMSB",122,0)
 ;
"RTN","PSODEMSB",123,0)
 I RETURN="" D  ;
"RTN","PSODEMSB",124,0)
 . N DATA,IEN4,SC,SUB
"RTN","PSODEMSB",125,0)
 . S SUB=$O(ORVISIT(":"),-1) Q:'SUB
"RTN","PSODEMSB",126,0)
 . S DATA=ORVISIT(SUB)
"RTN","PSODEMSB",127,0)
 . S SC=$P($P(DATA,U),";",3) Q:'SC  ; HOSPITAL LOCATION file (#44) IEN
"RTN","PSODEMSB",128,0)
 . S IEN4=$$GET1^DIQ(44,SC,3,"I") ; INSTITUTION file (#4) IEN
"RTN","PSODEMSB",129,0)
 . S RETURN=$$GET1^DIQ(4,IEN4,.01) ; INSTITUTION file (#4) NAME (#.01)
"RTN","PSODEMSB",130,0)
 ;
"RTN","PSODEMSB",131,0)
 Q RETURN
"RTN","PSODEMSB",132,0)
 ;------------------------------------------------------------------
"RTN","PSODEMSB",133,0)
PCTEAM(PSODFN) ; Display current PC TEAM, PC Provider, and phone.
"RTN","PSODEMSB",134,0)
 ; Input:
"RTN","PSODEMSB",135,0)
 ;   DFN ; Required ; IEN of Patient file (#2) entry
"RTN","PSODEMSB",136,0)
 ;
"RTN","PSODEMSB",137,0)
 S PSOTEAM=0
"RTN","PSODEMSB",138,0)
 N DATA,PAGER,PCPOS,PCPROV,PCPROVI,PHONE,PCTM
"RTN","PSODEMSB",139,0)
 N SCDT2,SCP,SDI,TEAM,TEAMI
"RTN","PSODEMSB",140,0)
 ;
"RTN","PSODEMSB",141,0)
 S PCTM="^TMP(""SDPLIST"",$J)"
"RTN","PSODEMSB",142,0)
 K @PCTM
"RTN","PSODEMSB",143,0)
 S SDI=$$GETALL^SCAPMCA(PSODFN,DT,PCTM) Q:'SDI  ; ICR #2848
"RTN","PSODEMSB",144,0)
 S SDI=0
"RTN","PSODEMSB",145,0)
 F  S SDI=$O(^TMP("SDPLIST",$J,PSODFN,"PCTM",SDI)) Q:'SDI  D  ;
"RTN","PSODEMSB",146,0)
 . ;
"RTN","PSODEMSB",147,0)
 . ; "PCTM" node (PC Team)
"RTN","PSODEMSB",148,0)
 . S PSOTEAM=1
"RTN","PSODEMSB",149,0)
 . S DATA=$G(^TMP("SDPLIST",$J,PSODFN,"PCTM",SDI)) Q:DATA=""
"RTN","PSODEMSB",150,0)
 . S TEAMI=$P(DATA,U,1) ; IEN  of TEAM file (#404.51)
"RTN","PSODEMSB",151,0)
 . S TEAM=$P(DATA,U,2) ;. NAME of TEAM file entry
"RTN","PSODEMSB",152,0)
 . ;
"RTN","PSODEMSB",153,0)
 . ; "PCPR" node (PC Provider)
"RTN","PSODEMSB",154,0)
 . S DATA=$G(^TMP("SDPLIST",$J,PSODFN,"PCPR",SDI))
"RTN","PSODEMSB",155,0)
 . S PCPROVI=+$P(DATA,U,1) ; IEN of PC Provider
"RTN","PSODEMSB",156,0)
 . S PCPROV=$P(DATA,U,2) ;. PC Provider
"RTN","PSODEMSB",157,0)
 . S PCPOS=$P(DATA,U,4) ;.. PC Provider Position
"RTN","PSODEMSB",158,0)
 . S PAGER=$$GET1^DIQ(200,PCPROVI,.138) ; DIGITAL PAGER
"RTN","PSODEMSB",159,0)
 . S:PAGER="" PAGER=$$GET1^DIQ(200,PCPROVI,.137) ;  VOICE PAGER
"RTN","PSODEMSB",160,0)
 . S PHONE=$$GET1^DIQ(200,PCPROVI,.132) ; OFFICE PHONE
"RTN","PSODEMSB",161,0)
 . ;
"RTN","PSODEMSB",162,0)
 . I PSOTEAM W !! D HDR("Extended Patient Demographics:")
"RTN","PSODEMSB",163,0)
 . ;
"RTN","PSODEMSB",164,0)
 . W !," Primary Care Team: ",TEAM
"RTN","PSODEMSB",165,0)
 . W ?52,"   Phone: ",$$GET1^DIQ(404.51,TEAMI,.02) ; TEAM PHONE NUMBER
"RTN","PSODEMSB",166,0)
 . ;
"RTN","PSODEMSB",167,0)
 . W !,"       PC Provider: ",PCPROV
"RTN","PSODEMSB",168,0)
 . W ?52,"Position: ",$E(PCPOS,1,18)
"RTN","PSODEMSB",169,0)
 . ;
"RTN","PSODEMSB",170,0)
 . W !?13,"Pager: ",PAGER
"RTN","PSODEMSB",171,0)
 . W ?52,"   Phone: ",PHONE
"RTN","PSODEMSB",172,0)
 ;
"RTN","PSODEMSB",173,0)
 K @PCTM
"RTN","PSODEMSB",174,0)
 Q
"RTN","PSODEMSB",175,0)
 ;------------------------------------------------------------------
"RTN","PSODEMSB",176,0)
REMARKS(PSODFN) ; Display PATIENT file (#2) REMARKS field (#.091)
"RTN","PSODEMSB",177,0)
 ; Input:
"RTN","PSODEMSB",178,0)
 ;   DFN ; Required ; IEN of Patient file (#2) entry
"RTN","PSODEMSB",179,0)
 ;
"RTN","PSODEMSB",180,0)
 W !?11,"Remarks: ",$$GET1^DIQ(2,PSODFN_",",.091)
"RTN","PSODEMSB",181,0)
 ;
"RTN","PSODEMSB",182,0)
 Q
"RTN","PSODEMSB",183,0)
 ;------------------------------------------------------------------
"RTN","PSODEMSB",184,0)
ENTER ; PSO CLINICAL ENTER/EDIT OPTION ENTRY POINT.
"RTN","PSODEMSB",185,0)
 N PSODFN
"RTN","PSODEMSB",186,0)
PROMPT ;
"RTN","PSODEMSB",187,0)
 W @IOF,!?1,"*** CLINICAL ALERT ENTER/EDIT ***"
"RTN","PSODEMSB",188,0)
START ;
"RTN","PSODEMSB",189,0)
 W !
"RTN","PSODEMSB",190,0)
 S PSODFN=+$$PATIENT G:'PSODFN EXIT  W ! ; Prompt for Select PHARMACY PATIENT
"RTN","PSODEMSB",191,0)
 D EDITCA(PSODFN) ; Edit CLINICAL ALERTS (multiple)
"RTN","PSODEMSB",192,0)
 G START
"RTN","PSODEMSB",193,0)
 ;
"RTN","PSODEMSB",194,0)
EXIT ;
"RTN","PSODEMSB",195,0)
 Q
"RTN","PSODEMSB",196,0)
 ;------------------------------------------------------------------
"RTN","PSODEMSB",197,0)
EDITCA(PSODFN) ; Edit the CLINICAL ALERTS multiple (#109) of file (#55)
"RTN","PSODEMSB",198,0)
 ; Input:
"RTN","PSODEMSB",199,0)
 ;   DFN ; Patient file (#2) entry internal entry number
"RTN","PSODEMSB",200,0)
 ;
"RTN","PSODEMSB",201,0)
 NEW %,%X,%Y,D,D0,D1,DA,DG,DI,DIC,DIDEL,DIE,DIERR,DIW,DQ,DR,DTOUT,X
"RTN","PSODEMSB",202,0)
 ;
"RTN","PSODEMSB",203,0)
 S DA=PSODFN
"RTN","PSODEMSB",204,0)
 S DIE="^PS(55,",DR="[PSO CLINICAL ALERT ENTER/EDIT]"
"RTN","PSODEMSB",205,0)
 ;
"RTN","PSODEMSB",206,0)
 D LOCK^DILF($NA(^PS(55,DA))) E  D  Q
"RTN","PSODEMSB",207,0)
 . W $C(7),!?4
"RTN","PSODEMSB",208,0)
 . W "Patient ",$$GET1^DIQ(2,DA,.01)," is being edited by another user."
"RTN","PSODEMSB",209,0)
 D ^DIE
"RTN","PSODEMSB",210,0)
 LOCK -^PS(55,DA)
"RTN","PSODEMSB",211,0)
 ;
"RTN","PSODEMSB",212,0)
 Q
"RTN","PSODEMSB",213,0)
 ;-----------------------------------------------------------------
"RTN","PSODEMSB",214,0)
PATIENT() ; Extrinsic, prompt for 'Select PHARMACY PATIENT: '
"RTN","PSODEMSB",215,0)
 ; Output:
"RTN","PSODEMSB",216,0)
 ;   IEN^Name ; Of the selected Pharmacy Patient file #55 entry
"RTN","PSODEMSB",217,0)
 ;              Return null if no patient selected
"RTN","PSODEMSB",218,0)
 ;
"RTN","PSODEMSB",219,0)
 N %,%H,%I,%X,%Y,C,D,D0,DA,DDH,DG,DIC,DILN,DINUM,DIPGM,DIY
"RTN","PSODEMSB",220,0)
 N DLAYGO,DTOUT,DUOUT,I,RETURN,X,Y
"RTN","PSODEMSB",221,0)
 ;
"RTN","PSODEMSB",222,0)
 S RETURN=""
"RTN","PSODEMSB",223,0)
 S DIC="^PS(55,"
"RTN","PSODEMSB",224,0)
 S DIC(0)="AEMQZ"
"RTN","PSODEMSB",225,0)
 D ^DIC I Y>0 S RETURN=+Y_"^"_Y(0,0)
"RTN","PSODEMSB",226,0)
 ;
"RTN","PSODEMSB",227,0)
 Q RETURN
"RTN","PSODEMSB",228,0)
 ;
"RTN","PSODEMSB",229,0)
APPT() ; get appointments up to +/-2 yrs from now
"RTN","PSODEMSB",230,0)
 ;  return null or name of institution
"RTN","PSODEMSB",231,0)
 ;  ICR# 10061 - VADPT supported
"RTN","PSODEMSB",232,0)
 ;  ICR# 10040 - FM read of file 44, field 3 supported
"RTN","PSODEMSB",233,0)
 ;  ICR# 2171  - $$NS^XUAF4
"RTN","PSODEMSB",234,0)
 N I,X,Y,DIV,F4,GL,NOW,VAERR,VAST,XI,XE
"RTN","PSODEMSB",235,0)
 S GL=$NA(^UTILITY("VASD",$J)) K @GL
"RTN","PSODEMSB",236,0)
 S NOW=$$NOW^XLFDT
"RTN","PSODEMSB",237,0)
 S VASD("F")=DT-20000
"RTN","PSODEMSB",238,0)
 S VASD("T")=DT+20000
"RTN","PSODEMSB",239,0)
 D SDA^VADPT
"RTN","PSODEMSB",240,0)
 ;   div("F",inst)=total count of visits
"RTN","PSODEMSB",241,0)
 ;   div("F",0) = appt_dt ^ inst_ptr
"RTN","PSODEMSB",242,0)
 ;   div("P") set up similarly for past kept appointments
"RTN","PSODEMSB",243,0)
 ;   ^utility("VASD",$j,inc,"I"/"E")=appt_dt^clinic^status^appt_type
"RTN","PSODEMSB",244,0)
 ;   only use one visit per day for division count
"RTN","PSODEMSB",245,0)
 ;   if institution has more than 2 future appts, use that
"RTN","PSODEMSB",246,0)
 ;   if institution has more than 2 past appts, use that
"RTN","PSODEMSB",247,0)
 ;   if future appts, use institution of next appt
"RTN","PSODEMSB",248,0)
 ;   if past appts, use institution of last appt
"RTN","PSODEMSB",249,0)
 ;   use ^UTILITY("VASD",$J,"D",DATE)="" to track visit days
"RTN","PSODEMSB",250,0)
 S F4="",I=0 F  S I=$O(@GL@(I)) Q:'I  S XI=^(I,"I"),XE=^("E") D  Q:F4>2
"RTN","PSODEMSB",251,0)
 . N CL,APPT,DATE,INST
"RTN","PSODEMSB",252,0)
 . S APPT=+XI,CL=+$P(XI,U,2) Q:'CL
"RTN","PSODEMSB",253,0)
 . S DATE=$P(APPT,".") Q:$D(@GL@("D",DATE))  S ^(DATE)=""
"RTN","PSODEMSB",254,0)
 . S INST=+$$GET1^DIQ(44,SC,3,"I") Q:'INST
"RTN","PSODEMSB",255,0)
 . I APPT>NOW D
"RTN","PSODEMSB",256,0)
 . . S Y=1+$G(DIV("F",INST)) I Y>2 S F4=INST Q
"RTN","PSODEMSB",257,0)
 . . S DIV("F",INST)=Y I '$D(DIV("F",0)) S DIV("F",0)=APPT_U_INST Q
"RTN","PSODEMSB",258,0)
 . . I APPT<DIV("F",0) S DIV("F",0)=APPT_U_INST
"RTN","PSODEMSB",259,0)
 . . Q
"RTN","PSODEMSB",260,0)
 . I APPT'>NOW D
"RTN","PSODEMSB",261,0)
 . . S Y=1+$G(DIV("P",INST)),DIV("F",INST)=Y
"RTN","PSODEMSB",262,0)
 . . I '$D(DIV("P",0)) S DIV("F",0)=APPT_U_INST Q
"RTN","PSODEMSB",263,0)
 . . I APPT>DIV("P",0) S DIV("F",0)=APPT_U_INST
"RTN","PSODEMSB",264,0)
 . . Q
"RTN","PSODEMSB",265,0)
 . Q
"RTN","PSODEMSB",266,0)
 I 'F4 S (I,X,Y)=0 D
"RTN","PSODEMSB",267,0)
 . F  S I=$O(DIV("P",I)) Q:'I  I DIV("P",I)>Y S X=I,Y=DIV("P",I)
"RTN","PSODEMSB",268,0)
 . I X,Y>2 S F4=X Q
"RTN","PSODEMSB",269,0)
 . S X=$G(DIV("F",0)) I +X S F4=$P(X,U,2) Q
"RTN","PSODEMSB",270,0)
 . S X=$G(DIV("P",0)) I +X S F4=$P(X,U,2)
"RTN","PSODEMSB",271,0)
 . Q
"RTN","PSODEMSB",272,0)
 I F4 S F4=$P($$NS^XUAF4(F4),U)
"RTN","PSODEMSB",273,0)
 K @GL
"RTN","PSODEMSB",274,0)
 Q F4
"RTN","PSODIR4")
0^8^B57253130
"RTN","PSODIR4",1,0)
PSODIR4 ;EPIP/RTW - Outpatient Site High Cost Related Calls ; 3/30/18 11:30am
"RTN","PSODIR4",2,0)
 ;;7.0;OUTPATIENT PHARMACY;**452**;Dec 1997;Build 56
"RTN","PSODIR4",3,0)
 ;------------------------------------------------------------------
"RTN","PSODIR4",4,0)
 ; ICR#     TYPE    DESCRIPTION
"RTN","PSODIR4",5,0)
 ;-----  ---------  --------------------------------------------
"RTN","PSODIR4",6,0)
 ; 2056  Supported  $$GET1^DIQ
"RTN","PSODIR4",7,0)
 ;10026  Supported  ^DIR
"RTN","PSODIR4",8,0)
 ;------------------------------------------------------------------
"RTN","PSODIR4",9,0)
OPTSITE(PSOTRGET,PSORTN,PSOSCREN) ; Prompt for Outpatient Site when the host site
"RTN","PSODIR4",10,0)
 ; has multiple OUTPATIENT SITE file (#59) entries.
"RTN","PSODIR4",11,0)
 ;
"RTN","PSODIR4",12,0)
 ; Input:
"RTN","PSODIR4",13,0)
 ;   PSOTRGET ; Required ; Name of output variable/array, passed by
"RTN","PSODIR4",14,0)
 ;                       reference.
"RTN","PSODIR4",15,0)
 ;   PSORTN    ; Required ; Name of calling routine, usually $T(+0)
"RTN","PSODIR4",16,0)
 ;   PSOSCREN ; Optional ;
"RTN","PSODIR4",17,0)
 ;            0 ; By default, no screening of entries will take place
"RTN","PSODIR4",18,0)
 ;            1 ; Optionally, only active OUTPATIENT SITE entries
"RTN","PSODIR4",19,0)
 ; Output:  ;
"RTN","PSODIR4",20,0)
 ;   The passed name of the PSOTRGET will be used in all output as
"RTN","PSODIR4",21,0)
 ;   follows:
"RTN","PSODIR4",22,0)
 ;     PSOTRGET=User's response from FM DIR API prompt
"RTN","PSODIR4",23,0)
 ;     PSOTRGET(PSOIEN59)=NAME (of OUTPATIENT SITE file (#59) entry)
"RTN","PSODIR4",24,0)
 ;     PSOTRGET("PSOSCNT")=Number of selected OUTPATIENT SITE entries
"RTN","PSODIR4",25,0)
 ;                   - or -
"RTN","PSODIR4",26,0)
 ;     PSOTRGET="^" ; If an error occurs, user times out or enters '^'
"RTN","PSODIR4",27,0)
 ;
"RTN","PSODIR4",28,0)
 ; Intended usage:
"RTN","PSODIR4",29,0)
 ;   List the host computer's OUTPATIENT SITE entries allowing
"RTN","PSODIR4",30,0)
 ;   the user to select any combination of those entries, for example
"RTN","PSODIR4",31,0)
 ;   if there are 5 active OUTPATIENT SITEs, the user can select one
"RTN","PSODIR4",32,0)
 ;   of the following: 1  1-3  1,2,5
"RTN","PSODIR4",33,0)
 ;
"RTN","PSODIR4",34,0)
 ; Example calls:
"RTN","PSODIR4",35,0)
 ;   1. Allow both active and/or inactive entries to be selected:
"RTN","PSODIR4",36,0)
 ;      D OPTSITE^PSODIR4(.PSOTRGET,$T(+0)) G:PSOTRGET="^" EXIT
"RTN","PSODIR4",37,0)
 ;   2. Allow only active OUTPATIENT SITE entries to be selected:
"RTN","PSODIR4",38,0)
 ;      D OPTSITE^PSODIR4(.PSOTRGET,$T(+0),1) G:PSOTRGET="^" EXIT
"RTN","PSODIR4",39,0)
 ;
"RTN","PSODIR4",40,0)
 KILL PSOTRGET ; Start with fresh output
"RTN","PSODIR4",41,0)
 S PSOSCREN=$G(PSOSCREN,0) ; Set optional screen to zero (avoid screening)
"RTN","PSODIR4",42,0)
 ;
"RTN","PSODIR4",43,0)
 ; Place selectable  OUTPATIENT SITE entries in array:
"RTN","PSODIR4",44,0)
 ;   PSOINPUT(Sequential#)=PSOIEN59_"^"_PSOSITNM
"RTN","PSODIR4",45,0)
 ; 
"RTN","PSODIR4",46,0)
 N PSOSCNT,PSODTINAC,PSOIEN59,PSOINPUT,PSOEXIT,PSOSITNM
"RTN","PSODIR4",47,0)
 S (PSOSCNT,PSOIEN59)=0 ; PSOSCNT=Count the number of selectable OUTPATIENT SITEs
"RTN","PSODIR4",48,0)
 F  S PSOIEN59=$O(^PS(59,PSOIEN59)) Q:'PSOIEN59  D  ;
"RTN","PSODIR4",49,0)
 . S PSOSITNM=$$GET1^DIQ(59,PSOIEN59,.01) ; OUTPATIENT SITE NAME (#.01)
"RTN","PSODIR4",50,0)
 . I PSOSCREN=1 D  Q:PSOEXIT="^"  ; Keep only active sites
"RTN","PSODIR4",51,0)
 . . S PSOEXIT=0
"RTN","PSODIR4",52,0)
 . . S PSODTINAC=$$GET1^DIQ(59,PSOIEN59,2004,"I") ; INACTIVE DATE (#2004)
"RTN","PSODIR4",53,0)
 . . I PSODTINAC,PSODTINAC'>DT S PSOEXIT="^" Q  ;. Bypass inactive site
"RTN","PSODIR4",54,0)
 . S PSOSCNT=PSOSCNT+1
"RTN","PSODIR4",55,0)
 . S PSOINPUT(PSOSCNT)=PSOIEN59_"^"_PSOSITNM
"RTN","PSODIR4",56,0)
 ;
"RTN","PSODIR4",57,0)
 I PSOSCNT=1 D  Q  ; When PSOSCNT of entries = 1, no need to prompt user
"RTN","PSODIR4",58,0)
 . S PSOIEN59=$P(PSOINPUT(PSOSCNT),U,1),PSOSITNM=$P(PSOINPUT(PSOSCNT),U,2)
"RTN","PSODIR4",59,0)
 . S PSOTRGET(PSOIEN59)=PSOSITNM ; PSOTRGET is the single Outpatient Site
"RTN","PSODIR4",60,0)
 . S PSOTRGET("PSOSCNT")=1,PSOTRGET=""
"RTN","PSODIR4",61,0)
 I PSOSCNT=0 S PSOTRGET="^" Q  ; No active OUTPATIENT SITE entries found
"RTN","PSODIR4",62,0)
 ;
"RTN","PSODIR4",63,0)
 ; Display the selectable  OUTPATIENT SITE entries from the INPUT 
"RTN","PSODIR4",64,0)
 ; array previously created above.
"RTN","PSODIR4",65,0)
 ;
"RTN","PSODIR4",66,0)
 W !
"RTN","PSODIR4",67,0)
 W !,"For RXs written at OUTPATIENT SITE(s):  (Example 1,3 or 1-5)"
"RTN","PSODIR4",68,0)
 ;
"RTN","PSODIR4",69,0)
 N PSOSCNT,PSOIEN59,PSOMAX
"RTN","PSODIR4",70,0)
 S (PSOSCNT,PSOMAX)=0 ; MAX=Count the number of selectable OUTPATIENT SITEs
"RTN","PSODIR4",71,0)
 F  S PSOSCNT=$O(PSOINPUT(PSOSCNT)) Q:'PSOSCNT  D  ;
"RTN","PSODIR4",72,0)
 . S PSOIEN59=$P(PSOINPUT(PSOSCNT),U),PSOSITNM=$P(PSOINPUT(PSOSCNT),U,2)
"RTN","PSODIR4",73,0)
 . W !?3,$J(PSOSCNT,2),")  ",PSOSITNM
"RTN","PSODIR4",74,0)
 . S PSOMAX=PSOMAX+1
"RTN","PSODIR4",75,0)
 ;
"RTN","PSODIR4",76,0)
 ; Prepare for DIR (list or range) API to prompt for selected sites
"RTN","PSODIR4",77,0)
 ;
"RTN","PSODIR4",78,0)
 N %,DA,DIR,DIRUT,DTOUT,DUOUT,I,X,Y ; DIR API variables
"RTN","PSODIR4",79,0)
 N PSODEF
"RTN","PSODIR4",80,0)
 ;
"RTN","PSODIR4",81,0)
 S DIR("A")="Select NUMBER(s): " ;DIR prompt text
"RTN","PSODIR4",82,0)
 S PSODEF=$G(^DISV(DUZ,PSORTN,"PSOSITE"),"1-"_PSOMAX) S:PSODEF]"" DIR("B")=PSODEF
"RTN","PSODIR4",83,0)
 ; Note: Previously defaulted site might be inactivated, making the
"RTN","PSODIR4",84,0)
 ;       previous default range too large
"RTN","PSODIR4",85,0)
 I $P(DIR("B"),"-",2)>PSOMAX S DIR("B")="1-"_PSOMAX
"RTN","PSODIR4",86,0)
 ;
"RTN","PSODIR4",87,0)
 ; DIR(0) notes
"RTN","PSODIR4",88,0)
 ;  L=List or range format  A=Nothing can be appended to DIC("A")
"RTN","PSODIR4",89,0)
 ;                          O=User response is prompt is optional
"RTN","PSODIR4",90,0)
 ;  Select from 1 to MAXimum selectable range
"RTN","PSODIR4",91,0)
 S DIR(0)="LAO^1:"_PSOMAX ; User may select list or range from 1 to PSOMAX
"RTN","PSODIR4",92,0)
 ;
"RTN","PSODIR4",93,0)
 D ^DIR
"RTN","PSODIR4",94,0)
 ;
"RTN","PSODIR4",95,0)
 I $G(DTOUT) S PSOTRGET="^" Q  ; User time out at DIR prompt
"RTN","PSODIR4",96,0)
 S PSOTRGET=X I PSOTRGET["^" S PSOTRGET="^" Q  ;User up-arrow out at DIR prompt
"RTN","PSODIR4",97,0)
 ;
"RTN","PSODIR4",98,0)
 ; Build output PSOTRGET(PSOIEN59)=PSOSITNM from the comma delimited
"RTN","PSODIR4",99,0)
 ; output varible Y of the FM DIR API.  Example DIR output: Y="1,3,5,"
"RTN","PSODIR4",100,0)
 ;
"RTN","PSODIR4",101,0)
 N PSOIEN59,PCE,SUB
"RTN","PSODIR4",102,0)
 F PCE=1:1 S SUB=$P(Y,",",PCE) Q:'SUB  D  ;
"RTN","PSODIR4",103,0)
 . S PSOIEN59=$P(PSOINPUT(SUB),U,1),PSOSITNM=$P(PSOINPUT(SUB),U,2)
"RTN","PSODIR4",104,0)
 . S PSOTRGET(PSOIEN59)=PSOSITNM
"RTN","PSODIR4",105,0)
 S PSOTRGET("PSOSCNT")=$L(Y,",")-1 ; Number of selected PSOTRGET entries
"RTN","PSODIR4",106,0)
 ;
"RTN","PSODIR4",107,0)
 S:PSOTRGET'["^" ^DISV(DUZ,PSORTN,"PSOSITE")=PSOTRGET ; Next default
"RTN","PSODIR4",108,0)
 ;
"RTN","PSODIR4",109,0)
 Q
"RTN","PSODIR4",110,0)
DIVOK(INARRAY,XREF,RX0,RX1) ; Return: 1 if the division of the RX is OK
"RTN","PSODIR4",111,0)
 ; 0 if the division does not match a specified input selection
"RTN","PSODIR4",112,0)
 ;
"RTN","PSODIR4",113,0)
 ; Assumptions:
"RTN","PSODIR4",114,0)
 ;   This call was designed to work with an Original RX, a Refilled
"RTN","PSODIR4",115,0)
 ;   RX, or a Partial RX.
"RTN","PSODIR4",116,0)
 ; Cross References potentially utilized by calling routines
"RTN","PSODIR4",117,0)
 ;   Original RX: ^PSRX("AL",Released_Dt,RX0,0)=""
"RTN","PSODIR4",118,0)
 ;   Refilled RX: ^PSRX("AL",Released_Dt,RX0,RX1)=""
"RTN","PSODIR4",119,0)
 ;   Partial  RX: ^PSRX("AM",Released_Dt,RX0,RX1)=""
"RTN","PSODIR4",120,0)
 ; Input:
"RTN","PSODIR4",121,0)
 ;   INARRAY ; Required ; Usually as the result from a previous
"RTN","PSODIR4",122,0)
 ;             execution of the above companion call OPTSITE^PSOZDIR4
"RTN","PSODIR4",123,0)
 ;     INARRAY(PSOIEN)=VALUE ; Example: INARRAY(1)="JOHN COCHRAN VAMC"
"RTN","PSODIR4",124,0)
 ;     INARRAY("B",VALUE,PSOIEN)="" ; INARRAY("B","JOHN COCHRAN VAMC",1)=""
"RTN","PSODIR4",125,0)
 ;   XREF ; Required ; Type of x-ref, where
"RTN","PSODIR4",126,0)
 ;              'AL' ; Indicates a either an original RX when RX1=0
"RTN","PSODIR4",127,0)
 ;                     Indicates a refilled (multiple) RX when RX1>0
"RTN","PSODIR4",128,0)
 ;              'AM' ; Indicates a partial  (multiple) RX
"RTN","PSODIR4",129,0)
 ;          Note: See routine PSOSCT10 as an example, used by the
"RTN","PSODIR4",130,0)
 ;                option High Cost Rx Report [PSO HI COST].
"RTN","PSODIR4",131,0)
 ;   RX0  ; Required ; IEN of PRESCRIPTION file #52 entry
"RTN","PSODIR4",132,0)
 ;   RX1  ; Required ; IEN1 of Refill or a Partial RX multiple entry.
"RTN","PSODIR4",133,0)
 ; Output:
"RTN","PSODIR4",134,0)
 ;   This extrinsic functions returns 1 (true) or 0 (false)
"RTN","PSODIR4",135,0)
 ; Intended usage:
"RTN","PSODIR4",136,0)
 ;   This purpose of this API is to screen a particular RX for report
"RTN","PSODIR4",137,0)
 ;   inclusion or exclusion, that is, if the RX was dispensed at a
"RTN","PSODIR4",138,0)
 ;   previously selected Outpatient Site it should be included. In
"RTN","PSODIR4",139,0)
 ;   this, the extrinsic function will return a one (1).  If the RX
"RTN","PSODIR4",140,0)
 ;   was not dispensed at a selected Outpatient Site, it should be
"RTN","PSODIR4",141,0)
 ;   excluded and the extrinsic function will return a zero (0).
"RTN","PSODIR4",142,0)
 ;   Althought this API can be used independently, this entry point
"RTN","PSODIR4",143,0)
 ;   was written as a companion call to be utilized after calling the
"RTN","PSODIR4",144,0)
 ;   OPTSITE^PSOZDIR4 API.
"RTN","PSODIR4",145,0)
 ; Example call:
"RTN","PSODIR4",146,0)
 ;   ; Prompt for which Outptient Site(s) to include
"RTN","PSODIR4",147,0)
 ;   D OPTSITE^PSOZDIR4(.PSOSITE,$T(+0)) G:PSOSITE="^" EXIT
"RTN","PSODIR4",148,0)
 ;   ; When looping thru entries in file (#52), screen
"RTN","PSODIR4",149,0)
 ;   ; the RX to only include a selected Outpatient Site.
"RTN","PSODIR4",150,0)
 ;   Q:'$$DIVOK^PSOZDIR4(.PSOSITE,TY,PSRXN,PSFILL)
"RTN","PSODIR4",151,0)
 ;
"RTN","PSODIR4",152,0)
 N DIRUT,PSOIENS,PSOSITEI,PSOVAL,IENS
"RTN","PSODIR4",153,0)
 ;
"RTN","PSODIR4",154,0)
 S PSOVAL=0 ; Default return value to false (failed screen by division)
"RTN","PSODIR4",155,0)
 ;
"RTN","PSODIR4",156,0)
 I XREF="AL" D  ; An original or a refill, depending upon value RX1
"RTN","PSODIR4",157,0)
 . ;
"RTN","PSODIR4",158,0)
 . I RX1=0 D  ; Original RX based upon an 'AL' type of XREF
"RTN","PSODIR4",159,0)
 . . ;
"RTN","PSODIR4",160,0)
 . . ; DIVISION (#20) [RP59'] of PRESCRIPTION file (#52)
"RTN","PSODIR4",161,0)
 . . S IENS=RX0_","
"RTN","PSODIR4",162,0)
 . . S PSOSITEI=$$GET1^DIQ(52,IENS,20,"I") Q:$G(DIERR)
"RTN","PSODIR4",163,0)
 . ;
"RTN","PSODIR4",164,0)
 . I RX1>0 D  ; Refilled RX based upon an 'AL' type of XREF
"RTN","PSODIR4",165,0)
 . . ;
"RTN","PSODIR4",166,0)
 . . ; DIVISION (#8) [RP59'] of REFILL multiple (#52.1)
"RTN","PSODIR4",167,0)
 . . S IENS=RX1_","_RX0_","
"RTN","PSODIR4",168,0)
 . . S PSOSITEI=$$GET1^DIQ(52.1,IENS,8,"I") Q:$G(DIERR)
"RTN","PSODIR4",169,0)
 . ;
"RTN","PSODIR4",170,0)
 . I $D(INARRAY(PSOSITEI)) S PSOVAL=1 ; Selected DIVISION found
"RTN","PSODIR4",171,0)
 ;
"RTN","PSODIR4",172,0)
 I XREF="AM" D  ; Partial RX based upon 'AM' type of XREF
"RTN","PSODIR4",173,0)
 . ;
"RTN","PSODIR4",174,0)
 . ; DIVISION (#.09) [RP59'] of PARTIAL DATA multiple (#52.2)
"RTN","PSODIR4",175,0)
 . S IENS=RX1_","_RX0_","
"RTN","PSODIR4",176,0)
 . S PSOSITEI=$$GET1^DIQ(52.2,IENS,.09,"I") Q:$G(DIERR)
"RTN","PSODIR4",177,0)
 . ;
"RTN","PSODIR4",178,0)
 . I $D(INARRAY(PSOSITEI)) S PSOVAL=1 ; Selected DIVISION found
"RTN","PSODIR4",179,0)
 ;
"RTN","PSODIR4",180,0)
 Q PSOVAL
"RTN","PSODIR4",181,0)
DIR() Q "%,DIR,DIRUT,DTOUT,DUOUT,I,X,Y" ;............... ^DIR
"RTN","PSODIR4",182,0)
 Q
"RTN","PSODIR4",183,0)
 ;
"RTN","PSODIR4",184,0)
GETSITE(PSORTN) ; Prompt for Outpatient Site (or Division)
"RTN","PSODIR4",185,0)
 ;
"RTN","PSODIR4",186,0)
 ; Output:
"RTN","PSODIR4",187,0)
 ;     PSOSSITE(IENof59)=NAME (of OUTPATIENT SITE file #59)
"RTN","PSODIR4",188,0)
 ;     PSOFLGQ = 1 if user enters '^' or no active Outpatient Site found
"RTN","PSODIR4",189,0)
 ;
"RTN","PSODIR4",190,0)
 N PSODEF,PSODTINAC,PSOIEN59,PSOIENS,PSOFLGQ,PSOMAX,PROMPT,PSOSITNM,PSOSCNT
"RTN","PSODIR4",191,0)
 ;
"RTN","PSODIR4",192,0)
 ; Set default to user's previous response; or '1-2'
"RTN","PSODIR4",193,0)
 ; if no previous response
"RTN","PSODIR4",194,0)
 ;
"RTN","PSODIR4",195,0)
 S PSODEF=$G(^DISV(DUZ,PSORTN,"PSOSITE"),"1-2")
"RTN","PSODIR4",196,0)
 ;
"RTN","PSODIR4",197,0)
 ; Loop through OUTPATIENT SITE file (#59) entries
"RTN","PSODIR4",198,0)
 ; and bypass any inactive entries.  Build a prompt array to be used
"RTN","PSODIR4",199,0)
 ; as input to the FM DIR API call and display prompt text and any
"RTN","PSODIR4",200,0)
 ; active OUTPATIENT SITE entries for user selection.
"RTN","PSODIR4",201,0)
 ;
"RTN","PSODIR4",202,0)
 S (PSOSCNT,PSOIEN59)=0
"RTN","PSODIR4",203,0)
 F  S PSOIEN59=$O(^PS(59,PSOIEN59)) Q:'PSOIEN59  D  ;
"RTN","PSODIR4",204,0)
 . S PSOIENS=PSOIEN59_"," ; IEN String for FM Database Server calls
"RTN","PSODIR4",205,0)
 . S PSODTINAC=$$GET1^DIQ(59,PSOIENS,2004,"I") Q:$G(DIERR)  ; INACTIVE DATE
"RTN","PSODIR4",206,0)
 . I PSODTINAC,PSODTINAC'>DT Q  ; Quit if currently inactive
"RTN","PSODIR4",207,0)
 . S PSOSITNM=$$GET1^DIQ(59,PSOIENS,.01) Q:$G(DIERR)  ; NAME of SITE
"RTN","PSODIR4",208,0)
 . Q:PSOSITNM=""  ; Quit it NAME of OUTPATIENT SITE is null
"RTN","PSODIR4",209,0)
 . S PSOSCNT=PSOSCNT+1 ; Increment count of active Outpatient Sites
"RTN","PSODIR4",210,0)
 . I PSOSCNT=1 D  ;. Display prompt text before 1st active Outpatient Site
"RTN","PSODIR4",211,0)
 . . W !
"RTN","PSODIR4",212,0)
 . . W !,"For RXs written at OUTPATIENT SITEs:  (Example 1,3 or 1-5)"
"RTN","PSODIR4",213,0)
 . S PROMPT(PSOSCNT)=PSOIEN59_"^"_PSOSITNM ; Input array to FM DIR API
"RTN","PSODIR4",214,0)
 . W !?3,$J(PSOSCNT,2),")  ",PSOSITNM ;.. Display choice number & site
"RTN","PSODIR4",215,0)
 ;
"RTN","PSODIR4",216,0)
 I 'PSOSCNT S PSOFLGQ=1 Q  ; If no active sites, return PSOFLGQ = 1
"RTN","PSODIR4",217,0)
 ;
"RTN","PSODIR4",218,0)
 ; Refresh output array, prompt user using FM DIR List or Range API
"RTN","PSODIR4",219,0)
 ; and save user's choice in ^DISV global for future default
"RTN","PSODIR4",220,0)
 ;
"RTN","PSODIR4",221,0)
 KILL PSOSSITE ; Refresh output array
"RTN","PSODIR4",222,0)
 W ! D REFSITE(.PROMPT,.PSOSSITE,PSOSCNT,$G(DEF),1)
"RTN","PSODIR4",223,0)
 S:PSOMAX'["^" ^DISV(DUZ,PSORTN,"PSOSSITE")=PSOMAX
"RTN","PSODIR4",224,0)
 ;
"RTN","PSODIR4",225,0)
 Q
"RTN","PSODIR4",226,0)
REFSITE(PSOINPUT,PSOOUTPT,PSOMAX,PSODEF,PSORETRN) ; Prompt for range or list of displayed items
"RTN","PSODIR4",227,0)
 ; PSOINPUT  - Array of displayed menu items in the format:
"RTN","PSODIR4",228,0)
 ; PSOINPUT(PSONUM)=PSOIEN_"^"_PSOVALU
"RTN","PSODIR4",229,0)
 ; PSOOUTPT - Array of user selected items in the format:
"RTN","PSODIR4",230,0)
 ;    PSOOUTPT(PSOIEN)=PSOVALU
"RTN","PSODIR4",231,0)
 ; PSOMAX ; User's response
"RTN","PSODIR4",232,0)
 ; PSOMAX    - Maximum number of items displayed
"RTN","PSODIR4",233,0)
 ; PSODEF    - Default answer (optional)
"RTN","PSODIR4",234,0)
 ; PSORETRN - If 1 the users response will be returned in var. PSOMAX
"RTN","PSODIR4",235,0)
 ; (optional)
"RTN","PSODIR4",236,0)
 ;
"RTN","PSODIR4",237,0)
 N @($$DIR^PSODIR4())
"RTN","PSODIR4",238,0)
 N PSOI,PSOIEN,PSONUM,PSOVALU
"RTN","PSODIR4",239,0)
 S DIR(0)="LAO^1:"_PSOMAX ;...User may select list or range
"RTN","PSODIR4",240,0)
 S DIR("A")="Select NUMBER(s): " ;...Prompt text
"RTN","PSODIR4",241,0)
 I PSODEF]"" S DIR("B")=PSODEF
"RTN","PSODIR4",242,0)
 D ^DIR ;...Prompt user IA #10026
"RTN","PSODIR4",243,0)
 S PSOOUTPT=X
"RTN","PSODIR4",244,0)
 I $G(PSORETRN)=1 S PSOMAX=X
"RTN","PSODIR4",245,0)
 I "^"[X S PSOFLGQ=1 Q
"RTN","PSODIR4",246,0)
 ;-> Process user's list of choices.  Example Y="1,3,5,6,"
"RTN","PSODIR4",247,0)
 S PSONUM=""
"RTN","PSODIR4",248,0)
 F PSOI=1:1 S PSONUM=$P(Y,",",PSOI) Q:'PSONUM  D  ;
"RTN","PSODIR4",249,0)
 . S PSOIEN=$P(PSOINPUT(PSONUM),U,1),PSOVALU=$P(PSOINPUT(PSONUM),U,2)
"RTN","PSODIR4",250,0)
 . S PSOOUTPT(PSOIEN)=PSOVALU
"RTN","PSODIR4",251,0)
 ;
"RTN","PSODIR4",252,0)
 Q
"RTN","PSOEOPNW")
0^1^B11880159
"RTN","PSOEOPNW",1,0)
PSOEOPNW ;EPIP/RTW - End of Prescription Numbering Warning ; 7/11/17 8:53AM
"RTN","PSOEOPNW",2,0)
 ;;7.0;OUTPATIENT PHARMACY;**452**;DEC 1997;Build 56
"RTN","PSOEOPNW",3,0)
 ;---------------------------------------------------------------------
"RTN","PSOEOPNW",4,0)
 ; ICR#   TYPE    DESCRIPTION
"RTN","PSOEOPNW",5,0)
 ;-----  -------  ------------------------------------------
"RTN","PSOEOPNW",6,0)
 ;10063  Support  %ZTLOAD
"RTN","PSOEOPNW",7,0)
 ;10086  Support  %ZIS
"RTN","PSOEOPNW",8,0)
 ;10089  Support  %ZISC
"RTN","PSOEOPNW",9,0)
 ;10003  Support  ^%DT
"RTN","PSOEOPNW",10,0)
 ;10103  Support  ^XLFDT: $$FMTE, $$NOW
"RTN","PSOEOPNW",11,0)
 ;---------------------------------------------------------------------
"RTN","PSOEOPNW",12,0)
 S %ZIS="Q" D ^%ZIS G:POP EXIT
"RTN","PSOEOPNW",13,0)
 I $D(IO("Q")) S ZTRTN="CHECK2^PSOEOPNW" D ^%ZTLOAD,HOME^%ZIS G EXIT
"RTN","PSOEOPNW",14,0)
CHECK2 ;
"RTN","PSOEOPNW",15,0)
 U IO
"RTN","PSOEOPNW",16,0)
CHECK ;
"RTN","PSOEOPNW",17,0)
 N PSORXLMT,PSOSORT
"RTN","PSOEOPNW",18,0)
 I $D(^PS(59.7,1,48)),$G(^PS(59.7,1,48)) S PSORXLMT=$P(^PS(59.7,1,48),U),^TMP("PSOEOPNW",0)="9999999^"_$$FMTE^XLFDT($$NOW^XLFDT,"1M")_"^End of Prescription Numbering Warning^"_PSORXLMT
"RTN","PSOEOPNW",19,0)
 I '$D(^TMP("PSOEOPNW")) S ^TMP("PSOEOPNW",0)="9999999^"_$$FMTE^XLFDT($$NOW^XLFDT,"1M")_"^End of Prescription Numbering Warning^1000"
"RTN","PSOEOPNW",20,0)
 K ^TMP($J)
"RTN","PSOEOPNW",21,0)
 S PSOLINE=1
"RTN","PSOEOPNW",22,0)
 S PSOLIMIT=$P(^TMP("PSOEOPNW",0),U,4)
"RTN","PSOEOPNW",23,0)
 S ^TMP($J,PSOLINE)="LIMIT: "_PSOLIMIT,PSOLINE=PSOLINE+1
"RTN","PSOEOPNW",24,0)
 F PSOIEN=0:0 S PSOIEN=$O(^PS(59,PSOIEN)) Q:'PSOIEN  DO
"RTN","PSOEOPNW",25,0)
 . Q:$E($P(^PS(59,PSOIEN,0),U),1,2)="ZZ"
"RTN","PSOEOPNW",26,0)
 . I $G(^PS(59,PSOIEN,"I")) Q:$P(^PS(59,PSOIEN,"I"),U)'>DT
"RTN","PSOEOPNW",27,0)
 . S PSOLOW=$P($G(^PS(59,PSOIEN,3)),U,1),PSOMAX=$P($G(^PS(59,PSOIEN,3)),U,2),PSOLAST=$P($G(^PS(59,PSOIEN,3)),U,3)
"RTN","PSOEOPNW",28,0)
 . S PSODIFF=PSOMAX-PSOLAST
"RTN","PSOEOPNW",29,0)
 . S PSOSORT=$P($G(^PS(59,PSOIEN,2)),U,1)  ;RTW added to check to see if a site sorts Narcotics separately.
"RTN","PSOEOPNW",30,0)
 . I PSODIFF<PSOLIMIT,($G(PSOSORT)) DO WARN("NARCOTIC") ;RTW
"RTN","PSOEOPNW",31,0)
 . S PSOLOW=$P($G(^PS(59,PSOIEN,8)),U,1),PSOMAX=$P($G(^PS(59,PSOIEN,8)),U,2),PSOLAST=$P($G(^PS(59,PSOIEN,8)),U,3)
"RTN","PSOEOPNW",32,0)
 . S PSODIFF=PSOMAX-PSOLAST
"RTN","PSOEOPNW",33,0)
 . I PSODIFF<PSOLIMIT DO WARN("PRESCRIPTION #")
"RTN","PSOEOPNW",34,0)
 ;
"RTN","PSOEOPNW",35,0)
 D:PSOLINE>2
"RTN","PSOEOPNW",36,0)
 . S $P(^TMP("PSOEOPNW",0),U,2)=$$FMTE^XLFDT($$NOW^XLFDT,"1M")
"RTN","PSOEOPNW",37,0)
 . S $P(^TMP("PSOEOPNW",0),U,4)=PSOLIMIT
"RTN","PSOEOPNW",38,0)
 . S XMSUB="End of Prescribing Numbering WARNING"
"RTN","PSOEOPNW",39,0)
 . S (XMDUZ,DUZ)=.5
"RTN","PSOEOPNW",40,0)
 . S XMTEXT="^TMP($J)"
"RTN","PSOEOPNW",41,0)
 . S XMY("G.PHARMACY SUPERVISORS")=""
"RTN","PSOEOPNW",42,0)
 . S XMINSTR("FLAGS")="P"
"RTN","PSOEOPNW",43,0)
 . DO SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.XMINSTR)
"RTN","PSOEOPNW",44,0)
 G EXIT
"RTN","PSOEOPNW",45,0)
WARN(PSOFOO) ;
"RTN","PSOEOPNW",46,0)
 S ^TMP($J,PSOLINE)="",PSOLINE=PSOLINE+1
"RTN","PSOEOPNW",47,0)
 S ^TMP($J,PSOLINE)="SITE: "_$P(^PS(59,PSOIEN,0),U),PSOLINE=PSOLINE+1
"RTN","PSOEOPNW",48,0)
 S ^TMP($J,PSOLINE)=PSOFOO_" LOWER BOUND       : "_PSOLOW,PSOLINE=PSOLINE+1
"RTN","PSOEOPNW",49,0)
 S ^TMP($J,PSOLINE)=PSOFOO_" UPPER BOUND       : "_PSOMAX,PSOLINE=PSOLINE+1
"RTN","PSOEOPNW",50,0)
 S ^TMP($J,PSOLINE)="LAST "_PSOFOO_" ISSUED       : "_PSOLAST,PSOLINE=PSOLINE+1
"RTN","PSOEOPNW",51,0)
 S ^TMP($J,PSOLINE)="There are "_PSODIFF_" Numbers left, a new series needs to be defined.",PSOLINE=PSOLINE+1
"RTN","PSOEOPNW",52,0)
 I PSODIFF<250 S ^TMP($J,PSOLINE)="*** EXTREMELY LOW ***",PSOLINE=PSOLINE+1
"RTN","PSOEOPNW",53,0)
 QUIT
"RTN","PSOEOPNW",54,0)
EXIT ;
"RTN","PSOEOPNW",55,0)
 K %ZIS,PSODIFF,PSOFOO,PSOIEN,PSOLAST,PSOLIMIT,PSOLINE,PSOLOW,PSOMAX,POP,XMDUZ,XMINSTR,XMSUB
"RTN","PSOEOPNW",56,0)
 K XMTEXT,XMY,ZTRTN,^TMP($J),^TMP("PSOEOPNW")
"RTN","PSOEOPNW",57,0)
 D:$D(ZTQUEUED) KILL^%ZTLOAD
"RTN","PSOEOPNW",58,0)
 D ^%ZISC QUIT
"RTN","PSOP452P")
0^^B5385563
"RTN","PSOP452P",1,0)
PSOP452P ;ALB/RTW - PS RX NUMBERING WARNING POST INSTALL ; 11/24/16 1:54pm
"RTN","PSOP452P",2,0)
 ;;7.0;OUTPATIENT PHARMACY ;**452**;Dec 17, 1997;Build 56
"RTN","PSOP452P",3,0)
 ; ICR#  Type  Description
"RTN","PSOP452P",4,0)
 ;-----  ----  -------------------------------------
"RTN","PSOP452P",5,0)
 ; 1157  Sup   $$LKOPT^XPDMENU
"RTN","PSOP452P",6,0)
 ; 1472  Sup   RESCH^XUTMOPT [allows creation of new record in 19.2]
"RTN","PSOP452P",7,0)
 ;10000  Sup   C^%DTC
"RTN","PSOP452P",8,0)
 ;10111  Sup   FM lookup on file 3.8 using ^DIC API 
"RTN","PSOP452P",9,0)
 ; 1146  Sup   $$MG^XMBGRP add a mail group
"RTN","PSOP452P",10,0)
 ;
"RTN","PSOP452P",11,0)
 D TASK,MAILGRP
"RTN","PSOP452P",12,0)
 Q
"RTN","PSOP452P",13,0)
TASK ;
"RTN","PSOP452P",14,0)
 N X,DA,DIE,DR,PSOAOPTB,PSOAOPTN,PSOERR,PSONM,PSOIEN,PSOWHEN
"RTN","PSOP452P",15,0)
 S PSONM="PSO RX NUMBERING WARNING"
"RTN","PSOP452P",16,0)
 S PSOIEN=$$LKOPT^XPDMENU(PSONM) I PSOIEN="" D  Q
"RTN","PSOP452P",17,0)
 . W !?5,"ERROR: Option "_PSONM_" not found",!
"RTN","PSOP452P",18,0)
 . Q
"RTN","PSOP452P",19,0)
 S X1=DT,X2=1 D C^%DTC S PSOWHEN=X_"@0301"
"RTN","PSOP452P",20,0)
 W !,"The '"_PSONM_"' option is scheduled to run at: "
"RTN","PSOP452P",21,0)
 D RESCH^XUTMOPT(PSONM,PSOWHEN,"","1D","L",.PSOERR)
"RTN","PSOP452P",22,0)
 S PSOAOPTB=0,PSOAOPTB=+$P($Q(^DIC(19.2,"B",PSOIEN,PSOAOPTB)),",",4)
"RTN","PSOP452P",23,0)
 S DIE="^DIC(19.2,",DR="11///.5",DA=PSOAOPTB D ^DIE
"RTN","PSOP452P",24,0)
 Q
"RTN","PSOP452P",25,0)
MAILGRP ;Need to check for a pre existing mail group called PHARMACY SURPERVISORS if it exists do nothing.
"RTN","PSOP452P",26,0)
 N PSOMG,PSOMSG,PSONIEN,PSORX
"RTN","PSOP452P",27,0)
 S PSOMG=$$FIND1^DIC(3.8,"","X","PHARMACY SUPERVISORS","B")
"RTN","PSOP452P",28,0)
 I PSOMG W !,"The PHARMACY SUPERVISORS Mail Group already exists, nothing created!" Q
"RTN","PSOP452P",29,0)
 D:'PSOMG
"RTN","PSOP452P",30,0)
 . N PSOMGRP,PSODESCR,PSOTYPE,PSOORG,MSG,FDA2,FDA,PSOIEN
"RTN","PSOP452P",31,0)
 . S PSOMGRP="PHARMACY SUPERVISORS",PSOTYPE="PU",PSOORG=".5"
"RTN","PSOP452P",32,0)
 . S FDA(3.8,"+1,",.01)=PSOMGRP
"RTN","PSOP452P",33,0)
 . S FDA(3.8,"+1,",4)=PSOTYPE
"RTN","PSOP452P",34,0)
 . S FDA(3.8,"+1,",5)=PSOORG
"RTN","PSOP452P",35,0)
 . S FDA(3.8,"+1,",5.1)=PSOORG
"RTN","PSOP452P",36,0)
 . S FDA(3.8,"+1,",7)="n"
"RTN","PSOP452P",37,0)
 . D UPDATE^DIE("","FDA","FDAIEN","MSG")
"RTN","PSOP452P",38,0)
 . S PSONIEN=$O(^XMB(3.8,"B","PHARMACY SUPERVISORS",0))
"RTN","PSOP452P",39,0)
 . S PSOMSG(1)="Pharmacy Supervisors Group for end of RX Numbering Alert"
"RTN","PSOP452P",40,0)
 . D WP^DIE(3.8,PSONIEN_",",3,,"PSOMSG")
"RTN","PSOP452P",41,0)
 . K FDA,FDAIEN
"RTN","PSOP452P",42,0)
 I $D(MSG) D  Q
"RTN","PSOP452P",43,0)
 . S PSORX="Mail Group Creation Failed.  The following error message was returned:"
"RTN","PSOP452P",44,0)
 . W !
"RTN","PSOP452P",45,0)
 . D MES^XPDUTL(PSORX)
"RTN","PSOP452P",46,0)
 I '$D(MSG) S PSORX="Mail Group created successfully." D
"RTN","PSOP452P",47,0)
 . D MES^XPDUTL(PSORX)
"RTN","PSOP452P",48,0)
 Q
"RTN","PSOSITED")
0^2^B11480103
"RTN","PSOSITED",1,0)
PSOSITED ;BHAM ISC/SAB - ENTER/EDIT OUTPATIENT SITE PARAMETERS ; 09/18/92 9:11
"RTN","PSOSITED",2,0)
 ;;7.0;OUTPATIENT PHARMACY;**24,65,268,354,452**;DEC 1997;Build 56
"RTN","PSOSITED",3,0)
 ;External reference to ^PS(59.7 supported by DBIA 694
"RTN","PSOSITED",4,0)
 I $G(PSOPAR)']"" D ^PSOLSET
"RTN","PSOSITED",5,0)
1 W ! K DIC S DIC("A")="Select SITE NAME: ",(DIC,DIE)="^PS(59,",DIC(0)="QEALM",DLAYGO=59
"RTN","PSOSITED",6,0)
 K PSOSITEX D ^DIC G:"^"[X EX K DIC("A") G:Y<0 1 S DA=+Y D FLDQ G:$D(PSOSITEX) EX S DR="[PSO SITE]" W ! D ^DIE K DIE("NO^")
"RTN","PSOSITED",7,0)
 ;rtw added field 48 to DR below
"RTN","PSOSITED",8,0)
 W !!,"Outpatient System Parameters",! S DA=1,DIE=59.7,DR="40;40.1;40.19;40.14;40.15;48" L +^PS(59.7,DA):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) I '$T W !,"Another person is editing this entry.  Try Later!",! K DA,DIE,DR G 1
"RTN","PSOSITED",9,0)
 D ^DIE L -^PS(59.7,DA)
"RTN","PSOSITED",10,0)
 N CNT,TOT S (TOT,CNT)=0 F  S CNT=$O(^PS(59,CNT)) Q:'CNT  S TOT=TOT+1
"RTN","PSOSITED",11,0)
 D:TOT>1 ^PSODIV K CNT,TOT
"RTN","PSOSITED",12,0)
 S:$G(PSOSITE)=DA PSOPAR=$G(^PS(59,DA,1)),PSOPAR7=$G(^PS(59,DA,"IB")),PSOSYS=$G(^PS(59.7,1,40.1)) D EX G 1
"RTN","PSOSITED",13,0)
EX K DIC,DA,DIE,DIR,DIV,DR,I,PS1,PS11,PSIX,PSOCNT,PSOSITEX,X,Y,%,%X,%Y,D0,DI,DQ,DX,S Q
"RTN","PSOSITED",14,0)
 Q
"RTN","PSOSITED",15,0)
FLDQ S DIR("?",1)="Press <RETURN> if you want to see a list of all outpatient",DIR("?")="pharmacy answered site fields.  Enter 'N' if you don't want to see the list."
"RTN","PSOSITED",16,0)
 S DIR(0)="Y",DIR("A")="Would you like to see all site parameters for this division",DIR("B")="Y" D ^DIR K DIR S:$D(DTOUT) PSOSITEX="" I Y,'$D(PSOSITEX) W @IOF D EN^DIQ
"RTN","PSOSITED",17,0)
 K DIR Q
"RTN","PSOSITED",18,0)
 ;
"RTN","PSOSITED",19,0)
CATVAL(X) ;Input transform for CATEGORY field #1, OPAI sub-file #59.20081 
"RTN","PSOSITED",20,0)
 ;of the DISPENSING SYSTEM PRINTER sub-file #59.02008 of File #59.
"RTN","PSOSITED",21,0)
 ;This check ensures that a dispensing printer is not assigned more
"RTN","PSOSITED",22,0)
 ;than one ADD device with conflicting categories which guarantees an 
"RTN","PSOSITED",23,0)
 ;RX is routed to only one dispensing device. Valid category
"RTN","PSOSITED",24,0)
 ;combinations are shown at the COMB line tag. Category "A"ny is
"RTN","PSOSITED",25,0)
 ;selectable only when no other category is defined on file for that
"RTN","PSOSITED",26,0)
 ;device and vice versa. The category "S"torage can be combined with
"RTN","PSOSITED",27,0)
 ;any other category or can standalone.
"RTN","PSOSITED",28,0)
 ;
"RTN","PSOSITED",29,0)
 I $G(X)="" Q 0
"RTN","PSOSITED",30,0)
 N DEV,CAT,CATL,FLG,II,XX
"RTN","PSOSITED",31,0)
 S (DEV,FLG)=0,CATL=""
"RTN","PSOSITED",32,0)
 F  S DEV=$O(^PS(59,DA(2),"P",DA(1),"OPAI",DEV)) Q:'DEV  D  I FLG Q
"RTN","PSOSITED",33,0)
 .S CAT=$P($G(^PS(59,DA(2),"P",DA(1),"OPAI",DEV,0)),"^",2) I CAT="" Q
"RTN","PSOSITED",34,0)
 .I DEV=DA Q  ;current entry
"RTN","PSOSITED",35,0)
 .I CAT'="S",X=CAT D EN^DDIOL("  <-- Category already on file.","","?0") S FLG=1 Q
"RTN","PSOSITED",36,0)
 .S CATL=CATL_"^"_CAT
"RTN","PSOSITED",37,0)
 I FLG Q FLG
"RTN","PSOSITED",38,0)
 ;if no categories are on file or the category entered is storage then quit
"RTN","PSOSITED",39,0)
 I (CATL="")!(X="S") Q FLG
"RTN","PSOSITED",40,0)
 S CATL=CATL_"^"_X
"RTN","PSOSITED",41,0)
 F II=1:1 S XX=$T(COMB+II) Q:XX["END"  S XX=$P(XX,";;",2),FLG=$$COMCHK(XX,CATL) I 'FLG Q
"RTN","PSOSITED",42,0)
 I FLG D
"RTN","PSOSITED",43,0)
 .;D EN^DDIOL("  <-- Can't be combined with categories on file.","","?0")
"RTN","PSOSITED",44,0)
 .D EN^DDIOL("  <-- Conflicting categories.","","?0")
"RTN","PSOSITED",45,0)
 .D EN^DDIOL("*** Valid category combinations are:","","!?5")
"RTN","PSOSITED",46,0)
 .F II=1:1 S XX=$T(COMB+II) Q:XX["END"  S XX=$P(XX,";;",2) D
"RTN","PSOSITED",47,0)
 ..S XX=$E(XX,2,9999)
"RTN","PSOSITED",48,0)
 ..D EN^DDIOL(II_". "_$TR(XX,"^",", "),"","!?8")
"RTN","PSOSITED",49,0)
 .D EN^DDIOL("  ","","?0")
"RTN","PSOSITED",50,0)
 Q FLG
"RTN","PSOSITED",51,0)
 ;
"RTN","PSOSITED",52,0)
COMCHK(CMBO,STR) ; check allowable ADD combinations for a printer
"RTN","PSOSITED",53,0)
 ;INPUT CMBO - contains a set of categories that can be combined together
"RTN","PSOSITED",54,0)
 ;      STR  - checked against CMBO for validity.
"RTN","PSOSITED",55,0)
 ;OUTPUT     - returns a 0 if a combination is valid, else a 1.
"RTN","PSOSITED",56,0)
 ;
"RTN","PSOSITED",57,0)
 N I1,VAL,FLG
"RTN","PSOSITED",58,0)
 S FLG=0
"RTN","PSOSITED",59,0)
 ;find valid CMBO combination base on value in STR
"RTN","PSOSITED",60,0)
 F I1=1:1:$L(STR,"^") S VAL=$P(STR,"^",I1) D  I FLG Q
"RTN","PSOSITED",61,0)
 .I VAL'="",VAL'="S",CMBO'[("^"_VAL_"^") S FLG=1
"RTN","PSOSITED",62,0)
 Q FLG
"RTN","PSOSITED",63,0)
 ;
"RTN","PSOSITED",64,0)
COMB ; valid category combinations for ADDs that can be assigned to a dispensing printer.
"RTN","PSOSITED",65,0)
 ;;^MCS^MNCS^WCS^WNCS^S
"RTN","PSOSITED",66,0)
 ;;^MCS^MNCS^WIND^S
"RTN","PSOSITED",67,0)
 ;;^WCS^WNCS^MAIL^S
"RTN","PSOSITED",68,0)
 ;;^CS^MNCS^WNCS^S
"RTN","PSOSITED",69,0)
 ;;^NCS^WCS^MCS^S
"RTN","PSOSITED",70,0)
 ;;^MAIL^WIND^S
"RTN","PSOSITED",71,0)
 ;;^CS^NCS^S
"RTN","PSOSITED",72,0)
 ;;^A^S
"RTN","PSOSITED",73,0)
 ;;^S
"RTN","PSOSITED",74,0)
 ;;END
"RTN","PSOSUCAT")
0^5^B81054236
"RTN","PSOSUCAT",1,0)
PSOSUCAT ;EPIP/RTW -Print From Suspense By Category ;08/01/14  14:53
"RTN","PSOSUCAT",2,0)
 ;;7.0;OUTPATIENT PHARMACY;**452**;DEC 1997;Build 56
"RTN","PSOSUCAT",3,0)
 ;---------------------------------------------------------------------
"RTN","PSOSUCAT",4,0)
 ; ICR#   TYPE    DESCRIPTION
"RTN","PSOSUCAT",5,0)
 ;-----  -------  ------------------------------------
"RTN","PSOSUCAT",6,0)
 ;10026  Support  ^DIK
"RTN","PSOSUCAT",7,0)
 ;---------------------------------------------------------------------
"RTN","PSOSUCAT",8,0)
START N DIR,X,Y,DTOUT,DUOUT,PSOSULST,PSORESP,PSOSTPF,PSOMOD,PSOTAG
"RTN","PSOSUCAT",9,0)
 S CNT=0
"RTN","PSOSUCAT",10,0)
 s DIR("B")="ALL"
"RTN","PSOSUCAT",11,0)
 S DIR(0)="SBO^A:ALL;N:Non-Controlled Drugs;C:Controlled Substances;S:Supplies;R:Refrigerated Items;D:Drugs;V:VA Classifications;E:Exit"
"RTN","PSOSUCAT",12,0)
 S DIR("A")="Select Print Category"
"RTN","PSOSUCAT",13,0)
 S DIR("T")=DTIME
"RTN","PSOSUCAT",14,0)
 S DIR("?",1)="Enter 'A' ALL Prescriptions on Suspense for the Division"
"RTN","PSOSUCAT",15,0)
 S DIR("?",2)="      'N' Non-Controlled Rx or OTCs (Special Handling Code 6 or 9)"
"RTN","PSOSUCAT",16,0)
 S DIR("?",3)="      'C' Controlled Substance Prescriptions (DEA 1, 2, 3, 4, 5)"
"RTN","PSOSUCAT",17,0)
 S DIR("?",4)="      'S' Supply Prescriptions (Special Handling Code 'S')"
"RTN","PSOSUCAT",18,0)
 S DIR("?",5)="      'R' Refrigerated Prescriptions (Special Handling Code 'Q')"
"RTN","PSOSUCAT",19,0)
 S DIR("?",6)="      'D' Prescriptions by Selected Drugs"
"RTN","PSOSUCAT",20,0)
 S DIR("?",7)="      'V' Prescriptions by Selected VA Classifications"
"RTN","PSOSUCAT",21,0)
 S DIR("?",8)="   or 'E' or '^' to Exit"
"RTN","PSOSUCAT",22,0)
 S DIR("?")=" "
"RTN","PSOSUCAT",23,0)
 D ^DIR K DIR I $D(DIRUT)!(Y="E") D MESS^PSOSULB1 G EXIT^PSOSULBL
"RTN","PSOSUCAT",24,0)
 I Y="A" G ASK^PSOSULB1
"RTN","PSOSUCAT",25,0)
 I Y="N" S PSORESP="N^Non-Controlled Drugs^DEA"
"RTN","PSOSUCAT",26,0)
 I Y="C" S PSORESP="C^Controlled Substances^DEA"
"RTN","PSOSUCAT",27,0)
 I Y="D" S PSORESP="D^Specific Drugs^DRUG"
"RTN","PSOSUCAT",28,0)
 I Y="V" S PSORESP="V^Specific VA Class^CLASS"
"RTN","PSOSUCAT",29,0)
 I Y="S" S PSORESP="S^Supplies^SUPPLY"
"RTN","PSOSUCAT",30,0)
 I Y="R" S PSORESP="R^Refrigerated Items^FRIDGE"
"RTN","PSOSUCAT",31,0)
 S PSOSULST($P(PSORESP,U,3))=""
"RTN","PSOSUCAT",32,0)
 D INVR I $D(PSOSTPF) D MESS^PSOSULB1 G EXIT^PSOSULBL
"RTN","PSOSUCAT",33,0)
 D DISPENSE I $D(PSOSTPF) D MESS^PSOSULB1 G EXIT^PSOSULBL
"RTN","PSOSUCAT",34,0)
 I "SR"'[$P(PSORESP,U) D @$P(PSORESP,U) I $D(PSOSTPF) D MESS^PSOSULB1 G EXIT^PSOSULBL
"RTN","PSOSUCAT",35,0)
 S PSOTAG="" F  S PSOTAG=$O(PSOSULST(PSOTAG)) Q:PSOTAG']""  S PSOSULST(PSOTAG)=PSOMOD
"RTN","PSOSUCAT",36,0)
 D CONT I $D(PSOSTPF) D MESS^PSOSULB1 G EXIT^PSOSULBL
"RTN","PSOSUCAT",37,0)
 G ASK^PSOSULB1
"RTN","PSOSUCAT",38,0)
INVR N DIR
"RTN","PSOSUCAT",39,0)
 S DIR(0)="SBAO^Include:Include "_$P(PSORESP,U,2)_";Exclude:Exclude "_$P(PSORESP,U,2)
"RTN","PSOSUCAT",40,0)
 S DIR("A")=$P(PSORESP,U,2)_": ",DIR("B")="Include"
"RTN","PSOSUCAT",41,0)
 S DIR("T")=DTIME
"RTN","PSOSUCAT",42,0)
 D ^DIR S:$D(DIRUT) PSOSTPF=1 Q:$D(PSOSTPF)
"RTN","PSOSUCAT",43,0)
 S PSOMOD=""
"RTN","PSOSUCAT",44,0)
 I Y["Exclude" S PSOMOD="1"
"RTN","PSOSUCAT",45,0)
 Q
"RTN","PSOSUCAT",46,0)
DISPENSE N DIR
"RTN","PSOSUCAT",47,0)
 S DIR(0)="SBAO^M:Mail;W:Window;B:Both Mail and Window"
"RTN","PSOSUCAT",48,0)
 S DIR("A")=$S($P(PSOMOD,U):"Exclude:",1:"Include:")_" Mail (M), Window (W), Both (B): ",DIR("B")="Both"
"RTN","PSOSUCAT",49,0)
 S DIR("T")=DTIME
"RTN","PSOSUCAT",50,0)
 D ^DIR S:$D(DIRUT) PSOSTPF=1 Q:$D(PSOSTPF)
"RTN","PSOSUCAT",51,0)
 S PSOMOD=PSOMOD_"^"_$S((Y="B"):"",1:Y)
"RTN","PSOSUCAT",52,0)
 Q
"RTN","PSOSUCAT",53,0)
INCLD N DIR,PSOPMT
"RTN","PSOSUCAT",54,0)
 S DIR(0)="YO",DIR("B")="YES"
"RTN","PSOSUCAT",55,0)
 S DIR("T")=DTIME
"RTN","PSOSUCAT",56,0)
 S PSOPMT=$S(1:$P(PSOMOD,U),1:"")
"RTN","PSOSUCAT",57,0)
 I $P(PSORESP,U)="N",$G(PSOPMT) D 
"RTN","PSOSUCAT",58,0)
 . S DIR("?")=" ",DIR("?",1)="Enter 'YES' to EXCLUDE refrigerated "_$P(PSORESP,U,2)_" from printing."
"RTN","PSOSUCAT",59,0)
 . S DIR("?",2)="Enter 'NO' to print refrigerated "_$P(PSORESP,U,2)_" in addition to the"
"RTN","PSOSUCAT",60,0)
 . S DIR("?",3)="other categories."
"RTN","PSOSUCAT",61,0)
 I $P(PSORESP,U)="N",'$G(PSOPMT) D
"RTN","PSOSUCAT",62,0)
 . S DIR("?")=" ",DIR("?",1)="Enter 'NO' to EXCLUDE refrigerated "_$P(PSORESP,U,2)_" from printing."
"RTN","PSOSUCAT",63,0)
 . S DIR("?",2)="Enter 'YES' to print refrigerated "_$P(PSORESP,U,2)_"."
"RTN","PSOSUCAT",64,0)
 I $P(PSORESP,U)="C",$G(PSOPMT) D
"RTN","PSOSUCAT",65,0)
 . S DIR("?")=" "
"RTN","PSOSUCAT",66,0)
 . S DIR("?",1)="Enter 'YES' to EXCLUDE refrigerated "_$P(PSORESP,U,2)_" of the selected range"
"RTN","PSOSUCAT",67,0)
 . S DIR("?",2)="from printing."
"RTN","PSOSUCAT",68,0)
 . S DIR("?",3)="Enter 'NO' to print refrigerated "_$P(PSORESP,U,2)_" of the selected range"
"RTN","PSOSUCAT",69,0)
 . S DIR("?",4)="in addition to the other categories."
"RTN","PSOSUCAT",70,0)
 I $P(PSORESP,U)="C",'$G(PSOPMT) D
"RTN","PSOSUCAT",71,0)
 . S DIR("?")=" ",DIR("?",1)="Enter 'NO' to EXCLUDE refrigerated "_$P(PSORESP,U,2)_" of the selected range"
"RTN","PSOSUCAT",72,0)
 . S DIR("?",2)="from printing."
"RTN","PSOSUCAT",73,0)
 . S DIR("?",3)="Enter 'YES' to print refrigerated "_$P(PSORESP,U,2)_" of the selected range."
"RTN","PSOSUCAT",74,0)
 S DIR("A")=$S($P(PSOMOD,U):"Exclude",1:"Include")_" Refrigerated Items" D ^DIR S:$D(DIRUT) PSOSTPF=1 Q:$D(PSOSTPF)  S:Y>0 PSOMOD=PSOMOD_"^" S:Y=0 PSOMOD=PSOMOD_"^Q"
"RTN","PSOSUCAT",75,0)
 I $P(PSORESP,U)="N",$G(PSOPMT) D
"RTN","PSOSUCAT",76,0)
 . S DIR("?")=" "
"RTN","PSOSUCAT",77,0)
 . S DIR("?",1)="Enter 'YES' to EXCLUDE Non-Controlled supplies from printing."
"RTN","PSOSUCAT",78,0)
 . S DIR("?",2)="Enter 'NO' to print Non-Controlled supplies in addition to the"
"RTN","PSOSUCAT",79,0)
 . S DIR("?",3)="other categories."
"RTN","PSOSUCAT",80,0)
 I $P(PSORESP,U)="N",'$G(PSOPMT) D
"RTN","PSOSUCAT",81,0)
 . S DIR("?")=" "
"RTN","PSOSUCAT",82,0)
 . S DIR("?",1)="Enter 'NO' to EXCLUDE Non-Controlled supplies from printing."
"RTN","PSOSUCAT",83,0)
 . S DIR("?",2)="Enter 'YES' to print Non-Controlled supplies."
"RTN","PSOSUCAT",84,0)
 I $P(PSORESP,U)="N" S DIR("A")=$S($P(PSOMOD,U):"Exclude",1:"Include")_" Supplies" D ^DIR S:$D(DIRUT) PSOSTPF=1 Q:$D(PSOSTPF)  S:Y>0 PSOMOD=PSOMOD_"^" S:Y=0 PSOMOD=PSOMOD_"^S"
"RTN","PSOSUCAT",85,0)
 Q
"RTN","PSOSUCAT",86,0)
CONT N DIR
"RTN","PSOSUCAT",87,0)
 S DIR(0)="YO"
"RTN","PSOSUCAT",88,0)
 S DIR("A")="Print Suspended '"_$P(PSORESP,U,2)_"' selections" ;rtw
"RTN","PSOSUCAT",89,0)
 I $P(PSOMOD,U) S DIR("A")="Print everything Suspended EXCEPT '"_$P(PSORESP,U,2)_"' selections" ;rtw
"RTN","PSOSUCAT",90,0)
 S DIR("B")="NO"
"RTN","PSOSUCAT",91,0)
 S DIR("T")=DTIME
"RTN","PSOSUCAT",92,0)
 W ! D ^DIR S:Y'>0 PSOSTPF=1
"RTN","PSOSUCAT",93,0)
 Q
"RTN","PSOSUCAT",94,0)
N N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
"RTN","PSOSUCAT",95,0)
 S DIR(0)="SBO^Rx:Rx;OTC:OTC;Both:Both Rx and OTC"
"RTN","PSOSUCAT",96,0)
 S DIR("A")="Include the following"
"RTN","PSOSUCAT",97,0)
 I $P(PSOMOD,U) S DIR("A")="Exclude the following"
"RTN","PSOSUCAT",98,0)
 S DIR("?",1)="Enter 'Rx'   Prescriptions for Legend Drugs (Special Handling Code 6)"
"RTN","PSOSUCAT",99,0)
 S DIR("?",2)="      'OTC'  Prescriptions for OTC Drugs (Special Handling Code 9)"
"RTN","PSOSUCAT",100,0)
 S DIR("?",3)="      'Both' Prescriptions for BOTH Legend and OTC Drugs"
"RTN","PSOSUCAT",101,0)
 S DIR("?")=" "
"RTN","PSOSUCAT",102,0)
 S DIR("B")="Both"
"RTN","PSOSUCAT",103,0)
 S DIR("T")=DTIME
"RTN","PSOSUCAT",104,0)
 D ^DIR K DIR S:$D(DIRUT)!(Y="E") PSOSTPF=1 Q:$D(PSOSTPF)
"RTN","PSOSUCAT",105,0)
 I Y="Rx" S PSOSULST($P(PSORESP,U,3),6)=""
"RTN","PSOSUCAT",106,0)
 I Y="OTC" S PSOSULST($P(PSORESP,U,3),9)=""
"RTN","PSOSUCAT",107,0)
 I Y="Both" S PSOSULST($P(PSORESP,U,3),6)="",PSOSULST($P(PSORESP,U,3),9)=""
"RTN","PSOSUCAT",108,0)
 D INCLD Q:$D(PSOSTPF)
"RTN","PSOSUCAT",109,0)
 Q
"RTN","PSOSUCAT",110,0)
C N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
"RTN","PSOSUCAT",111,0)
 S DIR(0)="LAO^1:5:0"
"RTN","PSOSUCAT",112,0)
 S DIR("A")="Enter a list or range of CS Federal Schedules to INCLUDE (1-5): "
"RTN","PSOSUCAT",113,0)
 I $P(PSOMOD,U) S DIR("A")="Enter list or range of CS Federal Schedules to EXCLUDE (1-5): "
"RTN","PSOSUCAT",114,0)
 S DIR("B")="1-5"
"RTN","PSOSUCAT",115,0)
 S DIR("?")="This response must be a list or range, e.g. 2,4 or 3-5."
"RTN","PSOSUCAT",116,0)
 S DIR("T")=DTIME
"RTN","PSOSUCAT",117,0)
 D ^DIR K DIR S:$D(DIRUT) PSOSTPF=1 Q:$D(PSOSTPF)
"RTN","PSOSUCAT",118,0)
 N XX F XX=1:1:($L(Y,",")-1) S PSOSULST($P(PSORESP,U,3),+$P(Y,",",XX))=""
"RTN","PSOSUCAT",119,0)
 D INCLD Q:$D(PSOSTPF)
"RTN","PSOSUCAT",120,0)
 Q
"RTN","PSOSUCAT",121,0)
D N PSODRG,PSOSORT,PSOSRT,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
"RTN","PSOSUCAT",122,0)
 D DSLCT S:'$O(PSOSULST($P(PSORESP,U,3),"")) PSOSTPF=1 Q:$D(PSOSTPF)  D
"RTN","PSOSUCAT",123,0)
 . W !!,"Drugs Selected:"
"RTN","PSOSUCAT",124,0)
 . S PSODRG=0 F  S PSODRG=$O(PSOSULST($P(PSORESP,U,3),PSODRG)) Q:'PSODRG  D
"RTN","PSOSUCAT",125,0)
 .. S PSOSORT($P(^PSDRUG(PSODRG,0),U))=""
"RTN","PSOSUCAT",126,0)
 . S PSOSRT="" F  S PSOSRT=$O(PSOSORT(PSOSRT)) Q:PSOSRT=""  D
"RTN","PSOSUCAT",127,0)
 .. W !,PSOSRT
"RTN","PSOSUCAT",128,0)
 Q
"RTN","PSOSUCAT",129,0)
DSLCT N DIC,X,Y,DTOUT,DUOUT
"RTN","PSOSUCAT",130,0)
 S DIC=50,DIC(0)="AEQM"
"RTN","PSOSUCAT",131,0)
DSLCT2 D ^DIC Q:Y'>0  S PSOSULST($P(PSORESP,U,3),+Y)=""
"RTN","PSOSUCAT",132,0)
 S DIC("A")="Select Another DRUG GENERIC NAME: "
"RTN","PSOSUCAT",133,0)
 G DSLCT2
"RTN","PSOSUCAT",134,0)
 Q
"RTN","PSOSUCAT",135,0)
V N PSOCLSS,PSOSORT,PSOSRT,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
"RTN","PSOSUCAT",136,0)
 D VSLCT S:'$O(PSOSULST($P(PSORESP,U,3),"")) PSOSTPF=1 Q:$D(PSOSTPF)  D
"RTN","PSOSUCAT",137,0)
 . W !!,"VA Classification Selected:"
"RTN","PSOSUCAT",138,0)
 . S PSOCLSS=0 F  S PSOCLSS=$O(PSOSULST($P(PSORESP,U,3),PSOCLSS)) Q:'PSOCLSS  D
"RTN","PSOSUCAT",139,0)
 .. S PSOSORT($P(^PS(50.605,PSOCLSS,0),U))=""
"RTN","PSOSUCAT",140,0)
 . S PSOSRT="" F  S PSOSRT=$O(PSOSORT(PSOSRT)) Q:PSOSRT=""  D
"RTN","PSOSUCAT",141,0)
 .. W !,PSOSRT
"RTN","PSOSUCAT",142,0)
 Q
"RTN","PSOSUCAT",143,0)
VSLCT N DIC,X,Y,DTOUT,DUOUT
"RTN","PSOSUCAT",144,0)
 S DIC=50.605,DIC(0)="AEQM"
"RTN","PSOSUCAT",145,0)
VSLCT2 N PSOCLSIN,PSOVACLS,CHLDCLSS
"RTN","PSOSUCAT",146,0)
 D ^DIC Q:Y'>0  S PSOCLSIN=+Y S PSOSULST($P(PSORESP,U,3),+Y)=""
"RTN","PSOSUCAT",147,0)
 S PSOVACLS=$P(^PS(50.605,PSOCLSIN,0),U)
"RTN","PSOSUCAT",148,0)
 D VDISP,VSPLIT
"RTN","PSOSUCAT",149,0)
 W !
"RTN","PSOSUCAT",150,0)
 S DIC("A")="Select Another VA DRUG CLASS CODE: "
"RTN","PSOSUCAT",151,0)
 G VSLCT2
"RTN","PSOSUCAT",152,0)
 Q
"RTN","PSOSUCAT",153,0)
VDISP N OI,PSODRG
"RTN","PSOSUCAT",154,0)
 N CNT S CNT=0
"RTN","PSOSUCAT",155,0)
 S OI=0 F  S OI=$O(^PSDRUG("AOC",OI)) Q:'OI  S PSODRG=0 F  S PSODRG=$O(^PSDRUG("AOC",OI,PSOVACLS,PSODRG)) Q:'PSODRG  D
"RTN","PSOSUCAT",156,0)
 . S CNT=CNT+1 I CNT=1 W !!,"Dispense Drugs for VA Class ",PSOVACLS," are:"
"RTN","PSOSUCAT",157,0)
 . W !,$P(^PSDRUG(PSODRG,0),U)
"RTN","PSOSUCAT",158,0)
 Q
"RTN","PSOSUCAT",159,0)
VSPLIT I $D(^PS(50.605,"AC",PSOCLSIN)) D
"RTN","PSOSUCAT",160,0)
 . S CHLDCLSS=0 F  S CHLDCLSS=$O(^PS(50.605,"AC",PSOCLSIN,CHLDCLSS)) D:$D(^PS(50.605,"AC",+CHLDCLSS)) VSPLIT2 Q:'+CHLDCLSS  D
"RTN","PSOSUCAT",161,0)
 .. S PSOSULST($P(PSORESP,U,3),+CHLDCLSS)="",PSOVACLS=$P(^PS(50.605,CHLDCLSS,0),"^") D VDISP
"RTN","PSOSUCAT",162,0)
 Q
"RTN","PSOSUCAT",163,0)
VSPLIT2 N CHLDCLSS2
"RTN","PSOSUCAT",164,0)
 S CHLDCLSS2=0 F  S CHLDCLSS2=$O(^PS(50.605,"AC",CHLDCLSS,CHLDCLSS2)) Q:'+CHLDCLSS2  S PSOSULST($P(PSORESP,U,3),+CHLDCLSS2)="",PSOVACLS=$P(^PS(50.605,CHLDCLSS2,0),"^") D VDISP
"RTN","PSOSUCAT",165,0)
 Q
"RTN","PSOSUCAT",166,0)
EN N PSODRUG,PSODEA,PSOIEN,PSOMW,PSOPP,PSONODE,PSOVACLS
"RTN","PSOSUCAT",167,0)
 S PSOIEN=+$G(^PS(52.5,SFN,0)) Q:'PSOIEN  S PSODRUG=$P($G(^PSRX(PSOIEN,0)),U,6)
"RTN","PSOSUCAT",168,0)
 S PSODEA=$P($G(^PSDRUG(PSODRUG,0)),U,3),PSOVACLS=$P($G(^PSDRUG(PSODRUG,0)),U,2),PSOOK=+PSOSULST($O(PSOSULST("")))
"RTN","PSOSUCAT",169,0)
 S PSONODE=$G(^PS(52.5,SFN,0)) D
"RTN","PSOSUCAT",170,0)
 . I $P(PSONODE,"^",5) S PSOMW=$P($G(^PSRX(+$G(PSONODE),"Q",$P(PSONODE,"^",5),0)),"^",2) Q
"RTN","PSOSUCAT",171,0)
 . I $P(PSONODE,"^",13)!($O(^PSRX(+$G(PSONODE),1,0))) D  Q
"RTN","PSOSUCAT",172,0)
 .. I $P(PSONODE,"^",13) S PSOMW=$P($G(^PSRX(+$G(PSONODE),1,$P(PSONODE,"^",13),0)),"^",2) Q
"RTN","PSOSUCAT",173,0)
 .. F PSOPP=0:0 S PSOPP=$O(^PSRX(+$G(PSONODE),1,PSOPP)) Q:'PSOPP  S PSOMW=$P($G(^PSRX(+$G(PSONODE),1,PSOPP,0)),"^",2)
"RTN","PSOSUCAT",174,0)
 . S PSOMW=$P($G(^PSRX(+$G(PSONODE),0)),"^",11)
"RTN","PSOSUCAT",175,0)
 D @$O(PSOSULST(""))
"RTN","PSOSUCAT",176,0)
 Q
"RTN","PSOSUCAT",177,0)
DEA N XX
"RTN","PSOSUCAT",178,0)
 S XX="" F  S XX=$O(PSOSULST("DEA",XX)) Q:'XX  I (PSODEA[XX)&(PSOMW[$P(PSOSULST("DEA"),U,2)) S PSOOK='PSOOK D
"RTN","PSOSUCAT",179,0)
 . I (($P(PSOSULST("DEA"),U,3)="Q")&(PSODEA["Q"))!(($P(PSOSULST("DEA"),U,4)="S")&(PSODEA["S")) S PSOOK='PSOOK
"RTN","PSOSUCAT",180,0)
 . I PSOOK'=+PSOSULST("DEA") Q
"RTN","PSOSUCAT",181,0)
 Q
"RTN","PSOSUCAT",182,0)
DRUG N PSODRG
"RTN","PSOSUCAT",183,0)
 S PSODRG="" F  S PSODRG=$O(PSOSULST("DRUG",PSODRG)) Q:'PSODRG  D
"RTN","PSOSUCAT",184,0)
 . I (PSODRUG=PSODRG)&(PSOMW[$P(PSOSULST("DRUG"),U,2)) S PSOOK='PSOOK Q
"RTN","PSOSUCAT",185,0)
 Q
"RTN","PSOSUCAT",186,0)
CLASS N PSOCLSS
"RTN","PSOSUCAT",187,0)
 S PSOCLSS="" F  S PSOCLSS=$O(PSOSULST("CLASS",PSOCLSS)) Q:'PSOCLSS  D
"RTN","PSOSUCAT",188,0)
 . I (PSOVACLS=$P(^PS(50.605,PSOCLSS,0),U))&(PSOMW[$P(PSOSULST("CLASS"),U,2)) S PSOOK='PSOOK Q
"RTN","PSOSUCAT",189,0)
 Q
"RTN","PSOSUCAT",190,0)
SUPPLY I (PSODEA["S")&(PSOMW[$P(PSOSULST("SUPPLY"),U,2)) S PSOOK='PSOOK
"RTN","PSOSUCAT",191,0)
 Q
"RTN","PSOSUCAT",192,0)
FRIDGE I (PSODEA["Q")&(PSOMW[$P(PSOSULST("FRIDGE"),U,2)) S PSOOK='PSOOK
"RTN","PSOSUCAT",193,0)
 Q
"RTN","PSOSULB1")
0^4^B47930066
"RTN","PSOSULB1",1,0)
PSOSULB1 ;BHAM ISC/RTR,SAB -Print suspended labels  cont. ;10/10/96
"RTN","PSOSULB1",2,0)
 ;;7.0;OUTPATIENT PHARMACY;**10,200,264,289,367,421,448,452**;DEC 1997;Build 56
"RTN","PSOSULB1",3,0)
 ;Reference to $$INSUR^IBBAPI supported by IA 4419
"RTN","PSOSULB1",4,0)
 ;Reference to $$BILLABLE^IBNCPDP supported by IA 6243
"RTN","PSOSULB1",5,0)
 ;
"RTN","PSOSULB1",6,0)
DEV D:'$D(PSOPAR) ^PSOLSET G:'$D(PSOPAR) DEV S PSOION=ION
"RTN","PSOSULB1",7,0)
 N X S X="PSXRSUS" X ^%ZOSF("TEST") G:($T)&($G(PSXSYS))&($D(^XUSEC("PSXCMOPMGR",DUZ)))&($D(^XUSEC("PSX XMIT",DUZ))) ^PSXRSUS
"RTN","PSOSULB1",8,0)
DEV1 I '$P(PSOPAR,"^",8) G START
"RTN","PSOSULB1",9,0)
 N PSOPROP,PFIO W $C(7),!!,"PROFILES MUST BE SENT TO PRINTER !!",! K IOP,%ZIS,IO("Q"),POP S %ZIS="MNQ",%ZIS("A")="Select PROFILE Device: " D ^%ZIS K %ZIS("A") G:POP EXIT^PSOSULBL G:$E(IOST)["C"!(PSOION=ION) DEV S PSOPROP=ION D ^%ZISC
"RTN","PSOSULB1",10,0)
START I $G(PSOCUTDT)']"" S X1=DT,X2=-120 D C^%DTC S PSODTCUT=X,PSOPRPAS=$P(PSOPAR,"^",7) G ^PSOSUCAT ;Print Suspense by Category //rtw
"RTN","PSOSULB1",11,0)
ASK K ^TMP($J),PSOSU,PSOSUSPR S PFIOQ=0,PDUZ=DUZ W !
"RTN","PSOSULB1",12,0)
 S %DT="AEX",%DT("A")="Print labels through date: ",%DT("B")="TODAY" D ^%DT K %DT D:Y<0 MESS G:Y<0 EXIT^PSOSULBL S PRTDT=Y
"RTN","PSOSULB1",13,0)
 I '$O(^PS(52.5,"C",0))!($O(^(0))>PRTDT) W $C(7),!!,"NOTHING THRU DATE TO PRINT" G ASK
"RTN","PSOSULB1",14,0)
 W ! K DIR S DIR("A")="Sort by Patient Name, ID#, or DEA Special Handling",DIR(0)="SB^P:PATIENT NAME;I:IDENTIFICATION NUMBER;D:DEA SPECIAL HANDLING"
"RTN","PSOSULB1",15,0)
 S DIR("?")="Enter 'P' to sort the labels alphabetically by name, enter 'I' to sort by identification number, enter 'D' to sort by DEA Special Handling."
"RTN","PSOSULB1",16,0)
 S DIR("?",1)="Sorting by DEA Special Handling will print the labels in three groups. The",DIR("?",2)="first will contain labels with drugs marked with an A or C in the DEA Special"
"RTN","PSOSULB1",17,0)
 S DIR("?",3)="Handling field, indicating NARCOTICS AND ALCOHOLICS, and CONTROLLED SUBSTANCES-",DIR("?",4)="NON NARCOTIC. The second group will contain ones marked with an S, indicating"
"RTN","PSOSULB1",18,0)
 S DIR("?",5)="SUPPLY, and all others will print in the third group.",DIR("?",6)=""
"RTN","PSOSULB1",19,0)
 S DIR("T")=DTIME
"RTN","PSOSULB1",20,0)
 D ^DIR K DIR D:$D(DIRUT) MESS G:$D(DIRUT) EXIT^PSOSULBL S PSRT=$S(Y="D":"D",Y="P":1,1:0)
"RTN","PSOSULB1",21,0)
 I Y="D" W ! K DIR S DIR(0)="SB^P:PATIENT NAME;I:IDENTIFICATION NUMBER",DIR("A")="Within DEA Special Handling, sort by Patient Name or ID#" D ^DIR K DIR D:$D(DIRUT) MESS G:$D(DIRUT) EXIT^PSOSULBL S PSRTONE=Y
"RTN","PSOSULB1",22,0)
 S X1=PRTDT,X2=$P(PSOPAR,"^",27) D C^%DTC S XDATE=X K IOP,POP,IO("Q"),ZTSK
"RTN","PSOSULB1",23,0)
PRLBL W ! S %ZIS("A")="Printer 'LABEL' Device: ",%ZIS("B")="",%ZIS="MQN" D ^%ZIS S PSLION=ION I POP S IOP=PSOION D ^%ZIS D MESS G EXIT^PSOSULBL
"RTN","PSOSULB1",24,0)
 I $E(IOST)'["P" D MESSL G PRLBL
"RTN","PSOSULB1",25,0)
 ;
"RTN","PSOSULB1",26,0)
FDAPRT ; Selects FDA Medication Guide Printer
"RTN","PSOSULB1",27,0)
 I $$GET1^DIQ(59,PSOSITE,134)'="" N FDAPRT S FDAPRT="" D  I FDAPRT="^"!($G(PSOFDAPT)="") G EXIT^PSOSULBL
"RTN","PSOSULB1",28,0)
 . F  D  Q:FDAPRT'=""
"RTN","PSOSULB1",29,0)
 . . S FDAPRT=$$SELPRT^PSOFDAUT($P($G(PSOFDAPT),"^"))
"RTN","PSOSULB1",30,0)
 . . I FDAPRT="" W $C(7),!,"You must select a valid FDA Medication Guide printer."
"RTN","PSOSULB1",31,0)
 . I FDAPRT'="",(FDAPRT'="^") S PSOFDAPT=FDAPRT
"RTN","PSOSULB1",32,0)
 ;
"RTN","PSOSULB1",33,0)
 N PSOIOS S PSOIOS=IOS D DEVBAR^PSOBMST
"RTN","PSOSULB1",34,0)
 S PSOBARS=PSOBAR1]""&(PSOBAR0]"")&$P(PSOPAR,"^",19)
"RTN","PSOSULB1",35,0)
 K PSOION D ^%ZISC I $D(IO("Q")) K IO("Q")
"RTN","PSOSULB1",36,0)
QUE K %DT,PSOTIME,PSOOUT D NOW^%DTC S %DT="REAX",%DT(0)=%,%DT("B")="NOW",%DT("A")="Queue to run at what time: " D ^%DT K %DT I $D(DTOUT)!(Y<0) D MESS G EXIT^PSOSULBL
"RTN","PSOSULB1",37,0)
 S (PSOSUSPR,PSODBQ)=1,PSOTIME=Y
"RTN","PSOSULB1",38,0)
 S ZTRTN="BEG^PSOSULBL",ZTDESC="PRINT LABELS FROM SUSPENSE",ZTIO=PSLION,ZTDTH=PSOTIME
"RTN","PSOSULB1",39,0)
 S ZTSAVE("PSOSULST(")="" ;Print Suspense by Category //RTW
"RTN","PSOSULB1",40,0)
 S PSOG="" F PSOG="PSOPAR","PSOSYS","PSOSUSPR","PSODBQ","PSRT","PSRTONE","PSOPROP","PSLION","PFIO","PSOBARS","PSODTCUT","PSOPRPAS","PRTDT","PDUZ","PSOBAR0","PSOBAR1","PSOSITE","XDATE","PSOTIME","PSOFDAPT" S:$D(@PSOG) ZTSAVE(PSOG)=""
"RTN","PSOSULB1",41,0)
 D ^%ZTLOAD W !!,"PRINT FROM SUSPENSE JOB QUEUED!",! D ^%ZISC G EXIT^PSOSULBL
"RTN","PSOSULB1",42,0)
 ;G:PSRT'="D" BEG^PSOSULBL
"RTN","PSOSULB1",43,0)
MESS W $C(7),!!?3,"NOTHING QUEUED TO PRINT!",! Q
"RTN","PSOSULB1",44,0)
MESSL W $C(7),!?3,"LABELS MUST BE SENT TO A PRINTER!",! Q
"RTN","PSOSULB1",45,0)
BAIMAIL ;Send mail message
"RTN","PSOSULB1",46,0)
 S:'$G(PDUZ) PDUZ=+$G(DUZ)
"RTN","PSOSULB1",47,0)
 K ^TMP("PSOM",$J)
"RTN","PSOSULB1",48,0)
 N SEQ,XMY,XMDUZ,XMSUB,XMTEXT,SEQ,NAME,PSSN,RX,FILL,FIRST
"RTN","PSOSULB1",49,0)
 S SEQ=1
"RTN","PSOSULB1",50,0)
 S XMY(PDUZ)=""
"RTN","PSOSULB1",51,0)
 S XMY("G.PSO EXTERNAL DISPENSE ALERTS")=""
"RTN","PSOSULB1",52,0)
 S XMDUZ="OUTPATIENT PHARMACY PACKAGE"
"RTN","PSOSULB1",53,0)
 S XMSUB="BAD ADDRESS SUSPENSE NOT PRINTED"
"RTN","PSOSULB1",54,0)
 I $G(PSOSITE) S XMSUB=$$GET1^DIQ(59,PSOSITE,.06)_" "_XMSUB
"RTN","PSOSULB1",55,0)
 S ^TMP("PSOM",$J,SEQ)="The following prescriptions with a routing of mail were not printed/sent to",SEQ=SEQ+1
"RTN","PSOSULB1",56,0)
 S ^TMP("PSOM",$J,SEQ)="external interface due to the BAD ADDRESS INDICATOR being set and no active",SEQ=SEQ+1
"RTN","PSOSULB1",57,0)
 S ^TMP("PSOM",$J,SEQ)="temporary address, or the patient has an active MAIL status of DO NOT MAIL, or",SEQ=SEQ+1
"RTN","PSOSULB1",58,0)
 S ^TMP("PSOM",$J,SEQ)="the patient has a foreign address:",SEQ=SEQ+1
"RTN","PSOSULB1",59,0)
 S NAME="" F  S NAME=$O(^TMP("PSOSM",$J,NAME)) Q:NAME=""  D
"RTN","PSOSULB1",60,0)
 .S PSSN="" F  S PSSN=$O(^TMP("PSOSM",$J,NAME,PSSN)) Q:PSSN=""  D
"RTN","PSOSULB1",61,0)
 ..S ^TMP("PSOM",$J,SEQ)="",SEQ=SEQ+1
"RTN","PSOSULB1",62,0)
 ..S ^TMP("PSOM",$J,SEQ)=NAME_"   "_PSSN,FIRST=1
"RTN","PSOSULB1",63,0)
 ..S RX=0 F  S RX=$O(^TMP("PSOSM",$J,NAME,PSSN,RX)) Q:'RX  S FILL="" F  S FILL=$O(^TMP("PSOSM",$J,NAME,PSSN,RX,FILL)) Q:FILL=""  D
"RTN","PSOSULB1",64,0)
 ...I FIRST D  S FIRST=0
"RTN","PSOSULB1",65,0)
 ....S ^TMP("PSOM",$J,SEQ)=^TMP("PSOM",$J,SEQ)_"   ("_$G(^TMP("PSOSM",$J,NAME,PSSN,RX,FILL))_")"
"RTN","PSOSULB1",66,0)
 ....S SEQ=SEQ+1
"RTN","PSOSULB1",67,0)
 ...S ^TMP("PSOM",$J,SEQ)="  "_$P(^PSRX(RX,0),"^")_" ("_FILL_")  "_$P($G(^PSDRUG($P(^PSRX(RX,0),"^",6),0)),"^"),SEQ=SEQ+1
"RTN","PSOSULB1",68,0)
 S ^TMP("PSOM",$J,SEQ+1)=""
"RTN","PSOSULB1",69,0)
 S XMTEXT="^TMP(""PSOM"",$J," N DIFROM D ^XMD K XMSUB,XMTEXT,XMY,XMDUZ
"RTN","PSOSULB1",70,0)
 Q
"RTN","PSOSULB1",71,0)
 ;Description: 
"RTN","PSOSULB1",72,0)
 ;This function determines whether the RX SUSPENSE has a DAYS SUPPLY HOLD
"RTN","PSOSULB1",73,0)
 ;condition.
"RTN","PSOSULB1",74,0)
 ;Input: REC = Pointer to Suspense file (#52.5)
"RTN","PSOSULB1",75,0)
 ;Returns: 1 or 0
"RTN","PSOSULB1",76,0)
 ;1 (one) if 3/4 of days supply has elapsed.
"RTN","PSOSULB1",77,0)
 ;0 (zero) is returned if 3/4 of days supply has not elapsed. 
"RTN","PSOSULB1",78,0)
 ;
"RTN","PSOSULB1",79,0)
DSH(REC) ; ePharmacy - verify that 3/4 days supply has elapsed before printing from suspense
"RTN","PSOSULB1",80,0)
 N PSINSUR,PSARR,SHDT,DSHOLD,DSHDT,PS0,COMM,DIE,DA,DR,RXIEN,RFL,DAYSSUP,LSTFIL,PTDFN,IBINS,DRG
"RTN","PSOSULB1",81,0)
 N SFN,SDT,ELIG,PREVRX
"RTN","PSOSULB1",82,0)
 S DSHOLD=1,PS0=^PS(52.5,REC,0),RXIEN=$P(PS0,U,1),RFL=$P(PS0,U,13)
"RTN","PSOSULB1",83,0)
 S LSTFIL=$$LSTRFL^PSOBPSU1(RXIEN),PTDFN=$$GET1^DIQ(52,RXIEN,"2","I")
"RTN","PSOSULB1",84,0)
 I RFL="" S RFL=LSTFIL
"RTN","PSOSULB1",85,0)
 S IBSTAT=$$INSUR^IBBAPI(PTDFN,,"E",.IBINS,"1"),DRG=$$GET1^DIQ(52,RXIEN,"6","I")
"RTN","PSOSULB1",86,0)
 S ELIG=$S(RFL:$P($G(^PSRX(+RXIEN,1,RFL,"EPH")),U,5),1:$P($G(^PSRX(+RXIEN,"EPH")),U,5))
"RTN","PSOSULB1",87,0)
 ;
"RTN","PSOSULB1",88,0)
 ; Don't hold Rx where the previous fill was not ebillable
"RTN","PSOSULB1",89,0)
 I LSTFIL>0,$$STATUS^BPSOSRX(RXIEN,LSTFIL-1)="" Q DSHOLD
"RTN","PSOSULB1",90,0)
 ; Don't hold when the Rx has SC/EI flagged
"RTN","PSOSULB1",91,0)
 I $P($G(^PSRX(RXIEN,"ICD",1,0)),U,2,10)[1 Q DSHOLD
"RTN","PSOSULB1",92,0)
 ; Don't hold rx if drug is non-billable
"RTN","PSOSULB1",93,0)
 I '$$BILLABLE^IBNCPDP(DRG,ELIG) Q DSHOLD ; IA# 6243
"RTN","PSOSULB1",94,0)
 ; Don't hold if no insurance
"RTN","PSOSULB1",95,0)
 I 'IBSTAT!(IBSTAT=-1) Q DSHOLD
"RTN","PSOSULB1",96,0)
 ;
"RTN","PSOSULB1",97,0)
 S DSHDT=$$DSHDT(RXIEN,RFL) ; 3/4 of days supply date
"RTN","PSOSULB1",98,0)
 S PREVRX=$P(DSHDT,U,2)
"RTN","PSOSULB1",99,0)
 S DSHDT=$P(DSHDT,U)
"RTN","PSOSULB1",100,0)
 I DSHDT>DT S DSHOLD=0 D
"RTN","PSOSULB1",101,0)
 . I DSHDT'=$P(PS0,U,14) D  ; Update Suspense Hold Date and Activity Log
"RTN","PSOSULB1",102,0)
 . . ; MRD;PSO*7*448 - If a previous Rx is used in the 3/4 days' supply 
"RTN","PSOSULB1",103,0)
 . . ; calculation, capture that Rx in the activity log.
"RTN","PSOSULB1",104,0)
 . . S COMM="3/4 of Days Supply SUSPENSE HOLD until "_$$FMTE^XLFDT(DSHDT,"2D")
"RTN","PSOSULB1",105,0)
 . . I PREVRX'="" S COMM=COMM_" (prior Rx "_PREVRX_")"
"RTN","PSOSULB1",106,0)
 . . S COMM=COMM_"."
"RTN","PSOSULB1",107,0)
 . . S DAYSSUP=$$LFDS(RXIEN)
"RTN","PSOSULB1",108,0)
 . . D RXACT^PSOBPSU2(RXIEN,RFL,COMM,"S",+$G(DUZ)) ; Update Activity Log
"RTN","PSOSULB1",109,0)
 . . S DR="10///^S X=DSHDT",DIE="^PS(52.5,",DA=REC D ^DIE ; File Suspense Hold Date
"RTN","PSOSULB1",110,0)
 . . N DA,DIE,DR,PSOX,SFN,INDT,DEAD,SUB,XOK,OLD,X,II
"RTN","PSOSULB1",111,0)
 . . S DA=REC,DIE="^PS(52.5,",DR=".02///"_DSHDT D ^DIE
"RTN","PSOSULB1",112,0)
 . . S SFN=REC,DEAD=0,INDT=DSHDT D CHANGE^PSOSUCH1(RXIEN,RFL)
"RTN","PSOSULB1",113,0)
 . . Q
"RTN","PSOSULB1",114,0)
 . Q
"RTN","PSOSULB1",115,0)
 Q DSHOLD
"RTN","PSOSULB1",116,0)
 ;
"RTN","PSOSULB1",117,0)
DSHDT(RXIEN,RFL) ; ePharmacy function to determine the 3/4 of the days supply date
"RTN","PSOSULB1",118,0)
 ; Input: RXIEN = Prescription file #52 ien
"RTN","PSOSULB1",119,0)
 ;          RFL = fill#
"RTN","PSOSULB1",120,0)
 ; Returns: DATE value of last date of service plus 3/4 of days supply
"RTN","PSOSULB1",121,0)
 ;       PREVRX = Previous Rx if PREVRX^PSOREJP2 identified one that
"RTN","PSOSULB1",122,0)
 ;                should be used in the 3/4 days' supply calculation.
"RTN","PSOSULB1",123,0)
 ;
"RTN","PSOSULB1",124,0)
 N FILLDT,DAYSSUP,DSH34,PREVRX
"RTN","PSOSULB1",125,0)
 I '$D(^PSRX(RXIEN,0)) Q -1
"RTN","PSOSULB1",126,0)
 I $G(RFL)="" Q -1
"RTN","PSOSULB1",127,0)
 ;
"RTN","PSOSULB1",128,0)
 D PREVRX^PSOREJP2(RXIEN,RFL,,.FILLDT,.DAYSSUP,.PREVRX)
"RTN","PSOSULB1",129,0)
 I FILLDT="" Q -1
"RTN","PSOSULB1",130,0)
 ;
"RTN","PSOSULB1",131,0)
 S DSH34=DAYSSUP*.75 ; 3/4 of Days Supply
"RTN","PSOSULB1",132,0)
 S:DSH34["." DSH34=(DSH34+1)\1
"RTN","PSOSULB1",133,0)
 ; Return last date of service plus 3/4 of Days Supply date
"RTN","PSOSULB1",134,0)
 ; and the previous Rx used in the calculation, if any.
"RTN","PSOSULB1",135,0)
 Q $$FMADD^XLFDT(FILLDT,DSH34)_U_PREVRX
"RTN","PSOSULB1",136,0)
 ;
"RTN","PSOSULB1",137,0)
 ;
"RTN","PSOSULB1",138,0)
 ; Description: This function returns the DAYS SUPPLY for the Latest Fill
"RTN","PSOSULB1",139,0)
 ; for a Prescription
"RTN","PSOSULB1",140,0)
 ; Input: RXIEN = Prescription file #52 IEN
"RTN","PSOSULB1",141,0)
 ; Returns: DAYS SUPPLY for the latest fill
"RTN","PSOSULB1",142,0)
 ;          -1 if RXIEN is not valid
"RTN","PSOSULB1",143,0)
LFDS(RXIEN) ;
"RTN","PSOSULB1",144,0)
 N RXFIL
"RTN","PSOSULB1",145,0)
 Q:'$D(^PSRX(RXIEN)) -1
"RTN","PSOSULB1",146,0)
 S RXFIL=$$LSTRFL^PSOBPSU1(RXIEN)
"RTN","PSOSULB1",147,0)
 Q $S(RXFIL=0:$P(^PSRX(RXIEN,0),U,8),1:$P(^PSRX(RXIEN,1,RXFIL,0),U,10))
"RTN","PSOSULB1",148,0)
 ;
"RTN","PSOSULBL")
0^10^B105467816
"RTN","PSOSULBL",1,0)
PSOSULBL ;BHAM ISC/RTR,SAB - Print Suspended labels ;4/8/93
"RTN","PSOSULBL",2,0)
 ;;7.0;OUTPATIENT PHARMACY;**139,173,174,148,200,260,264,287,289,290,354,421,370,427,466,539,452**;DEC 1997;Build 56
"RTN","PSOSULBL",3,0)
 ;External reference ^PS(55 supported by DBIA 2228
"RTN","PSOSULBL",4,0)
 ;Reference to SAVNDC^PSSNDCUT supported by IA 4707
"RTN","PSOSULBL",5,0)
 ;Reference ^PSDRUG( supported by DBIA 221
"RTN","PSOSULBL",6,0)
 K PDUZ,REPRINT G ^PSOSULB1
"RTN","PSOSULBL",7,0)
BEG ;
"RTN","PSOSULBL",8,0)
 K PSORUNIN,PSORETRY N BPSCNT
"RTN","PSOSULBL",9,0)
 S PSORUNIN="^XTMP(""PSOSUSP"")"     ; global lock fix by patch 290
"RTN","PSOSULBL",10,0)
 L +@PSORUNIN:10 I '$T D
"RTN","PSOSULBL",11,0)
 . F PSORETRY=1:1:120 L +@PSORUNIN:60 I $T Q  ;wait Max of 2 hrs before continue
"RTN","PSOSULBL",12,0)
 . Q
"RTN","PSOSULBL",13,0)
 K ^UTILITY($J,"PSOPRO"),^TMP("PSOSBAI",$J)
"RTN","PSOSULBL",14,0)
 S PSOSEQ=1 F DFN=0:0 S DFN=$O(^PS(52.5,"AC",DFN)) Q:'DFN  D
"RTN","PSOSULBL",15,0)
 . S (PSOSFLAG,DEAD)=0
"RTN","PSOSULBL",16,0)
 . F ZZ=0:0 S ZZ=$O(^PS(52.5,"AC",DFN,ZZ)) Q:'ZZ!$G(PSOSFLAG)  D
"RTN","PSOSULBL",17,0)
 . . I ZZ'>PRTDT S PSOSFLAG=1
"RTN","PSOSULBL",18,0)
 . D:'$G(PSRT) PID^VADPT6 D CHKDEAD I $G(DEAD) Q
"RTN","PSOSULBL",19,0)
 . I $G(PSOSFLAG) D PRT
"RTN","PSOSULBL",20,0)
 D PPL
"RTN","PSOSULBL",21,0)
 D:$D(^UTILITY($J,"PSOPRO"))&($P(PSOPAR,"^",8)) PROF
"RTN","PSOSULBL",22,0)
 G EXIT
"RTN","PSOSULBL",23,0)
PRT F SDT=0:0 S SDT=$O(^PS(52.5,"AC",DFN,SDT)) D:SDT CHK Q:'SDT
"RTN","PSOSULBL",24,0)
 Q
"RTN","PSOSULBL",25,0)
EXIT ;
"RTN","PSOSULBL",26,0)
 I $D(^TMP("PSOSBAI",$J)) D CHKMAIL
"RTN","PSOSULBL",27,0)
 K ^TMP($J),^TMP("PSOSBAI",$J)
"RTN","PSOSULBL",28,0)
 I $D(PSORUNIN) L -@PSORUNIN
"RTN","PSOSULBL",29,0)
 D ^%ZISC
"RTN","PSOSULBL",30,0)
 K %,%ZIS,CNT,COM,DA,DEAD,DFN,DIRUT,DTTM,G,HDPPL,JJ,JJJ,JJJJ,PDUZ,IOP,ORD,PFIOQ,PSLION,PSRT,POP,PRF,PRTDT,PSLIO,PSNP,PSODBQ,PSOSEQ,PSOSFLAG,PSOSU,PSOTIME,PSOOUT,PSOPRFLG,PSOSEQ,PSOSUSPR,PSSPND,PST,PTL,PPLHLD,PSFNIEN,ZTSK,PSOOK,PSOSULST
"RTN","PSOSULBL",31,0)
 K PSOBADDR,PSORUNIN,PSORETRY,PSRTONE,PSSRT,PSUSDEA,RF,RFCNT,RX,RXDFN,SDT,SFN,SREC,STOP,SUSPT,VADM,VAPA,X,X1,X2,XAK,XDATE,Y,Z,ZZ,WWW,PSDDDATE,SINRX,RXPR,RXPR1,GGGG,XXX,ZII,ZTDESC,ZTRTN,ZTSAVE,RRRR,RXRP,RXRP1,RXFL,SPR S:$D(ZTQUEUED) ZTREQ="@" Q
"RTN","PSOSULBL",32,0)
CHK I SDT'>XDATE D TMP Q
"RTN","PSOSULBL",33,0)
 Q
"RTN","PSOSULBL",34,0)
TMP F SFN=0:0 S SFN=$O(^PS(52.5,"AC",DFN,SDT,SFN)) Q:'SFN  D
"RTN","PSOSULBL",35,0)
 . I '$D(^PS(52.5,SFN,0))!'$D(^DPT(+DFN,0)) K ^PS(52.5,"AC",DFN,SDT,SFN) Q
"RTN","PSOSULBL",36,0)
 . I $D(PSOSULST) N PSOOK D EN^PSOSUCAT Q:'PSOOK  ;RTW line added for NSR20151109
"RTN","PSOSULBL",37,0)
 . N RXSITE,PRINTED,PSDFN,RXSTS,RXIEN,RXFILL,PARTIAL,RXEXPDT,RESP,DSHLD,ESTATUS
"RTN","PSOSULBL",38,0)
 . S RXIEN=+$$GET1^DIQ(52.5,SFN,.01,"I"),RXDFN=$$GET1^DIQ(52,RXIEN,2,"I")
"RTN","PSOSULBL",39,0)
 . S RXSTS=$$GET1^DIQ(52,RXIEN,100,"I"),RXSITE=+$$GET1^DIQ(52.5,SFN,.06,"I"),PRINTED=+$$GET1^DIQ(52.5,SFN,2,"I")
"RTN","PSOSULBL",40,0)
 . S PARTIAL=+$$GET1^DIQ(52.5,SFN,.05,"I"),RXEXPDT=$$GET1^DIQ(52,RXIEN,26,"I")
"RTN","PSOSULBL",41,0)
 . S RXFILL=$$GET1^DIQ(52.5,SFN,9,"I") I RXFILL="" S RXFILL=$$LSTRFL^PSOBPSU1(RXIEN)
"RTN","PSOSULBL",42,0)
 . I RXSITE=$G(PSOSITE),'PRINTED,RXDFN=DFN,RXSTS<9 D
"RTN","PSOSULBL",43,0)
 . . I PARTIAL,'$D(^PSRX(RXIEN,"P",PARTIAL)) Q
"RTN","PSOSULBL",44,0)
 . . ; If already printed and the REPRINT flag is not set, remove from queue and quit
"RTN","PSOSULBL",45,0)
 . . ; Line below commented out due to patient safety issue
"RTN","PSOSULBL",46,0)
 . . ; Refer to PSO*7.0*466
"RTN","PSOSULBL",47,0)
 . . ;I $$PRINTED(SFN,RXIEN,RXFILL)=1 D REMOVE(SFN,RXIEN,RXFILL,.5,"","") Q  
"RTN","PSOSULBL",48,0)
 . . I RXEXPDT<DT,RXSTS<11 D  Q
"RTN","PSOSULBL",49,0)
 . . . N RXREC S RXREC=RXIEN D EX^PSOSUTL
"RTN","PSOSULBL",50,0)
 . . . K DIE,DA S DIE=52,DA=RXIEN,DR="100///11" D ^DIE K DIE,DA
"RTN","PSOSULBL",51,0)
 . . . K DIK,DA S DA=SFN,DIK="^PS(52.5," D ^DIK K DIK,DA
"RTN","PSOSULBL",52,0)
 . . S PSOBADDR=0 D CHKBAI I PSOBADDR Q
"RTN","PSOSULBL",53,0)
 . . I PSRT="D" D
"RTN","PSOSULBL",54,0)
 . . . S PSSRT=$S($G(PSRTONE)="I":VA("PID"),1:$P(^DPT(DFN,0),"^")_$P(^(0),"^",9))
"RTN","PSOSULBL",55,0)
 . . . S PSUSDEA=$P($G(^PS(52.5,SFN,0)),"^",10)
"RTN","PSOSULBL",56,0)
 . . . S SRT=$S(PSUSDEA["A"!(PSUSDEA["C"):"A-"_PSSRT,PSUSDEA["S":"S-"_PSSRT,1:"Z-"_PSSRT)
"RTN","PSOSULBL",57,0)
 . . I PSRT'="D" D
"RTN","PSOSULBL",58,0)
 . . . S SRT=$S(PSRT:$P(^DPT(DFN,0),"^")_$P(^(0),"^",9),1:VA("PID"))
"RTN","PSOSULBL",59,0)
 . . ; - If not partial fill, sending Rx to ECME for 3rd Party billing
"RTN","PSOSULBL",60,0)
 . . I 'PARTIAL,$$RETRX^PSOBPSUT(RXIEN,RXFILL),SDT>DT Q
"RTN","PSOSULBL",61,0)
 . . S ESTATUS=$$STATUS^PSOBPSUT(RXIEN,RXFILL)
"RTN","PSOSULBL",62,0)
 . . I 'PARTIAL,ESTATUS'="",ESTATUS'["PAYABLE",'$$ECMESTAT^PSOBPSU2(RXIEN,RXFILL) Q  ;check for existing epharmacy reject codes
"RTN","PSOSULBL",63,0)
 . . I 'PARTIAL,RXFILL>0,$$STATUS^PSOBPSUT(RXIEN,RXFILL-1)'="" S DSHLD=$$DSH^PSOSULB1(SFN) Q:'DSHLD  ;epharmacy-3/4 days supply (refill)
"RTN","PSOSULBL",64,0)
 . . I 'PARTIAL,RXFILL=0 S DSHLD=$$DSH^PSOSULB1(SFN) Q:'DSHLD  ;epharmacy-3/4 days supply (original fill)
"RTN","PSOSULBL",65,0)
 . . I 'PARTIAL,$$FIND^PSOREJUT(RXIEN,RXFILL,,"79,88",,1) Q  ;check for DUR/RTS/RRR (again as it is done in ECMESTAT above)
"RTN","PSOSULBL",66,0)
 . . I 'PARTIAL,($$RETRX^PSOBPSUT(RXIEN,RXFILL)!$$ECMEST2^PSOBPSU2(RXIEN,RXFILL)) D  Q:$$TRISTA^PSOREJU3(RXIEN,RXFILL,.RESP,"PL")
"RTN","PSOSULBL",67,0)
 . . . D ECMESND^PSOBPSU1(RXIEN,RXFILL,,"PL",,,,,,.RESP)
"RTN","PSOSULBL",68,0)
 . . . I $D(RESP),'RESP S BPSCNT=$G(BPSCNT)+1
"RTN","PSOSULBL",69,0)
 . . S ^TMP($J,SRT,SFN)=RXIEN
"RTN","PSOSULBL",70,0)
 Q
"RTN","PSOSULBL",71,0)
PPL ; Wait some time before printing so response from 3rd party payers can be received
"RTN","PSOSULBL",72,0)
 I $G(BPSCNT)>0 H 60+$S((BPSCNT*15)>7200:7200,1:(BPSCNT*15))
"RTN","PSOSULBL",73,0)
 K PPL,PPL1 S ORD="" F  S ORD=$O(^TMP($J,ORD)) Q:ORD=""  D PPL1
"RTN","PSOSULBL",74,0)
 Q
"RTN","PSOSULBL",75,0)
PPL1 ; Printing Labels
"RTN","PSOSULBL",76,0)
 N PARTIAL,REPRINT,REFILL,Z,QUIT,ESTAT
"RTN","PSOSULBL",77,0)
 S (PSOPRFLG,SUSPT)=1 S:$D(PSOPROP) PFIO=PSOPROP
"RTN","PSOSULBL",78,0)
 S:'$D(PDUZ) PDUZ=DUZ K RXPR,RXPR1,PPL
"RTN","PSOSULBL",79,0)
 F SFN=0:0 S SFN=$O(^TMP($J,ORD,SFN)) Q:'SFN  D
"RTN","PSOSULBL",80,0)
 .I '$D(^PS(52.5,SFN,0)) Q
"RTN","PSOSULBL",81,0)
 .S Z=$G(^PS(52.5,SFN,0)),SINRX=+$P(Z,"^"),REFILL=+$P(Z,"^",13)
"RTN","PSOSULBL",82,0)
 .S PARTIAL=$P(Z,"^",5),REPRINT=$P(Z,"^",12)
"RTN","PSOSULBL",83,0)
 .; - Screening out OPEN/UNRESOLVED Rejects (3rd Party Payer) 
"RTN","PSOSULBL",84,0)
 .S QUIT=0
"RTN","PSOSULBL",85,0)
 .I 'PARTIAL,'REPRINT D  I QUIT Q
"RTN","PSOSULBL",86,0)
 ..I $$FIND^PSOREJUT(SINRX,REFILL,,"79,88",,1) S QUIT=1 Q
"RTN","PSOSULBL",87,0)
 ..S ESTAT=$$STATUS^PSOBPSUT(SINRX,REFILL)
"RTN","PSOSULBL",88,0)
 ..I ESTAT'="E PAYABLE",'$$ECMESTAT^PSOBPSU2(SINRX,REFILL) S QUIT=1 Q  ;host reject
"RTN","PSOSULBL",89,0)
 ..I ESTAT="E PAYABLE" D
"RTN","PSOSULBL",90,0)
 ...D SAVNDC^PSSNDCUT(+$$GET1^DIQ(52,SINRX,6,"I"),$$RXSITE^PSOBPSUT(SINRX,REFILL),$$GETNDC^PSONDCUT(SINRX,REFILL))
"RTN","PSOSULBL",91,0)
 .; 
"RTN","PSOSULBL",92,0)
 .I $L($G(PPL))<240 D
"RTN","PSOSULBL",93,0)
 ..S PPL=$P(^TMP($J,ORD,SFN),"^")_","_$G(PPL),RXPR(SINRX)=$P(^PS(52.5,SFN,0),"^",5)
"RTN","PSOSULBL",94,0)
 ..S:$P(^PS(52.5,SFN,0),"^",12) RXRP(SINRX)=1
"RTN","PSOSULBL",95,0)
 .E  D
"RTN","PSOSULBL",96,0)
 ..S PPL1=$P(^TMP($J,ORD,SFN),"^")_","_$G(PPL1),RXPR1(SINRX)=$P(^PS(52.5,SFN,0),"^",5)
"RTN","PSOSULBL",97,0)
 ..S:$P(^PS(52.5,SFN,0),"^",12) RXRP1(SINRX)=1
"RTN","PSOSULBL",98,0)
 .S DFN=$P(^PS(52.5,SFN,0),"^",3)
"RTN","PSOSULBL",99,0)
 .I $P(PSOPAR,"^",8),'$D(^PSRX($P(^PS(52.5,SFN,0),"^"),1)),'$G(RXPR(SINRX)),'$G(RXPR1(SINRX)) S PSOPRFLG=0
"RTN","PSOSULBL",100,0)
 S PSNP=$S($P(PSOPAR,"^",8):1,1:0)
"RTN","PSOSULBL",101,0)
 I $G(PPL) D
"RTN","PSOSULBL",102,0)
 .S PPLHLD=$G(PPL1),HDPPL=PPL K PPL1 S (PSODBQ,PSOSUSPR)=1
"RTN","PSOSULBL",103,0)
 .F GGGG=0:0 S GGGG=$O(RXPR(GGGG)) Q:'GGGG  K:'$G(RXPR(GGGG)) RXPR(GGGG)
"RTN","PSOSULBL",104,0)
 I $G(PPL) S ZTIO=$G(PSLION) D DQ^PSOLBL,SEQ D:'$G(PSOPRFLG) 
"RTN","PSOSULBL",105,0)
 .I $G(PSOPROP)'=$G(PSLION) S ^UTILITY($J,"PSOPRO",DFN)="" Q
"RTN","PSOSULBL",106,0)
 .D DQ^PSOPRFSS
"RTN","PSOSULBL",107,0)
 I $G(PPLHLD) K RXPR S (PPL,HDPPL)=PPLHLD,(PSODBQ,PSOSUSPR)=1,PSNP=0 S:'$D(PDUZ) PDUZ=DUZ F XXX=0:0 S XXX=$O(RXPR1(XXX)) Q:'XXX  S:$G(RXPR1(XXX)) RXPR(XXX)=RXPR1(XXX)
"RTN","PSOSULBL",108,0)
 I $G(PPLHLD) F RRRR=0:0 S RRRR=$O(RXRP1(RRRR)) Q:'RRRR  S:$D(RXRP1(RRRR)) RXRP(RRRR)=1
"RTN","PSOSULBL",109,0)
 I $G(PPLHLD) S ZTIO=$G(PSLION) D DQ^PSOLBL,SEQ D:'$G(PSOPRFLG)
"RTN","PSOSULBL",110,0)
 .I $G(PSOPROP)'=$G(PSLION) S ^UTILITY($J,"PSOPRO",DFN)="" Q
"RTN","PSOSULBL",111,0)
 .D DQ^PSOPRFSS
"RTN","PSOSULBL",112,0)
 K PPL,PPL1,PPLHLD,RXPR,RXPR1,RXFL Q
"RTN","PSOSULBL",113,0)
SEQ ;
"RTN","PSOSULBL",114,0)
 S SQCOUNT=0 F JJJ=1:1:$L(HDPPL) S:$E(HDPPL,JJJ)="," SQCOUNT=SQCOUNT+1
"RTN","PSOSULBL",115,0)
 F JJJJ=1:1:SQCOUNT S PSFNIEN=$P(HDPPL,",",JJJJ) D:PSFNIEN
"RTN","PSOSULBL",116,0)
 .S PSFNIEN=$O(^PS(52.5,"B",PSFNIEN,0)) I PSFNIEN D
"RTN","PSOSULBL",117,0)
 ..S $P(^PS(52.5,PSFNIEN,0),"^",11)=PSOSEQ,PSOSEQ=PSOSEQ+1 S:$P(^PS(52.5,PSFNIEN,0),"^",8)&($P(^(0),"^",9))&($P(^(0),"^",6)) ^PS(52.5,"AS",$P(^PS(52.5,PSFNIEN,0),"^",8),$P(^(0),"^",9),$P(^(0),"^",6),$P(^(0),"^",11),PSFNIEN)=""
"RTN","PSOSULBL",118,0)
 Q
"RTN","PSOSULBL",119,0)
CHKDEAD D DEM^VADPT I VADM(1)="" S DEAD=0 Q
"RTN","PSOSULBL",120,0)
 I VADM(6)="" S DEAD=0 Q
"RTN","PSOSULBL",121,0)
 S PSDDDATE=$P(VADM(6),"^",2) F WWW=0:0 S WWW=$O(^PS(55,DFN,"P",WWW)) Q:'WWW  I $D(^PS(55,DFN,"P",WWW,0)),$P($G(^(0)),"^") S (DA,RXREC)=$P(^(0),"^") S SFN=$O(^PS(52.5,"B",RXREC,0)) I SFN,$D(^PS(52.5,SFN,0)) S RX=$P(^(0),"^") D DEAD
"RTN","PSOSULBL",122,0)
 Q
"RTN","PSOSULBL",123,0)
DEAD S $P(^PSRX(RX,"STA"),"^")=12,COM="Died ("_$G(PSDDDATE)_")",DA(1)=RX
"RTN","PSOSULBL",124,0)
 S DEAD=1 D ARECD^PSOSUTL S DIK="^PS(52.5,",DA=SFN D ^DIK K DIK
"RTN","PSOSULBL",125,0)
 Q
"RTN","PSOSULBL",126,0)
PROF ;
"RTN","PSOSULBL",127,0)
 S ZTRTN="PRPROF^PSOSULBL",ZTDESC="PRINT PROFILES FROM SUSPENSE",ZTDTH=$H,ZTIO=PSOPROP
"RTN","PSOSULBL",128,0)
 S ZTSAVE("^UTILITY($J,""PSOPRO"",")="",ZTSAVE("PSOPAR")="",ZTSAVE("PSODTCUT")="",ZTSAVE("PSOSITE")="",ZTSAVE("PSOPRPAS")="" D ^%ZTLOAD Q
"RTN","PSOSULBL",129,0)
PRPROF ;
"RTN","PSOSULBL",130,0)
 F LLL=0:0 S LLL=$O(^UTILITY($J,"PSOPRO",LLL)) Q:'LLL  I $D(^DPT(LLL,0)) S DFN=LLL D DQ^PSOPRFSS
"RTN","PSOSULBL",131,0)
 K PSOPAR,PSODTCUT,PSOSITE,PSOPRPAS,LLL,DFN,^UTILITY($J,"PSOPRO") D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
"RTN","PSOSULBL",132,0)
 Q
"RTN","PSOSULBL",133,0)
 ;
"RTN","PSOSULBL",134,0)
CHKBAI ; IF BAD ADDRESS INDICATOR, NO ACTIVE TEMPORARY ADDRESS AND ROUTING OF MAIL, DO NOT SEND TO OPAI AND/OR DO NOT PRINT LABEL
"RTN","PSOSULBL",135,0)
 N PSOBADR,ACTSEQ,XX,PSOFIRST,ACTTYPE
"RTN","PSOSULBL",136,0)
 I '$G(RXFILL),$P(^PSRX(RXIEN,0),"^",11)="W" Q
"RTN","PSOSULBL",137,0)
 I $P($G(^PSRX(RXIEN,1,RXFILL,0)),"^",2)="W" Q
"RTN","PSOSULBL",138,0)
 S ACTTYPE="BAD ADDRESS INDICATOR"
"RTN","PSOSULBL",139,0)
 S PSOBADR=$$CHKRX^PSOBAI(RXIEN)
"RTN","PSOSULBL",140,0)
 ; GOOD PERMANENT OR TEMPORARY ADDRESS - CHECK FOR DO NOT MAIL
"RTN","PSOSULBL",141,0)
 I PSOBADR,'$P(PSOBADR,"^",2) D SETTMP(ACTTYPE) Q
"RTN","PSOSULBL",142,0)
 S NOMAIL=0 D NOMAIL I NOMAIL Q
"RTN","PSOSULBL",143,0)
 D FOREIGN
"RTN","PSOSULBL",144,0)
 Q
"RTN","PSOSULBL",145,0)
 ;
"RTN","PSOSULBL",146,0)
SETTMP(ACTTYPE) ;
"RTN","PSOSULBL",147,0)
 N ACTSEQ,XX,PSOFIRST,ZZ
"RTN","PSOSULBL",148,0)
 S PSOFIRST=1
"RTN","PSOSULBL",149,0)
 S PSOBADDR=1
"RTN","PSOSULBL",150,0)
 S ACTSEQ=0 F  S ACTSEQ=$O(^PSRX(RXIEN,"A",ACTSEQ)) Q:ACTSEQ=""  D
"RTN","PSOSULBL",151,0)
 .S XX=$G(^PSRX(RXIEN,"A",ACTSEQ,0)) I $P(XX,"^",2)="S" S ZZ=$P(XX,"^",4),ZZ=$S(ZZ<6:ZZ,1:ZZ-1) I ZZ=RXFILL,$P(XX,"^",5)["due to "_ACTTYPE S PSOFIRST=0 Q
"RTN","PSOSULBL",152,0)
 I PSOFIRST D
"RTN","PSOSULBL",153,0)
 .S ^TMP("PSOSBAI",$J,RXIEN,+RXFILL)=ACTTYPE
"RTN","PSOSULBL",154,0)
 .D ACT(ACTTYPE)
"RTN","PSOSULBL",155,0)
 Q
"RTN","PSOSULBL",156,0)
 ;
"RTN","PSOSULBL",157,0)
NOMAIL ; SEE IF FILE 55 STATUS IS DO NOT MAIL
"RTN","PSOSULBL",158,0)
 N ACTTYPE,DFN,MAILST,MAILEXP
"RTN","PSOSULBL",159,0)
 S ACTTYPE="DO NOT MAIL"
"RTN","PSOSULBL",160,0)
 S DFN=+$P($G(^PSRX(RXIEN,0)),"^",2),MAILST=$P($G(^PS(55,DFN,0)),"^",3) I MAILST'=2 Q
"RTN","PSOSULBL",161,0)
 S MAILEXP=$P(^PS(55,DFN,0),"^",5)
"RTN","PSOSULBL",162,0)
 I MAILEXP=""!(MAILEXP>DT) D SETTMP(ACTTYPE)
"RTN","PSOSULBL",163,0)
 Q
"RTN","PSOSULBL",164,0)
 ;
"RTN","PSOSULBL",165,0)
FOREIGN ;
"RTN","PSOSULBL",166,0)
 N DFN,PSOFORGN
"RTN","PSOSULBL",167,0)
 S DFN=$$GET1^DIQ(52,RXIEN,2,"I")  ;*370
"RTN","PSOSULBL",168,0)
 D ADD^VADPT
"RTN","PSOSULBL",169,0)
 S PSOFORGN=$P($G(VAPA(25)),"^",2) I PSOFORGN'="" D  ; *370
"RTN","PSOSULBL",170,0)
 . N PSON,PSOFOREN S PSOFOREN=1
"RTN","PSOSULBL",171,0)
 . S PSON=$$GET1^DIQ(59,PSOSITE,.01)
"RTN","PSOSULBL",172,0)
 . I PSON'["MANILA",PSOFORGN["UNITED STATES" S PSOFOREN=0
"RTN","PSOSULBL",173,0)
 . I PSON["MANILA",PSOFORGN["PHILIPPINES" S PSOFOREN=0
"RTN","PSOSULBL",174,0)
 . S PSOFORGN=PSOFOREN
"RTN","PSOSULBL",175,0)
 I PSOFORGN D SETTMP("FOREIGN ADDRESS")
"RTN","PSOSULBL",176,0)
 Q
"RTN","PSOSULBL",177,0)
 ;
"RTN","PSOSULBL",178,0)
CHKMAIL ; SEE IF MAILMAN MESSAGE SHOULD BE SENT FOR BAI/MAIL ROUTING
"RTN","PSOSULBL",179,0)
 N RXIEN,RXFILL,ACTSEQ,XX,DFN,SSN,NAME,ACTTYPE,ZZ
"RTN","PSOSULBL",180,0)
 K ^TMP("PSOSM",$J)
"RTN","PSOSULBL",181,0)
 S RXIEN=0 F  S RXIEN=$O(^TMP("PSOSBAI",$J,RXIEN)) Q:'RXIEN  D
"RTN","PSOSULBL",182,0)
 .S RXFILL="" F  S RXFILL=$O(^TMP("PSOSBAI",$J,RXIEN,RXFILL)) Q:RXFILL=""  D
"RTN","PSOSULBL",183,0)
 ..S ACTTYPE=^TMP("PSOSBAI",$J,RXIEN,RXFILL)
"RTN","PSOSULBL",184,0)
 ..S ACTSEQ=0 F  S ACTSEQ=$O(^PSRX(RXIEN,"A",ACTSEQ)) Q:ACTSEQ=""  D
"RTN","PSOSULBL",185,0)
 ...S XX=$G(^PSRX(RXIEN,"A",ACTSEQ,0)) I $P(XX,"^",2)="S" S ZZ=$P(XX,"^",4),ZZ=$S(ZZ<6:ZZ,1:ZZ-1) I ZZ=RXFILL,$P(XX,"^",5)["due to "_ACTTYPE Q
"RTN","PSOSULBL",186,0)
 ...S DFN=$P(^PSRX(RXIEN,0),"^",2),NAME=$P(^DPT(DFN,0),"^"),SSN=$P(^(0),"^",9) I SSN="" S SSN=0
"RTN","PSOSULBL",187,0)
 ...S ^TMP("PSOSM",$J,NAME,SSN,RXIEN,RXFILL)=ACTTYPE
"RTN","PSOSULBL",188,0)
 I $D(^TMP("PSOSM",$J)) D BAIMAIL^PSOSULB1
"RTN","PSOSULBL",189,0)
 K ^TMP("PSOSM",$J)
"RTN","PSOSULBL",190,0)
 Q
"RTN","PSOSULBL",191,0)
 ;
"RTN","PSOSULBL",192,0)
ACT(ACTTYPE) ;adds activity info for rx not printed from suspense/not sent to OPAI
"RTN","PSOSULBL",193,0)
 N NOW,IR,FDA
"RTN","PSOSULBL",194,0)
 D NOW^%DTC S NOW=%
"RTN","PSOSULBL",195,0)
 S IR=0 F FDA=0:0 S FDA=$O(^PSRX(RXIEN,"A",FDA)) Q:'FDA  S IR=FDA
"RTN","PSOSULBL",196,0)
 S IR=IR+1,^PSRX(RXIEN,"A",0)="^52.3DA^"_IR_"^"_IR
"RTN","PSOSULBL",197,0)
 S ^PSRX(RXIEN,"A",IR,0)=NOW_"^"_"S"_"^"_DUZ_"^"_$S(+RXFILL>5:RXFILL+1,1:+RXFILL)_"^"_"RX not printed from suspense due to "_ACTTYPE
"RTN","PSOSULBL",198,0)
 K PSUS,RXF,I,FDA,DIC,DIE,DR,Y,X,%,%I,%H,RSDT
"RTN","PSOSULBL",199,0)
 Q
"RTN","PSOSULBL",200,0)
 ;
"RTN","PSOSULBL",201,0)
PRINTED(SFN,RX,RFL) ;
"RTN","PSOSULBL",202,0)
 ; Check if a label log indicates that a label has already been printed
"RTN","PSOSULBL",203,0)
 ; Input Parameters
"RTN","PSOSULBL",204,0)
 ;    SFN - IEN of RX Suspense file (#52.5)
"RTN","PSOSULBL",205,0)
 ;    RX  - IEN of Prescription file (#50)
"RTN","PSOSULBL",206,0)
 ;    RFL - Refill number
"RTN","PSOSULBL",207,0)
 ; Output
"RTN","PSOSULBL",208,0)
 ;     0 - Label not printed
"RTN","PSOSULBL",209,0)
 ;     1 - Label already printed
"RTN","PSOSULBL",210,0)
 ;     2 - Label already printed and reprint flag is set
"RTN","PSOSULBL",211,0)
 ;
"RTN","PSOSULBL",212,0)
 ; Check parameters
"RTN","PSOSULBL",213,0)
 I '$G(SFN) Q 0
"RTN","PSOSULBL",214,0)
 I '$G(RX) Q 0
"RTN","PSOSULBL",215,0)
 I $G(RFL)="" S RFL=$$LSTRFL^PSOBPSU1(RX)
"RTN","PSOSULBL",216,0)
 ;
"RTN","PSOSULBL",217,0)
 N LBL,PTLBL
"RTN","PSOSULBL",218,0)
 ; Check label log
"RTN","PSOSULBL",219,0)
 S LBL=0,PTLBL=0
"RTN","PSOSULBL",220,0)
 F  S LBL=$O(^PSRX(RX,"L",LBL)) Q:'LBL  D  Q:PTLBL
"RTN","PSOSULBL",221,0)
 . I +$$GET1^DIQ(52.032,LBL_","_RX,1,"I")'=RFL Q
"RTN","PSOSULBL",222,0)
 . I $$GET1^DIQ(52.032,LBL_","_RX,4,"I") Q    ; Warning Label printed
"RTN","PSOSULBL",223,0)
 . I $$GET1^DIQ(52.032,LBL_","_RX,2)["INTERACTION" Q  ; Comment contains "Interaction"
"RTN","PSOSULBL",224,0)
 . S PTLBL=1
"RTN","PSOSULBL",225,0)
 ; If the label log indicates a label was printed and the REPRINT flag is set, change the output to 2
"RTN","PSOSULBL",226,0)
 I PTLBL=1,$$GET1^DIQ(52.5,SFN_",",8,"I") S PTLBL=2
"RTN","PSOSULBL",227,0)
 ; 
"RTN","PSOSULBL",228,0)
 Q PTLBL
"RTN","PSOSULBL",229,0)
 ;
"RTN","PSOSULBL",230,0)
REMOVE(SFN,RX,RFL,USR,DSP,PRTFLG) ;
"RTN","PSOSULBL",231,0)
 ; Remove the RX from the RX Suspense queue (#52.5)
"RTN","PSOSULBL",232,0)
 ; Input Parameters
"RTN","PSOSULBL",233,0)
 ;    SFN - IEN of RX Suspense file (#52.5)
"RTN","PSOSULBL",234,0)
 ;    RX  - IEN of Prescription file (#52)
"RTN","PSOSULBL",235,0)
 ;    RFL - Refill number
"RTN","PSOSULBL",236,0)
 ;    USR - User to enter into the Activity Log
"RTN","PSOSULBL",237,0)
 ;    DSP - Display message
"RTN","PSOSULBL",238,0)
 ;    PRTFLG - 1:Printed,2:Printed and Reprint Flag
"RTN","PSOSULBL",239,0)
 ;
"RTN","PSOSULBL",240,0)
 ; If Reprint flag and display flags are on, display message and quit
"RTN","PSOSULBL",241,0)
 I $G(PRTFLG)=2,$G(DSP)  W !,"Reprint Flag is on.  Prescription left on suspense." H 1 Q
"RTN","PSOSULBL",242,0)
 ;
"RTN","PSOSULBL",243,0)
 ; Check parameters
"RTN","PSOSULBL",244,0)
 I '$G(SFN) Q
"RTN","PSOSULBL",245,0)
 I '$D(^PS(52.5,SFN,0)) Q
"RTN","PSOSULBL",246,0)
 I '$G(RX) Q
"RTN","PSOSULBL",247,0)
 I '$D(^PSRX(RX,0)) Q
"RTN","PSOSULBL",248,0)
 I $G(RFL)="" S RFL=$$LSTRFL^PSOBPSU1(RX)
"RTN","PSOSULBL",249,0)
 ;
"RTN","PSOSULBL",250,0)
 N DIK,DA,DIE,DR,DTOUT
"RTN","PSOSULBL",251,0)
 ;
"RTN","PSOSULBL",252,0)
 ; Remove from the suspense queue
"RTN","PSOSULBL",253,0)
 S DIK="^PS(52.5,",DA=SFN D ^DIK
"RTN","PSOSULBL",254,0)
 ;
"RTN","PSOSULBL",255,0)
 ; Update status in the PRESCRIPTION file
"RTN","PSOSULBL",256,0)
 K DIE,DA
"RTN","PSOSULBL",257,0)
 S DIE=52,DA=RX,DR="100///0" D ^DIE
"RTN","PSOSULBL",258,0)
 ; 
"RTN","PSOSULBL",259,0)
 ; Update the Activity Log
"RTN","PSOSULBL",260,0)
 I '$D(USR) S USR=DUZ
"RTN","PSOSULBL",261,0)
 I '$D(^VA(200,+USR,0)) S USR=DUZ
"RTN","PSOSULBL",262,0)
 N X,DIC,DA,DD,DO,DR,DINUM,Y,DLAYGO
"RTN","PSOSULBL",263,0)
 S DA(1)=RX,DIC="^PSRX("_RX_",""A"",",DLAYGO=52.3,DIC(0)="L",X=$$NOW^XLFDT()
"RTN","PSOSULBL",264,0)
 S DIC("DR")=".02///S;.03////"_USR_";.04///"_$S(RFL>5:RFL+1,1:RFL)_";.05///Rx removed from suspense due to previous label print"
"RTN","PSOSULBL",265,0)
 D FILE^DICN
"RTN","PSOSULBL",266,0)
 I $G(DSP) W !,"Prescription has been removed from suspense." H 1
"RTN","PSOSULBL",267,0)
 Q
"VER")
8.0^22.2
**INSTALL NAME**
PSS*1.0*215
"BLD",10375,0)
PSS*1.0*215^PHARMACY DATA MANAGEMENT^0^3181024^y
"BLD",10375,1,0)
^^11^11^3180516^
"BLD",10375,1,1,0)
Patch PSS*1.0*215 is part of a Multi Build with patch PS0*7.0*452.
"BLD",10375,1,2,0)
PSO*7.0*452 contains the routine changes.
"BLD",10375,1,3,0)
PSS*1.0*215 contains the DD changes.
"BLD",10375,1,4,0)
 
"BLD",10375,1,5,0)
The NSRs involved in this build are:
"BLD",10375,1,6,0)
NSR20150311 High Cost Rx Report;  NSR20151109 Pharmacy Print from Suspense
"BLD",10375,1,7,0)
by Category; NSR20150512 Early Warning Advisory for Approaching the 
"BLD",10375,1,8,0)
end of Rx Number Ranges; and NSR20151001 Pharmacy Patient Demographics.
"BLD",10375,1,9,0)
 
"BLD",10375,1,10,0)
This build contains the Data Dictionary changes in support of PSO*7.0*452 
"BLD",10375,1,11,0)
and is a required build for PSO*7.0*452
"BLD",10375,4,0)
^9.64PA^59.7^2
"BLD",10375,4,55,0)
55
"BLD",10375,4,55,2,0)
^9.641^55.0109^1
"BLD",10375,4,55,2,55.0109,0)
CLINICAL ALERTS  (sub-file)
"BLD",10375,4,55,2,55.0109,1,0)
^9.6411^1^2
"BLD",10375,4,55,2,55.0109,1,.01,0)
CLINICAL ALERT DATE/TIME
"BLD",10375,4,55,2,55.0109,1,1,0)
TEXT
"BLD",10375,4,55,222)
y^n^p^^^^n^^n
"BLD",10375,4,55,224)

"BLD",10375,4,59.7,0)
59.7
"BLD",10375,4,59.7,2,0)
^9.641^59.7^1
"BLD",10375,4,59.7,2,59.7,0)
PHARMACY SYSTEM  (File-top level)
"BLD",10375,4,59.7,2,59.7,1,0)
^9.6411^48^1
"BLD",10375,4,59.7,2,59.7,1,48,0)
RX# UPPER BOUND WARNING LIMIT
"BLD",10375,4,59.7,222)
y^n^p^^^^n^^n
"BLD",10375,4,59.7,224)

"BLD",10375,4,"APDD",55,55.0109)

"BLD",10375,4,"APDD",55,55.0109,.01)

"BLD",10375,4,"APDD",55,55.0109,1)

"BLD",10375,4,"APDD",59.7,59.7)

"BLD",10375,4,"APDD",59.7,59.7,48)

"BLD",10375,4,"B",55,55)

"BLD",10375,4,"B",59.7,59.7)

"BLD",10375,6.3)
45
"BLD",10375,"ABPKG")
n
"BLD",10375,"KRN",0)
^9.67PA^779.2^20
"BLD",10375,"KRN",.4,0)
.4
"BLD",10375,"KRN",.4,"NM",0)
^9.68A^^
"BLD",10375,"KRN",.401,0)
.401
"BLD",10375,"KRN",.402,0)
.402
"BLD",10375,"KRN",.402,"NM",0)
^9.68A^1^1
"BLD",10375,"KRN",.402,"NM",1,0)
PSO CLINICAL ALERT ENTER/EDIT    FILE #55^55^0
"BLD",10375,"KRN",.402,"NM","B","PSO CLINICAL ALERT ENTER/EDIT    FILE #55",1)

"BLD",10375,"KRN",.403,0)
.403
"BLD",10375,"KRN",.5,0)
.5
"BLD",10375,"KRN",.84,0)
.84
"BLD",10375,"KRN",3.6,0)
3.6
"BLD",10375,"KRN",3.8,0)
3.8
"BLD",10375,"KRN",9.2,0)
9.2
"BLD",10375,"KRN",9.8,0)
9.8
"BLD",10375,"KRN",19,0)
19
"BLD",10375,"KRN",19.1,0)
19.1
"BLD",10375,"KRN",101,0)
101
"BLD",10375,"KRN",409.61,0)
409.61
"BLD",10375,"KRN",771,0)
771
"BLD",10375,"KRN",779.2,0)
779.2
"BLD",10375,"KRN",870,0)
870
"BLD",10375,"KRN",8989.51,0)
8989.51
"BLD",10375,"KRN",8989.51,"NM",0)
^9.68A^^0
"BLD",10375,"KRN",8989.52,0)
8989.52
"BLD",10375,"KRN",8994,0)
8994
"BLD",10375,"KRN","B",.4,.4)

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

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

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

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

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

"BLD",10375,"KRN","B",3.6,3.6)

"BLD",10375,"KRN","B",3.8,3.8)

"BLD",10375,"KRN","B",9.2,9.2)

"BLD",10375,"KRN","B",9.8,9.8)

"BLD",10375,"KRN","B",19,19)

"BLD",10375,"KRN","B",19.1,19.1)

"BLD",10375,"KRN","B",101,101)

"BLD",10375,"KRN","B",409.61,409.61)

"BLD",10375,"KRN","B",771,771)

"BLD",10375,"KRN","B",779.2,779.2)

"BLD",10375,"KRN","B",870,870)

"BLD",10375,"KRN","B",8989.51,8989.51)

"BLD",10375,"KRN","B",8989.52,8989.52)

"BLD",10375,"KRN","B",8994,8994)

"BLD",10375,"QDEF")
^^^^NO^^^^NO^^NO
"BLD",10375,"QUES",0)
^9.62^^
"BLD",10375,"REQB",0)
^9.611^1^1
"BLD",10375,"REQB",1,0)
PSO*7.0*452^0
"BLD",10375,"REQB","B","PSO*7.0*452",1)

"FIA",55)
PHARMACY PATIENT
"FIA",55,0)
^PS(55,
"FIA",55,0,0)
55P
"FIA",55,0,1)
y^n^p^^^^n^^n
"FIA",55,0,10)

"FIA",55,0,11)

"FIA",55,0,"RLRO")

"FIA",55,0,"VR")
1.0^PSS
"FIA",55,55)
1
"FIA",55,55,109)

"FIA",55,55.0109)
1
"FIA",55,55.0109,.01)

"FIA",55,55.0109,1)

"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^n^p^^^^n^^n
"FIA",59.7,0,10)

"FIA",59.7,0,11)

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

"FIA",59.7,0,"VR")
1.0^PSS
"FIA",59.7,59.7)
1
"FIA",59.7,59.7,48)

"KRN",.402,2856,-1)
0^1
"KRN",.402,2856,0)
PSO CLINICAL ALERT ENTER/EDIT^3170922.1548^^55^^^3181024
"KRN",.402,2856,"%D",0)
^^2^2^3170922^
"KRN",.402,2856,"%D",1,0)
This INPUT TEMPLATE allows Enter/Edit of the CLINICAL ALERT multiple
"KRN",.402,2856,"%D",2,0)
(field #109) in PHARMACY PATIENT file (#55).
"KRN",.402,2856,"DIAB",1,1,55.0109,0)
ALL
"KRN",.402,2856,"DR",1,55)
109;
"KRN",.402,2856,"DR",2,55.0109)
.01:1
"MBREQ")
0
"ORD",7,.402)
.402;7;;;EDEOUT^DIFROMSO(.402,DA,"",XPDA);FPRE^DIFROMSI(.402,"",XPDA);EPRE^DIFROMSI(.402,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.402,DA,"",XPDA);DEL^DIFROMSK(.402,"",%)
"ORD",7,.402,0)
INPUT TEMPLATE
"PKG",586,-1)
1^1
"PKG",586,0)
PHARMACY DATA MANAGEMENT^PSS^Maintenance of Pharmacy files.
"PKG",586,20,0)
^9.402P^^
"PKG",586,22,0)
^9.49I^1^1
"PKG",586,22,1,0)
1.0^2970930^2971128^1
"PKG",586,22,1,"PAH",1,0)
215^3181024
"PKG",586,22,1,"PAH",1,1,0)
^^11^11^3181024
"PKG",586,22,1,"PAH",1,1,1,0)
Patch PSS*1.0*215 is part of a Multi Build with patch PS0*7.0*452.
"PKG",586,22,1,"PAH",1,1,2,0)
PSO*7.0*452 contains the routine changes.
"PKG",586,22,1,"PAH",1,1,3,0)
PSS*1.0*215 contains the DD changes.
"PKG",586,22,1,"PAH",1,1,4,0)
 
"PKG",586,22,1,"PAH",1,1,5,0)
The NSRs involved in this build are:
"PKG",586,22,1,"PAH",1,1,6,0)
NSR20150311 High Cost Rx Report;  NSR20151109 Pharmacy Print from Suspense
"PKG",586,22,1,"PAH",1,1,7,0)
by Category; NSR20150512 Early Warning Advisory for Approaching the 
"PKG",586,22,1,"PAH",1,1,8,0)
end of Rx Number Ranges; and NSR20151001 Pharmacy Patient Demographics.
"PKG",586,22,1,"PAH",1,1,9,0)
 
"PKG",586,22,1,"PAH",1,1,10,0)
This build contains the Data Dictionary changes in support of PSO*7.0*452 
"PKG",586,22,1,"PAH",1,1,11,0)
and is a required build for PSO*7.0*452
"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
"UP",55,55.0109,-1)
55^2
"UP",55,55.0109,0)
55.0109
"VER")
8.0^22.2
"^DD",55,55,109,0)
CLINICAL ALERT^55.0109ID^^2;0
"^DD",55,55,109,21,0)
^.001^3^3^3171128^^^^
"^DD",55,55,109,21,1,0)
The CLINICAL ALERTS (multiple) allows Pharmacy staff to document clinical 
"^DD",55,55,109,21,2,0)
information that is not covered anywhere else in the VistA packages,  
"^DD",55,55,109,21,3,0)
e.g. when a patient is part of a research study.
"^DD",55,55,109,"DT")
3171128
"^DD",55,55.0109,0)
CLINICAL ALERT SUB-FIELD^^1^2
"^DD",55,55.0109,0,"NM","CLINICAL ALERT")

"^DD",55,55.0109,.01,0)
DATE/TIME OF ALERT^DX^^0;1^S %DT="ESTR" D ^%DT S X=Y K:Y<1 X I $D(X) S DINUM=9999999.999999-X
"^DD",55,55.0109,.01,1,0)
^.1
"^DD",55,55.0109,.01,1,1,0)
55.0109^B
"^DD",55,55.0109,.01,1,1,1)
S ^PS(55,DA(1),2,"B",$E(X,1,30),DA)=""
"^DD",55,55.0109,.01,1,1,2)
K ^PS(55,DA(1),2,"B",$E(X,1,30),DA)
"^DD",55,55.0109,.01,3)
Answer with DATE/TIME for the CLINICAL ALERT.
"^DD",55,55.0109,.01,21,0)
^.001^1^1^3171128^^^^
"^DD",55,55.0109,.01,21,1,0)
This field represents the CLINICAL ALERT DATE/TIME.
"^DD",55,55.0109,.01,"DT")
3171128
"^DD",55,55.0109,1,0)
TEXT^RFJ245^^1;1^K:$L(X)>245!($L(X)<2) X
"^DD",55,55.0109,1,3)
Answer must be 2-245 characters in length.
"^DD",55,55.0109,1,21,0)
^.001^1^1^3170808^^^
"^DD",55,55.0109,1,21,1,0)
This field represents the CLINICAL ALERT information.
"^DD",55,55.0109,1,"DT")
3170808
"^DD",59.7,59.7,48,0)
RX# UPPER BOUND WARNING LIMIT^NJ4,0^^48;1^K:+X'=X!(X>9999)!(X<1)!(X?.E1"."1N.N) X
"^DD",59.7,59.7,48,.1)
EARLY WARNING
"^DD",59.7,59.7,48,3)
Type a number between 1 and 9999. 0 decimal digits.  1000 is the default used by the software if left blank.
"^DD",59.7,59.7,48,21,0)
^.001^5^5^3180621^^^^
"^DD",59.7,59.7,48,21,1,0)
This field represents the Outpatient Pharmacy RX# UPPER BOUND WARNING 
"^DD",59.7,59.7,48,21,2,0)
LIMIT.  A MailMan notification to a mail group of the impending end of 
"^DD",59.7,59.7,48,21,3,0)
prescription number range is generated when this limit value is reached.  
"^DD",59.7,59.7,48,21,4,0)
The default value used by the software is 1000.  Sites may edit this limit
"^DD",59.7,59.7,48,21,5,0)
number as appropriate for their site, or left blank if 1000 is sufficient.
"^DD",59.7,59.7,48,23,0)
^^5^5^3180621^
"^DD",59.7,59.7,48,23,1,0)
This parameter can be set for the early warning of impendng end to
"^DD",59.7,59.7,48,23,2,0)
a sites prescription Numbering limits. If used the designated pharmacy
"^DD",59.7,59.7,48,23,3,0)
mailgroup will be notified when the end of the numbering system is within
"^DD",59.7,59.7,48,23,4,0)
the amount set by this parameter. 1000 is the default used by the software
"^DD",59.7,59.7,48,23,5,0)
if left blank.
"^DD",59.7,59.7,48,"DT")
3181003
**END**
**END**