Released PSO*7*832 SEQ #685
Extracted from mail message
**KIDS**:PSO*7.0*832^

**INSTALL NAME**
PSO*7.0*832
"BLD",14962,0)
PSO*7.0*832^OUTPATIENT PHARMACY^0^3260529^y
"BLD",14962,1,0)
^^2^2^3260522^
"BLD",14962,1,1,0)
Please review FORUM's Patch Module description and installation  
"BLD",14962,1,2,0)
instructions before installing this patch.
"BLD",14962,4,0)
^9.64PA^^
"BLD",14962,6)
1
"BLD",14962,6.3)
4
"BLD",14962,"ABPKG")
n
"BLD",14962,"KRN",0)
^9.67PA^18.12^26
"BLD",14962,"KRN",.4,0)
.4
"BLD",14962,"KRN",.401,0)
.401
"BLD",14962,"KRN",.402,0)
.402
"BLD",14962,"KRN",.403,0)
.403
"BLD",14962,"KRN",.5,0)
.5
"BLD",14962,"KRN",.84,0)
.84
"BLD",14962,"KRN",1.5,0)
1.5
"BLD",14962,"KRN",1.6,0)
1.6
"BLD",14962,"KRN",1.61,0)
1.61
"BLD",14962,"KRN",1.62,0)
1.62
"BLD",14962,"KRN",3.6,0)
3.6
"BLD",14962,"KRN",3.8,0)
3.8
"BLD",14962,"KRN",9.2,0)
9.2
"BLD",14962,"KRN",9.8,0)
9.8
"BLD",14962,"KRN",9.8,"NM",0)
^9.68A^2^2
"BLD",14962,"KRN",9.8,"NM",1,0)
PSOVEXR1^^0^B43309952
"BLD",14962,"KRN",9.8,"NM",2,0)
PSO52API^^0^B86313724
"BLD",14962,"KRN",9.8,"NM","B","PSO52API",2)

"BLD",14962,"KRN",9.8,"NM","B","PSOVEXR1",1)

"BLD",14962,"KRN",18.12,0)
18.12
"BLD",14962,"KRN",19,0)
19
"BLD",14962,"KRN",19.1,0)
19.1
"BLD",14962,"KRN",101,0)
101
"BLD",14962,"KRN",409.61,0)
409.61
"BLD",14962,"KRN",771,0)
771
"BLD",14962,"KRN",779.2,0)
779.2
"BLD",14962,"KRN",870,0)
870
"BLD",14962,"KRN",8989.51,0)
8989.51
"BLD",14962,"KRN",8989.52,0)
8989.52
"BLD",14962,"KRN",8993,0)
8993
"BLD",14962,"KRN",8994,0)
8994
"BLD",14962,"KRN","B",.4,.4)

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

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

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

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

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

"BLD",14962,"KRN","B",1.5,1.5)

"BLD",14962,"KRN","B",1.6,1.6)

"BLD",14962,"KRN","B",1.61,1.61)

"BLD",14962,"KRN","B",1.62,1.62)

"BLD",14962,"KRN","B",3.6,3.6)

"BLD",14962,"KRN","B",3.8,3.8)

"BLD",14962,"KRN","B",9.2,9.2)

"BLD",14962,"KRN","B",9.8,9.8)

"BLD",14962,"KRN","B",18.12,18.12)

"BLD",14962,"KRN","B",19,19)

"BLD",14962,"KRN","B",19.1,19.1)

"BLD",14962,"KRN","B",101,101)

"BLD",14962,"KRN","B",409.61,409.61)

"BLD",14962,"KRN","B",771,771)

"BLD",14962,"KRN","B",779.2,779.2)

"BLD",14962,"KRN","B",870,870)

"BLD",14962,"KRN","B",8989.51,8989.51)

"BLD",14962,"KRN","B",8989.52,8989.52)

"BLD",14962,"KRN","B",8993,8993)

"BLD",14962,"KRN","B",8994,8994)

"BLD",14962,"QDEF")
^^^^NO^^^^NO^^NO
"BLD",14962,"QUES",0)
^9.62^^
"BLD",14962,"REQB",0)
^9.611^2^2
"BLD",14962,"REQB",1,0)
PSO*7.0*653^1
"BLD",14962,"REQB",2,0)
PSO*7.0*744^1
"BLD",14962,"REQB","B","PSO*7.0*653",1)

"BLD",14962,"REQB","B","PSO*7.0*744",2)

"MBREQ")
0
"PKG",206,-1)
1^1
"PKG",206,0)
OUTPATIENT PHARMACY^PSO^OUTPATIENT LABELS, PROFILE, INVENTORY, PRESCRIPTIONS
"PKG",206,22,0)
^9.49I^1^1
"PKG",206,22,1,0)
7.0^3021122^3021202^66481
"PKG",206,22,1,"PAH",1,0)
832^3260529
"PKG",206,22,1,"PAH",1,1,0)
^^2^2^3260529
"PKG",206,22,1,"PAH",1,1,1,0)
Please review FORUM's Patch Module description and installation  
"PKG",206,22,1,"PAH",1,1,2,0)
instructions before installing this patch.
"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")
2
"RTN","PSO52API")
0^2^B86313724^B85808658
"RTN","PSO52API",1,0)
PSO52API ;BHAM ISC/SAB - Encap II API to return Rx data; May 22, 2026@11:20
"RTN","PSO52API",2,0)
 ;;7.0;OUTPATIENT PHARMACY;**213,229,252,387,386,566,441,712,744,832**;DEC 1997;Build 4
"RTN","PSO52API",3,0)
 ; Reference to ^PS(55 in ICR #2228
"RTN","PSO52API",4,0)
 ;
"RTN","PSO52API",5,0)
RX(DFN,LIST,IEN,RX,NODE,SDATE,EDATE) ;
"RTN","PSO52API",6,0)
 ;DFN: IEN from the PATIENT file (#2) [REQUIRED]
"RTN","PSO52API",7,0)
 ;LIST: Subscript name used in ^TMP global [REQUIRED]
"RTN","PSO52API",8,0)
 ;IEN: Internal prescription number [optional]
"RTN","PSO52API",9,0)
 ;RX#: RX # field (#.01) of the PRESCRIPTION file (#52) [optional]
"RTN","PSO52API",10,0)
 ;NODE: Determines data elements returned [optional]
"RTN","PSO52API",11,0)
 ;SDATE: Start Date [optional]
"RTN","PSO52API",12,0)
 ;EDATE: End Date [optional]
"RTN","PSO52API",13,0)
 ;
"RTN","PSO52API",14,0)
 Q:'$G(DFN)  Q:$G(LIST)=""
"RTN","PSO52API",15,0)
 N DA,DR,PST,DIC,DIQ,ND,LK,DTE,DAT,I,X,D0 K ^TMP($J,LIST) S ^TMP($J,LIST,DFN,0)=0
"RTN","PSO52API",16,0)
 I $G(IEN) D PROCESS G CLEAN
"RTN","PSO52API",17,0)
 I $G(RX)]"",'$G(IEN) S IEN=$O(^PSRX("B",RX,0)) D  G CLEAN
"RTN","PSO52API",18,0)
 .I 'IEN S ^TMP($J,LIST,DFN,0)="-1^NO DATA FOUND" Q
"RTN","PSO52API",19,0)
 .D PROCESS
"RTN","PSO52API",20,0)
 D DATE
"RTN","PSO52API",21,0)
CLEAN F I=0:0 S I=$O(^TMP($J,LIST,DFN,I)) Q:'I  S ^TMP($J,LIST,DFN,0)=^TMP($J,LIST,DFN,0)+1
"RTN","PSO52API",22,0)
 I ^TMP($J,LIST,DFN,0)=0 S ^TMP($J,LIST,DFN,0)="-1^NO DATA FOUND"
"RTN","PSO52API",23,0)
 K DA,DR,DIC,ND,DAT,PST,LK,DIQ,DTE,I,X
"RTN","PSO52API",24,0)
 Q
"RTN","PSO52API",25,0)
PROCESS ;
"RTN","PSO52API",26,0)
 I DFN'=$P($G(^PSRX(IEN,0)),"^",2) S ^TMP($J,LIST,IEN,0)="-1^NO DATA FOUND (MISMATCHED PATIENT)" Q
"RTN","PSO52API",27,0)
 I $G(^PSRX(IEN,0))']"" S ^TMP($J,LIST,IEN,0)="-1^NO RX DATA FOUND" Q
"RTN","PSO52API",28,0)
 ;
"RTN","PSO52API",29,0)
 ; - Rx Auto Expiration
"RTN","PSO52API",30,0)
 N RXSTS,RXEXPDT
"RTN","PSO52API",31,0)
 S RXSTS=+$G(^PSRX(IEN,"STA")),RXEXPDT=$$GET1^DIQ(52,IEN,26,"I")
"RTN","PSO52API",32,0)
 I (RXSTS<11)!(RXSTS=16),(RXEXPDT<DT) D
"RTN","PSO52API",33,0)
 .S RXSTS=11 N DIE,DIC,DR,DA,STAT,PHARMST,COMM
"RTN","PSO52API",34,0)
 .S DIE=52,DA=IEN,DR="100////11" D ^DIE K DIE,DIC,DR
"RTN","PSO52API",35,0)
 .D ECAN^PSOUTL(IEN)
"RTN","PSO52API",36,0)
 .S STAT="SC",PHARMST="ZE",COMM="Medication Expired on "_$$FMTE^XLFDT(RXEXPDT,2)
"RTN","PSO52API",37,0)
 .D EN^PSOHLSN1(IEN,STAT,PHARMST,COMM)
"RTN","PSO52API",38,0)
 ;
"RTN","PSO52API",39,0)
 I $G(NODE)']"" D ZE,TW,TH,MI,ST,RF,CM,AT,LB,CPRS,PT^PSO52B,SD^PSO52B,TB^PSO52B,OI^PSO52B,MLT^PSO52B,IND S DAT="I" D IB Q
"RTN","PSO52API",40,0)
 D ST F LK=1:1:$L(NODE,",") S DAT=$P(NODE,",",LK),ND=$P(DAT,"^") D
"RTN","PSO52API",41,0)
 .I ND=0 D ZE Q
"RTN","PSO52API",42,0)
 .I ND=2 D ZE,TW Q
"RTN","PSO52API",43,0)
 .I ND=3 D TW,TH Q
"RTN","PSO52API",44,0)
 .I ND="R" D RF Q
"RTN","PSO52API",45,0)
 .I ND="I" D IB Q
"RTN","PSO52API",46,0)
 .I ND="P" D PT^PSO52B Q
"RTN","PSO52API",47,0)
 .I ND="O" D OI^PSO52B Q
"RTN","PSO52API",48,0)
 .I ND="T" D TB^PSO52B Q
"RTN","PSO52API",49,0)
 .I ND="L" D LB Q
"RTN","PSO52API",50,0)
 .I ND="S" D SD^PSO52B Q
"RTN","PSO52API",51,0)
 .I ND="M" D MI Q
"RTN","PSO52API",52,0)
 .I ND="C" D CM Q
"RTN","PSO52API",53,0)
 .I ND="A" D AT Q
"RTN","PSO52API",54,0)
 .I ND="ST" D ST Q
"RTN","PSO52API",55,0)
 .I ND="CPRS" D CPRS Q
"RTN","PSO52API",56,0)
 .I ND="ICD" D MLT^PSO52B Q
"RTN","PSO52API",57,0)
 .I ND="IND" D IND Q
"RTN","PSO52API",58,0)
 .S ^TMP($J,LIST,DFN,IEN,"INVALID REQUEST",ND)="Invalid Data Requested"
"RTN","PSO52API",59,0)
 Q
"RTN","PSO52API",60,0)
ZE ;zero
"RTN","PSO52API",61,0)
 K PST S DIC=52,DA=IEN,DR=".01:9;10.3;10.6;11;14;16;17" D DIQ
"RTN","PSO52API",62,0)
 F DR=.01,1,2,3,4,5,6,6.5,7,8,9,10.3,10.6,11,14,16,17 D
"RTN","PSO52API",63,0)
 .I PST(52,DA,DR,"E")'=PST(52,DA,DR,"I") S ^TMP($J,LIST,DFN,IEN,DR)=PST(52,DA,DR,"I")_"^"_PST(52,DA,DR,"E") Q
"RTN","PSO52API",64,0)
 .S ^TMP($J,LIST,DFN,IEN,DR)=PST(52,DA,DR,"I")
"RTN","PSO52API",65,0)
 K DA,DR,PST,DIC,DIQ
"RTN","PSO52API",66,0)
 Q
"RTN","PSO52API",67,0)
TW ;two
"RTN","PSO52API",68,0)
 Q:'$D(^PSRX(IEN,2))
"RTN","PSO52API",69,0)
 K PST S DIC=52,DA=IEN,DR="20:31;32.1;32.2;32.3;104" D DIQ
"RTN","PSO52API",70,0)
 F DR=20,21,22,23,24,25,26,27,28,29,30,31,32.1,32.2,32.3,104 D
"RTN","PSO52API",71,0)
 .I PST(52,DA,DR,"E")'=PST(52,DA,DR,"I") S ^TMP($J,LIST,DFN,IEN,DR)=PST(52,DA,DR,"I")_"^"_PST(52,DA,DR,"E") Q
"RTN","PSO52API",72,0)
 .S ^TMP($J,LIST,DFN,IEN,DR)=PST(52,DA,DR,"I")
"RTN","PSO52API",73,0)
 K DA,DR,PST,DIC,DIQ
"RTN","PSO52API",74,0)
 Q
"RTN","PSO52API",75,0)
TH ;three
"RTN","PSO52API",76,0)
 Q:'$D(^PSRX(IEN,3))
"RTN","PSO52API",77,0)
 K PST S DIC=52,DA=IEN,DR="12;26.1;34.1;101;102;102.1;102.2;109;112" D DIQ
"RTN","PSO52API",78,0)
 F DR=12,26.1,34.1,101,102,102.1,102.2,109,112 D
"RTN","PSO52API",79,0)
 .I PST(52,DA,DR,"E")'=PST(52,DA,DR,"I") S ^TMP($J,LIST,DFN,IEN,DR)=PST(52,DA,DR,"I")_"^"_PST(52,DA,DR,"E") Q
"RTN","PSO52API",80,0)
 .S ^TMP($J,LIST,DFN,IEN,DR)=PST(52,DA,DR,"I")
"RTN","PSO52API",81,0)
 K DA,DR,PST,DIC,DIQ
"RTN","PSO52API",82,0)
 Q
"RTN","PSO52API",83,0)
MI ;sig
"RTN","PSO52API",84,0)
 I $P($G(^PSRX(IEN,"SIG")),"^",2) D  Q
"RTN","PSO52API",85,0)
 .I '$O(^PSRX(IEN,"SIG1",0)) S ^TMP($J,LIST,DFN,IEN,"M",0)="-1^NO DATA FOUND" Q
"RTN","PSO52API",86,0)
 .F I=0:0 S I=$O(^PSRX(IEN,"SIG1",I)) Q:'I  S ^TMP($J,LIST,DFN,IEN,"M",I,0)=^PSRX(IEN,"SIG1",I,0),^TMP($J,LIST,DFN,IEN,"M",0)=$G(^TMP($J,LIST,DFN,IEN,"M",0))+1
"RTN","PSO52API",87,0)
 I $P($G(^PSRX(IEN,"SIG")),"^")']"" S ^TMP($J,LIST,DFN,IEN,"M",0)="-1^NO DATA FOUND" Q
"RTN","PSO52API",88,0)
 S X=$P($G(^PSRX(IEN,"SIG")),"^") D SIG^PSOHELP S ^TMP($J,LIST,DFN,IEN,"M",1,0)=$E(INS1,2,9999999),^TMP($J,LIST,DFN,IEN,"M",0)=1
"RTN","PSO52API",89,0)
 K X,INS1
"RTN","PSO52API",90,0)
 Q
"RTN","PSO52API",91,0)
ST ;status
"RTN","PSO52API",92,0)
 I DT>$P(^PSRX(IEN,2),"^",6),$P(^PSRX(IEN,"STA"),"^")<11 D
"RTN","PSO52API",93,0)
 .N PSOEXRX,PSOEXSTA,ORN,PIFN,PSUSD,PRFDT,PDA,PSST
"RTN","PSO52API",94,0)
 .S PSOEXRX=IEN D EN2^PSOMAUEX K PSOEXRX,PSONM,PSONMX
"RTN","PSO52API",95,0)
 K PST S DIC=52,DA=IEN,DR=".01;100" D DIQ
"RTN","PSO52API",96,0)
 I PST(52,DA,100,"E")="DRUG INTERACTIONS" S PST(52,DA,100,"E")="NON-VERIFIED"
"RTN","PSO52API",97,0)
 S ^TMP($J,LIST,DFN,IEN,100)=PST(52,DA,100,"I")_"^"_PST(52,DA,100,"E")
"RTN","PSO52API",98,0)
 I PST(52,DA,100,"E")="ACTIVE",$G(^PSRX(DA,"PARK")),(LIST="OROCLST"!(LIST["MHV")!($E(LIST,1,4)="GMTS")) S ^TMP($J,LIST,DFN,IEN,100)=^TMP($J,LIST,DFN,IEN,100)_"/PARKED"
"RTN","PSO52API",99,0)
 S ^TMP($J,LIST,"B",PST(52,DA,.01,"E"),IEN)=""
"RTN","PSO52API",100,0)
 K DA,DR,PST,DIC,DIQ
"RTN","PSO52API",101,0)
 Q
"RTN","PSO52API",102,0)
RF ;refill
"RTN","PSO52API",103,0)
 I '$O(^PSRX(IEN,1,0)) S ^TMP($J,LIST,DFN,IEN,"RF",0)="-1^NO DATA FOUND" Q
"RTN","PSO52API",104,0)
 I $P($G(DAT),"^",3) S DA(52.1)=$P(DAT,"^",3) D RFD K DA,DR,PST,DIC,DIQ Q
"RTN","PSO52API",105,0)
 F RF=0:0 S RF=$O(^PSRX(IEN,1,RF)) Q:'RF  S DA(52.1)=RF D RFD
"RTN","PSO52API",106,0)
 K DA,DR,PST,DIC,DIQ,RF
"RTN","PSO52API",107,0)
 Q
"RTN","PSO52API",108,0)
RFD K PST S DR(52.1)=".01:8;10.1;11;12;13;14;15;17;23",DIC=52,DA=IEN,DR=52 D DIQ
"RTN","PSO52API",109,0)
 I $P($G(DAT),"^",3),'$G(PST(52.1,DA(52.1),.01,"I")) S ^TMP($J,LIST,DFN,IEN,"RF",0)="-1^NO DATA FOUND" Q
"RTN","PSO52API",110,0)
 S ^TMP($J,LIST,DFN,IEN,"RF",0)=$G(^TMP($J,LIST,DFN,IEN,"RF",0))+1
"RTN","PSO52API",111,0)
 F DR=.01,1,1.1,1.2,2,3,4,5,6,7,8,10.1,11,12,13,14,15,17,23 D
"RTN","PSO52API",112,0)
 .I PST(52.1,DA(52.1),DR,"E")'=PST(52.1,DA(52.1),DR,"I") S ^TMP($J,LIST,DFN,IEN,"RF",DA(52.1),DR)=PST(52.1,DA(52.1),DR,"I")_"^"_PST(52.1,DA(52.1),DR,"E") Q
"RTN","PSO52API",113,0)
 .S ^TMP($J,LIST,DFN,IEN,"RF",DA(52.1),DR)=PST(52.1,DA(52.1),DR,"I")
"RTN","PSO52API",114,0)
 Q
"RTN","PSO52API",115,0)
IB ;ib ori
"RTN","PSO52API",116,0)
 I $P($G(DAT),"^",2)="R" D IBR Q
"RTN","PSO52API",117,0)
 I $G(^PSRX(IEN,"IB"))']"" S ^TMP($J,LIST,DFN,IEN,"IB",0)="-1^NO DATA FOUND" Q
"RTN","PSO52API",118,0)
 K PST S DIC=52,DA=IEN,DR="105;106;106.5;106.6" D DIQ
"RTN","PSO52API",119,0)
 F DR=105,106,106.5,106.6 D
"RTN","PSO52API",120,0)
 .I PST(52,DA,DR,"E")'=PST(52,DA,DR,"I") S ^TMP($J,LIST,DFN,IEN,DR)=PST(52,DA,DR,"I")_"^"_PST(52,DA,DR,"E") Q
"RTN","PSO52API",121,0)
 .S ^TMP($J,LIST,DFN,IEN,DR)=PST(52,DA,DR,"E")
"RTN","PSO52API",122,0)
 K DA,DR,PST,DIC,DIQ
"RTN","PSO52API",123,0)
 I $P($G(DAT),"^",2)="" D IBR Q
"RTN","PSO52API",124,0)
 Q
"RTN","PSO52API",125,0)
IBR ;ib ref
"RTN","PSO52API",126,0)
 I '$O(^PSRX(IEN,1,0)) S ^TMP($J,LIST,DFN,IEN,"IB",0)="-1^NO DATA FOUND" Q
"RTN","PSO52API",127,0)
 I $P($G(DAT),"^",2)="R",$P($G(DAT),"^",3) S DA(52.1)=$P(DAT,"^",3) D IBS K DA,DR,PST,DIC,DIQ Q
"RTN","PSO52API",128,0)
 N IB F IB=0:0 S IB=$O(^PSRX(IEN,1,IB)) Q:'IB  S DA(52.1)=IB D IBS
"RTN","PSO52API",129,0)
 I '$G(^TMP($J,LIST,DFN,IEN,"IB",0)) K ^TMP($J,LIST,DFN,IEN,"IB") S ^TMP($J,LIST,DFN,IEN,"IB",0)="-1^NO DATA FOUND"
"RTN","PSO52API",130,0)
 K DA,DR,PST,DIC,DIQ,IB
"RTN","PSO52API",131,0)
 Q
"RTN","PSO52API",132,0)
IBS I $P($G(DAT),"^",3),'$G(^PSRX(IEN,1,DA(52.1),"IB")) S ^TMP($J,LIST,DFN,IEN,"IB",0)="-1^NO DATA FOUND" Q
"RTN","PSO52API",133,0)
 I '$D(^PSRX(IEN,1,DA(52.1),"IB")) S ^TMP($J,LIST,DFN,IEN,"IB",DA(52.1),0)="-1^NO DATA FOUND" Q
"RTN","PSO52API",134,0)
 K PST S DR(52.1)="9;9.1",DIC=52,DA=IEN,DR=52 D DIQ
"RTN","PSO52API",135,0)
 S ^TMP($J,LIST,DFN,IEN,"IB",0)=$G(^TMP($J,LIST,DFN,IEN,"IB",0))+1
"RTN","PSO52API",136,0)
 F DR=9,9.1 D
"RTN","PSO52API",137,0)
 .I PST(52.1,DA(52.1),DR,"E")'=PST(52.1,DA(52.1),DR,"I") S ^TMP($J,LIST,DFN,IEN,"IB",DA(52.1),DR)=PST(52.1,DA(52.1),DR,"I")_"^"_PST(52.1,DA(52.1),DR,"E") Q
"RTN","PSO52API",138,0)
 .S ^TMP($J,LIST,DFN,IEN,"IB",DA(52.1),DR)=PST(52.1,DA(52.1),DR,"I")
"RTN","PSO52API",139,0)
 Q
"RTN","PSO52API",140,0)
CM ;cmop
"RTN","PSO52API",141,0)
 I '$O(^PSRX(IEN,4,0)) S ^TMP($J,LIST,DFN,IEN,"C",0)="-1^NO DATA FOUND" Q
"RTN","PSO52API",142,0)
 N CM F CM=0:0 S CM=$O(^PSRX(IEN,4,CM)) Q:'CM  S DA(52.01)=CM D CMP
"RTN","PSO52API",143,0)
 K DA,DR,PST,DIC,DIQ,CM
"RTN","PSO52API",144,0)
 Q
"RTN","PSO52API",145,0)
CMP S ^TMP($J,LIST,DFN,IEN,"C",0)=$G(^TMP($J,LIST,DFN,IEN,"C",0))+1
"RTN","PSO52API",146,0)
 K PST S DR(52.01)=".01;2;3;4;9:12",DIC=52,DA=IEN,DR=400 D DIQ
"RTN","PSO52API",147,0)
 F DR=.01,2,3,4,9,10,11,12 D
"RTN","PSO52API",148,0)
 .I PST(52.01,DA(52.01),DR,"E")'=PST(52.01,DA(52.01),DR,"I") S ^TMP($J,LIST,DFN,IEN,"C",DA(52.01),DR)=PST(52.01,DA(52.01),DR,"I")_"^"_PST(52.01,DA(52.01),DR,"E") Q
"RTN","PSO52API",149,0)
 .S ^TMP($J,LIST,DFN,IEN,"C",DA(52.01),DR)=PST(52.01,DA(52.01),DR,"I")
"RTN","PSO52API",150,0)
 Q
"RTN","PSO52API",151,0)
AT ;activity log
"RTN","PSO52API",152,0)
 I '$O(^PSRX(IEN,"A",0)) S ^TMP($J,LIST,DFN,IEN,"A",0)="-1^NO DATA FOUND" Q
"RTN","PSO52API",153,0)
 ;P744 Check for missing Activity Log Header node and fix
"RTN","PSO52API",154,0)
 ;P832 Add check to line below for missing "^" first piece.
"RTN","PSO52API",155,0)
 I '$D(^PSRX(IEN,"A",0))!($E($G(^PSRX(IEN,"A",0)))'="^") D
"RTN","PSO52API",156,0)
 . S COUNT="" S COUNT=$O(^PSRX(IEN,"A","Z"),-1)
"RTN","PSO52API",157,0)
 . S ^PSRX(IEN,"A",0)="^52.3DA^"_COUNT_"^"_COUNT
"RTN","PSO52API",158,0)
 N AT F AT=0:0 S AT=$O(^PSRX(IEN,"A",AT)) Q:'AT  S DA(52.3)=AT D ATP
"RTN","PSO52API",159,0)
 K DA,DR,PST,DIC,DIQ,AT
"RTN","PSO52API",160,0)
 Q
"RTN","PSO52API",161,0)
ATP K PST S DR(52.3)=".01;.02;.03;.04;.05" S DIC=52,DA=IEN,DR=40 D DIQ
"RTN","PSO52API",162,0)
 S ^TMP($J,LIST,DFN,IEN,"A",0)=$G(^TMP($J,LIST,DFN,IEN,"A",0))+1
"RTN","PSO52API",163,0)
 F DR=.01,.02,.03,.04,.05 D
"RTN","PSO52API",164,0)
 .I DR=.04 S ^TMP($J,LIST,DFN,IEN,"A",DA(52.3),DR)=PST(52.3,DA(52.3),DR,"E") Q
"RTN","PSO52API",165,0)
 .I PST(52.3,DA(52.3),DR,"E")'=PST(52.3,DA(52.3),DR,"I") S ^TMP($J,LIST,DFN,IEN,"A",DA(52.3),DR)=PST(52.3,DA(52.3),DR,"I")_"^"_PST(52.3,DA(52.3),DR,"E") Q
"RTN","PSO52API",166,0)
 .S ^TMP($J,LIST,DFN,IEN,"A",DA(52.3),DR)=PST(52.3,DA(52.3),DR,"I")
"RTN","PSO52API",167,0)
 I $O(^PSRX(IEN,"A",AT,2,0)) D OC
"RTN","PSO52API",168,0)
 Q
"RTN","PSO52API",169,0)
OC ;Activity Log Other Comments
"RTN","PSO52API",170,0)
 N PSOOC,PSOOCD
"RTN","PSO52API",171,0)
 F PSOOC=0:0 S PSOOC=$O(^PSRX(IEN,"A",DA(52.3),2,PSOOC)) Q:'PSOOC  D
"RTN","PSO52API",172,0)
 .S PSOOCD=$G(^PSRX(IEN,"A",DA(52.3),2,PSOOC,0)) I PSOOCD'="" S ^TMP($J,LIST,DFN,IEN,"A",DA(52.3),"OC",PSOOC,.01)=PSOOCD
"RTN","PSO52API",173,0)
 Q
"RTN","PSO52API",174,0)
LB ;label log
"RTN","PSO52API",175,0)
 I '$O(^PSRX(IEN,"L",0)) S ^TMP($J,LIST,DFN,IEN,"L",0)="-1^NO DATA FOUND" Q
"RTN","PSO52API",176,0)
 N LB F LB=0:0 S LB=$O(^PSRX(IEN,"L",LB)) Q:'LB  S DA(52.032)=LB D LBP
"RTN","PSO52API",177,0)
 K DA,DR,PST,DIC,DIQ,LB
"RTN","PSO52API",178,0)
 Q
"RTN","PSO52API",179,0)
LBP S ^TMP($J,LIST,DFN,IEN,"L",0)=$G(^TMP($J,LIST,DFN,IEN,"L",0))+1
"RTN","PSO52API",180,0)
 K PST S DR(52.032)=".01;1;2;3;4" S DIC=52,DA=IEN,DR=32 D DIQ
"RTN","PSO52API",181,0)
 F DR=.01,1,2,3,4 D
"RTN","PSO52API",182,0)
 .I DR=1 S ^TMP($J,LIST,DFN,IEN,"L",DA(52.032),DR)=PST(52.032,DA(52.032),DR,"E") Q
"RTN","PSO52API",183,0)
 .I PST(52.032,DA(52.032),DR,"E")'=PST(52.032,DA(52.032),DR,"I") S ^TMP($J,LIST,DFN,IEN,"L",DA(52.032),DR)=PST(52.032,DA(52.032),DR,"I")_"^"_PST(52.032,DA(52.032),DR,"E") Q
"RTN","PSO52API",184,0)
 .S ^TMP($J,LIST,DFN,IEN,"L",DA(52.032),DR)=PST(52.032,DA(52.032),DR,"I")
"RTN","PSO52API",185,0)
 K DA,DR,PST,DIC,DIQ
"RTN","PSO52API",186,0)
 Q
"RTN","PSO52API",187,0)
CPRS ;CPRS number
"RTN","PSO52API",188,0)
 K PST S DIC=52,DA=IEN,DR=39.3 D DIQ
"RTN","PSO52API",189,0)
 I $G(PST(52,DA,DR,"E"))']"" S ^TMP($J,LIST,DFN,DA,DR)="" Q
"RTN","PSO52API",190,0)
 I PST(52,DA,DR,"E")'=PST(52,DA,DR,"I") S ^TMP($J,LIST,DFN,IEN,DR)=PST(52,DA,DR,"I")_"^"_PST(52,DA,DR,"E") Q
"RTN","PSO52API",191,0)
 S ^TMP($J,LIST,DFN,IEN,DR)=PST(52,DA,DR,"I")
"RTN","PSO52API",192,0)
 K DA,DR,PST,DIC,DIQ
"RTN","PSO52API",193,0)
 Q
"RTN","PSO52API",194,0)
DATE ;date range
"RTN","PSO52API",195,0)
 I $G(SDATE) S DTE=SDATE-1 D  Q
"RTN","PSO52API",196,0)
 .I $G(EDATE) D  Q
"RTN","PSO52API",197,0)
 ..F  S DTE=$O(^PS(55,DFN,"P","A",DTE)) Q:'DTE!(DTE>EDATE)  F IEN=0:0 S IEN=$O(^PS(55,DFN,"P","A",DTE,IEN)) Q:'IEN  D:$P($G(^PSRX(IEN,"STA")),"^")'=13 PROCESS
"RTN","PSO52API",198,0)
 .F  S DTE=$O(^PS(55,DFN,"P","A",DTE)) Q:'DTE  F IEN=0:0 S IEN=$O(^PS(55,DFN,"P","A",DTE,IEN)) Q:'IEN  D:$P($G(^PSRX(IEN,"STA")),"^")'=13 PROCESS
"RTN","PSO52API",199,0)
 I $G(EDATE),'$G(SDATE) S DTE=DT-1 D  Q
"RTN","PSO52API",200,0)
 .F  S DTE=$O(^PS(55,DFN,"P","A",DTE)) Q:'DTE!(DTE>EDATE)  F IEN=0:0 S IEN=$O(^PS(55,DFN,"P","A",DTE,IEN)) Q:'IEN  D:$P($G(^PSRX(IEN,"STA")),"^")'=13 PROCESS
"RTN","PSO52API",201,0)
 S DTE=DT-1 F  S DTE=$O(^PS(55,DFN,"P","A",DTE)) Q:'DTE  F IEN=0:0 S IEN=$O(^PS(55,DFN,"P","A",DTE,IEN)) Q:'IEN  D:$P($G(^PSRX(IEN,"STA")),"^")'=13 PROCESS
"RTN","PSO52API",202,0)
 Q
"RTN","PSO52API",203,0)
PROF(DFN,LIST,SDATE,EDATE) ;
"RTN","PSO52API",204,0)
 D ^PSO52AP1
"RTN","PSO52API",205,0)
 Q
"RTN","PSO52API",206,0)
IND ;Indication
"RTN","PSO52API",207,0)
 S:$P($G(^PSRX(IEN,"IND")),U)]"" ^TMP($J,LIST,DFN,IEN,"IND")=$P($G(^PSRX(IEN,"IND")),U,1,2)
"RTN","PSO52API",208,0)
 Q
"RTN","PSO52API",209,0)
DIQ ;process fields
"RTN","PSO52API",210,0)
 S DIQ="PST",DIQ(0)="IE" D EN^DIQ1
"RTN","PSO52API",211,0)
 Q
"RTN","PSOVEXR1")
0^1^B43309952^B31123618
"RTN","PSOVEXR1",1,0)
PSOVEXR1 ;BIRM/KML - PHARMACY TELEPHONE REFILLS - CONTINUED; May 22, 2026@11:20
"RTN","PSOVEXR1",2,0)
 ;;7.0;OUTPATIENT PHARMACY;**653,832**;Dec 1997;Build 4
"RTN","PSOVEXR1",3,0)
 ;
"RTN","PSOVEXR1",4,0)
PSOBLD ; This will transfer entries from the vendor daily telephone refill requests global when the pharmacy audio refills option is accessed.
"RTN","PSOVEXR1",5,0)
 ;VEXHRX(19080,PSOSITE,"PSODFN-PSORXIEN")=PSORDT_"^"_PSOSTAT_"^"_PSOP3_"^"_PSOP4_"^"_PSOORF_"^"_PSORSLT_"^"_PSOUSER_"^"_PSOPRF
"RTN","PSOVEXR1",6,0)
 ;each time the option is accessed it will add new RXs to the class I ^PS(52.444 file.
"RTN","PSOVEXR1",7,0)
 ;below is a breakdown of the vendor ^VEXHRX(19080 global contents. 
"RTN","PSOVEXR1",8,0)
 ;PSOSITE= Outpatient site number of refill request i.e. 442 for cheyenne VAMC 
"RTN","PSOVEXR1",9,0)
 ;PSODFN=patient dfn from file #2
"RTN","PSOVEXR1",10,0)
 ;PSORXIEN=the ien of the prescription file. Not the prescription #. the prescription number is actually piece one of the PSRX global 
"RTN","PSOVEXR1",11,0)
 ;PSORDT=the date processed needs to also be set back into vexhrx for clean up.
"RTN","PSOVEXR1",12,0)
 ;PSOSTAT=status of "NOT FILLED"
"RTN","PSOVEXR1",13,0)
 ;PSOP3=PIECE NOT USED
"RTN","PSOVEXR1",14,0)
 ;PSOP4=PIECE NOT USED
"RTN","PSOVEXR1",15,0)
 ;PSOORF=ORDER RENEW FLAG - SET OF CODES 'N' for NoN Renewable or 'U' unsigned orders allowed and 'I' Incomplete because Unsigned orders not allowed.
"RTN","PSOVEXR1",16,0)
 ;PSORSLT=RENEW PROCESSING RESULT - ORAREN SET OF CODES '0' is processing problem., '1' for OK, '2' for user stopped, '3' not from primary care provider. '5' provider on order terminated no one to send order to.
"RTN","PSOVEXR1",17,0)
 ;PSOUSER=IEN OF NEW PERSON file (#200). User that processed the order, i.e. Auto refills could be  USER,AUDIOCARE
"RTN","PSOVEXR1",18,0)
 ;PSOPRF=PROVIDER RENEW FLAG - 'P' FOR restricts renewals to THE PATIENTS PRIMARY CARE PROVIDER; 'A' FOR ANY PROVIDER CAN RENEW;
"RTN","PSOVEXR1",19,0)
 N PSOORF,PSODFN,PSODFNRX,PSOGET,PSOPRF,PSORDT,PSORSLT,PSOUSER,PSOSITE,PSOSITID,PSOXCNT,PSOXPTRN
"RTN","PSOVEXR1",20,0)
 K FDA,PSOERR
"RTN","PSOVEXR1",21,0)
 S (PSOORF,PSOPRF,PSORSLT,PSORDT,PSOSTAT,PSOUSER)=""
"RTN","PSOVEXR1",22,0)
 K ^XTMP("PSOVEXRX",$J)
"RTN","PSOVEXR1",23,0)
 L +^XTMP("PSOVEXRX"):5 D  Q:'$T
"RTN","PSOVEXR1",24,0)
 . I '$T D  Q
"RTN","PSOVEXR1",25,0)
 . . S QUIT=1
"RTN","PSOVEXR1",26,0)
 . . ;Performing $G in case another vendor process somehow sets this lock,
"RTN","PSOVEXR1",27,0)
 . . ;even though that is extremely unlikely.
"RTN","PSOVEXR1",28,0)
 . . N PSOSTR S PSOSTR=$G(^XTMP("PSOVEXRX"))
"RTN","PSOVEXR1",29,0)
 . . I PSOSTR="" D  Q
"RTN","PSOVEXR1",30,0)
 . . . W !!,"Unknown process has the lock. Audit has not been set."
"RTN","PSOVEXR1",31,0)
 . . . W !,"Please try again later."
"RTN","PSOVEXR1",32,0)
 . . N PSOWHO S PSOWHO=$$NAME^XUSER($P(PSOSTR,"^"))
"RTN","PSOVEXR1",33,0)
 . . W !!,$S(PSOWHO'="":PSOWHO,1:$P(PSOSTR,"^"))," locked this option"
"RTN","PSOVEXR1",34,0)
 . . W !,$P($$FMTE^XLFDT($P(PSOSTR,U,2)),":",1,2)," with job number: ",$P(PSOSTR,U,3),"."
"RTN","PSOVEXR1",35,0)
 . . I PSOWHO]"" W !,"Please try again later or contact end user to exit the option." Q
"RTN","PSOVEXR1",36,0)
 . . ;Extremely unlikely that a process (not a user) is locking the option, but displaying text anyway.
"RTN","PSOVEXR1",37,0)
 . . W !,"Please try again later."
"RTN","PSOVEXR1",38,0)
 . ;Set audit of who, when, and job number when locked.
"RTN","PSOVEXR1",39,0)
 . S ^XTMP("PSOVEXRX")=DUZ_"^"_$$NOW^XLFDT_"^"_$J
"RTN","PSOVEXR1",40,0)
 ;PSO*7.0*832: Adding zero node to adhere to ^XTMP rule. Previously was not set.
"RTN","PSOVEXR1",41,0)
 S ^XTMP("PSOVEXRX",0)=$$FMADD^XLFDT(DT,5)_"^"_DT_"^PSO PROCESS TELEPHONE REFILLS option"
"RTN","PSOVEXR1",42,0)
 M ^XTMP("PSOVEXRX",$J)=^VEXHRX(19080)   ; populate XTMP with AUDIOCARE vendor array data for further processing
"RTN","PSOVEXR1",43,0)
 S PSOSITE=0 F  S PSOSITE=$O(^XTMP("PSOVEXRX",$J,PSOSITE)) Q:'PSOSITE  D
"RTN","PSOVEXR1",44,0)
 . S PSODFNRX=0 F  S PSODFNRX=$O(^XTMP("PSOVEXRX",$J,PSOSITE,PSODFNRX)) Q:'PSODFNRX  D
"RTN","PSOVEXR1",45,0)
 . . S PSODFN=$P(PSODFNRX,"-",1)
"RTN","PSOVEXR1",46,0)
 . . S PSORXIEN=$P(PSODFNRX,"-",2)
"RTN","PSOVEXR1",47,0)
 . . S PSOSITID=$P($G(^PSRX(PSORXIEN,2)),U,9)
"RTN","PSOVEXR1",48,0)
 . . I PSORXIEN Q:$D(^PS(52.444,"B",PSORXIEN))  ;This checks to see is a prescription ien is already recorded.
"RTN","PSOVEXR1",49,0)
 . . S PSOGET=$G(^XTMP("PSOVEXRX",$J,PSOSITE,PSODFNRX))
"RTN","PSOVEXR1",50,0)
 . . S:$D(PSOGET) PSORDT=$P(PSOGET,U,1),PSOSTAT=$P(PSOGET,U,2),PSOORF=$P(PSOGET,U,5),PSORSLT=$P(PSOGET,U,6),PSOUSER=$P(PSOGET,U,7),PSOPRF=$P(PSOGET,U,8) Q:$G(PSORDT)
"RTN","PSOVEXR1",51,0)
 . . ;QUIT ABOVE If a date is already in piece one of the vendor global means the order has been processed.
"RTN","PSOVEXR1",52,0)
 . . ;code below this line adds new RX information to the Class I file 52.444
"RTN","PSOVEXR1",53,0)
 . . S FDA(1,52.444,"?+1,",.01)=PSORXIEN
"RTN","PSOVEXR1",54,0)
 . . S FDA(1,52.444,"?+1,",1)=PSOSITID
"RTN","PSOVEXR1",55,0)
 . . S FDA(1,52.444,"?+1,",2)=PSODFN
"RTN","PSOVEXR1",56,0)
 . . I $D(PSOSTAT) S FDA(1,52.444,"?+1,",4)=PSOSTAT
"RTN","PSOVEXR1",57,0)
 . . I $D(PSOORF) S FDA(1,52.444,"?+1,",5)=PSOORF
"RTN","PSOVEXR1",58,0)
 . . I $D(PSORSLT) S FDA(1,52.444,"?+1,",6)=PSORSLT
"RTN","PSOVEXR1",59,0)
 . . I $G(PSOUSER) S FDA(1,52.444,"?+1,",7)=PSOUSER
"RTN","PSOVEXR1",60,0)
 . . I $D(PSOPRF) S FDA(1,52.444,"?+1,",8)=PSOPRF
"RTN","PSOVEXR1",61,0)
 . . D UPDATE^DIE("","FDA(1)",,"PSOERR")
"RTN","PSOVEXR1",62,0)
 . . W:$D(PSOERR) !,"Prescription Internal Record number "_PSORXIEN_" failed to UPDATE file 52.444"
"RTN","PSOVEXR1",63,0)
 Q
"RTN","PSOVEXR1",64,0)
 ;
"RTN","PSOVEXR1",65,0)
CLEAN ;delete completed records from the new file 52.444.
"RTN","PSOVEXR1",66,0)
 ;scheduled to run daily
"RTN","PSOVEXR1",67,0)
 N PSORDT,PSORXEN
"RTN","PSOVEXR1",68,0)
 K ^XTMP("PSOVEXRX",$J)
"RTN","PSOVEXR1",69,0)
 ;PSO*7.0*832: Add lock audit.
"RTN","PSOVEXR1",70,0)
 ;             If locked, no need to display a message since this is a background job.
"RTN","PSOVEXR1",71,0)
 L +^XTMP("PSOVEXRX"):5 D  I '$T Q
"RTN","PSOVEXR1",72,0)
 . I $T S ^XTMP("PSOVEXRX")="PSO PURGE PROCESSED 52.444 option^"_$$NOW^XLFDT_"^"_$J
"RTN","PSOVEXR1",73,0)
 ;PSO*7.0*832: Adding zero node to adhere to ^XTMP rule. Previously was not set.
"RTN","PSOVEXR1",74,0)
 S ^XTMP("PSOVEXRX",0)=$$FMADD^XLFDT(DT,5)_"^"_DT_"^PSO PURGE PROCESSED 52.444 option"
"RTN","PSOVEXR1",75,0)
 M ^XTMP("PSOVEXRX",$J)=^VEXHRX(19080)   ; populate XTMP with AUDIOCARE vendor array data for further processing
"RTN","PSOVEXR1",76,0)
 D SETVEN
"RTN","PSOVEXR1",77,0)
 S PSORDT=0 F  S PSORDT=$O(^PS(52.444,"E",PSORDT)) Q:'PSORDT  D
"RTN","PSOVEXR1",78,0)
 . S PSORXEN=0 F  S PSORXEN=$O(^PS(52.444,"E",PSORDT,PSORXEN)) Q:'PSORXEN  D
"RTN","PSOVEXR1",79,0)
 . . S DIK="^PS(52.444,",DA=PSORXEN D ^DIK K DIK,DA
"RTN","PSOVEXR1",80,0)
 K XMY N XMDUZ,XMSUB,XMTEXT,XMT
"RTN","PSOVEXR1",81,0)
 S XMDUZ="AUTO,RENEWAL",XMY(DUZ)="",XMY("G.AUTORENEWAL")="",XMSUB="Purge PHARMACY TELEPHONE REFILLS file (#52.444)."
"RTN","PSOVEXR1",82,0)
 S XMT(1,0)="Purge of processed entries in the "
"RTN","PSOVEXR1",83,0)
 S XMT(2,0)="PHARMACY TELEPHONE REFILLS file (#52.444) completed."
"RTN","PSOVEXR1",84,0)
 S XMTEXT="XMT("
"RTN","PSOVEXR1",85,0)
 D ^XMD
"RTN","PSOVEXR1",86,0)
 Q
"RTN","PSOVEXR1",87,0)
 ;
"RTN","PSOVEXR1",88,0)
SETVEN ;adds fill date, status and processing result to vendor global to facilitate completion in their process.
"RTN","PSOVEXR1",89,0)
 N PSODATA,PSODFN,PSORDT,PSORSLT,PSORGET,PSORX,PSORXEN,PSORXIEN,PSOSITE,PSOSTAT
"RTN","PSOVEXR1",90,0)
 S PSOSITE=$$GET1^DIQ(4,$P(^XMB(1,1,"XUS"),"^",17),99,"I") ;ICR 10090 and 10091 retrieve parent institution for the site
"RTN","PSOVEXR1",91,0)
 S (PSOCNT,PSORDT)=0 F  S PSORDT=$O(^PS(52.444,"E",PSORDT)) Q:'PSORDT  D
"RTN","PSOVEXR1",92,0)
 . S PSORXEN=0 F  S PSORXEN=$O(^PS(52.444,"E",PSORDT,PSORXEN)) Q:'PSORXEN  D
"RTN","PSOVEXR1",93,0)
 . . S PSORGET=$G(^PS(52.444,PSORXEN,0))
"RTN","PSOVEXR1",94,0)
 . . S PSORXIEN=$P(PSORGET,U,1)
"RTN","PSOVEXR1",95,0)
 . . S PSOSTAT=$P(PSORGET,U,5),PSORSLT=$P(PSORGET,U,7)
"RTN","PSOVEXR1",96,0)
 . . S IENS=PSORXIEN_","
"RTN","PSOVEXR1",97,0)
 . . D GETS^DIQ(52,IENS,".01;2;6","","PSORX")
"RTN","PSOVEXR1",98,0)
 . . S PSODFN=$P(PSORGET,U,3)
"RTN","PSOVEXR1",99,0)
 . . S PSODATA=""_PSODFN_""_"-"_""_PSORXIEN_""
"RTN","PSOVEXR1",100,0)
 . . Q:'$D(^XTMP("PSOVEXRX",$J,PSOSITE,PSODATA))
"RTN","PSOVEXR1",101,0)
 . . Q:$P(^XTMP("PSOVEXRX",$J,PSOSITE,PSODATA),"^")
"RTN","PSOVEXR1",102,0)
 . . I $G(PRINT) W !,"RX #: "_$P(PSORX(52,IENS,".01"),U,1)_"  RX IEN: "_IENS_" was marked processed in the ^VEXHRX Global. "
"RTN","PSOVEXR1",103,0)
 . . S $P(^XTMP("PSOVEXRX",$J,PSOSITE,PSODATA),"^")=PSORDT ;direct set required due to non fileman vendor global for Audiocare maintenance
"RTN","PSOVEXR1",104,0)
 . . I $D(PSOSTAT) S $P(^XTMP("PSOVEXRX",$J,PSOSITE,PSODATA),"^",2)=PSOSTAT ;direct set required due to non fileman vendor global Audiocare maintenance
"RTN","PSOVEXR1",105,0)
 . . I $G(PSORSLT)'="" S $P(^XTMP("PSOVEXRX",$J,PSOSITE,PSODATA),"^",6)=PSORSLT ;direct set required due to non fileman vendor global Audiocare maintenance
"RTN","PSOVEXR1",106,0)
 . . S PSOCNT=PSOCNT+1
"RTN","PSOVEXR1",107,0)
 M ^VEXHRX(19080)=^XTMP("PSOVEXRX",$J)
"RTN","PSOVEXR1",108,0)
 K ^XTMP("PSOVEXRX",$J)
"RTN","PSOVEXR1",109,0)
 L -^XTMP("PSOVEXRX")
"RTN","PSOVEXR1",110,0)
 ;Deleting lock audit and stray zero node to prevent confusion during troubleshooting.
"RTN","PSOVEXR1",111,0)
 ;Hesitant to kill just in case it would cause issues.
"RTN","PSOVEXR1",112,0)
 ;The background process XQ XUTL $J NODES will clean these up periodically.
"RTN","PSOVEXR1",113,0)
 S ^XTMP("PSOVEXRX")=""
"RTN","PSOVEXR1",114,0)
 S ^XTMP("PSOVEXRX",0)=""
"RTN","PSOVEXR1",115,0)
 Q
"RTN","PSOVEXR1",116,0)
 ;
"RTN","PSOVEXR1",117,0)
TILDECHK(PSORXIEN,PSORXEN) ;check for the tilde character (~) in the free text dosage field of the medications instructions
"RTN","PSOVEXR1",118,0)
 ; PSORXIEN = input - ien of RX in PRESCRIPTION file (#52)
"RTN","PSOVEXR1",119,0)
 ; PSORXEN  = input - ien of RX in PHARMACY TELEPHONE REFILLS file (#52.444)
"RTN","PSOVEXR1",120,0)
 ; RSLT = return as output
"RTN","PSOVEXR1",121,0)
 N TILDECHK,IENS,I,J,RSLT,CS,DRGIEN
"RTN","PSOVEXR1",122,0)
 S IENS=PSORXIEN_","
"RTN","PSOVEXR1",123,0)
 D GETS^DIQ(52,IENS,"113*","","TILDECHK")
"RTN","PSOVEXR1",124,0)
 S DRGIEN=+$P($G(^PSRX(PSORXIEN,0)),U,6)
"RTN","PSOVEXR1",125,0)
 S CS=$$CSDRUG(DRGIEN)
"RTN","PSOVEXR1",126,0)
 S RSLT=0
"RTN","PSOVEXR1",127,0)
 S I=0 F  S I=$O(TILDECHK(52.0113,I)) Q:I=""  S J=0 F  S J=$O(TILDECHK(52.0113,I,J)) Q:J=""  I TILDECHK(52.0113,I,J)["~" S RSLT=1
"RTN","PSOVEXR1",128,0)
 I RSLT D
"RTN","PSOVEXR1",129,0)
 . S IENS=PSORXEN_","
"RTN","PSOVEXR1",130,0)
 . S FDA(52.444,IENS,3)=DT D FILE^DIE(,"FDA","PSOERR") ; update the entry with the date processed
"RTN","PSOVEXR1",131,0)
 S RSLT=RSLT_"^"_CS
"RTN","PSOVEXR1",132,0)
 Q RSLT
"RTN","PSOVEXR1",133,0)
 ;
"RTN","PSOVEXR1",134,0)
CSDRUG(IEN) ;Controlled Substance drug?
"RTN","PSOVEXR1",135,0)
 ; Input: IEN - DRUG file (#50) pointer 
"RTN","PSOVEXR1",136,0)
 ;Output: $$CS - 1:YES / 0:NO
"RTN","PSOVEXR1",137,0)
 N DEA
"RTN","PSOVEXR1",138,0)
 Q:'IEN 0
"RTN","PSOVEXR1",139,0)
 S DEA=$P($G(^PSDRUG(IEN,0)),U,3)
"RTN","PSOVEXR1",140,0)
 I (DEA["2")!(DEA["3")!(DEA["4")!(DEA["5") Q 1
"RTN","PSOVEXR1",141,0)
 Q 0
"RTN","PSOVEXR1",142,0)
 ;
"VER")
8.0^22.2
"BLD",14962,6)
^685
**END**
**END**