EMERGENCY Released PSO*7*387 SEQ #316 Extracted from mail message **KIDS**:PSO*7.0*387^ **INSTALL NAME** PSO*7.0*387 "BLD",8016,0) PSO*7.0*387^OUTPATIENT PHARMACY^0^3110725^y "BLD",8016,4,0) ^9.64PA^^ "BLD",8016,6) 5^ "BLD",8016,6.3) 13 "BLD",8016,"KRN",0) ^9.67PA^779.2^20 "BLD",8016,"KRN",.4,0) .4 "BLD",8016,"KRN",.401,0) .401 "BLD",8016,"KRN",.402,0) .402 "BLD",8016,"KRN",.403,0) .403 "BLD",8016,"KRN",.5,0) .5 "BLD",8016,"KRN",.84,0) .84 "BLD",8016,"KRN",3.6,0) 3.6 "BLD",8016,"KRN",3.8,0) 3.8 "BLD",8016,"KRN",9.2,0) 9.2 "BLD",8016,"KRN",9.8,0) 9.8 "BLD",8016,"KRN",9.8,"NM",0) ^9.68A^28^24 "BLD",8016,"KRN",9.8,"NM",2,0) PSOCPPRE^^0^B9017722 "BLD",8016,"KRN",9.8,"NM",3,0) PSODDPRE^^0^B116150731 "BLD",8016,"KRN",9.8,"NM",4,0) PSODRG^^0^B64923938 "BLD",8016,"KRN",9.8,"NM",5,0) PSOORRD2^^0^B24528466 "BLD",8016,"KRN",9.8,"NM",7,0) PSODGDGP^^0^B47871096 "BLD",8016,"KRN",9.8,"NM",8,0) PSOVER^^0^B79826569 "BLD",8016,"KRN",9.8,"NM",9,0) PSOVER1^^0^B116713560 "BLD",8016,"KRN",9.8,"NM",12,0) PSOLLLI^^0^B82644773 "BLD",8016,"KRN",9.8,"NM",13,0) PSODELI^^0^B8034838 "BLD",8016,"KRN",9.8,"NM",14,0) PSOHLNEW^^0^B85696343 "BLD",8016,"KRN",9.8,"NM",15,0) PSOLBL^^0^B74655660 "BLD",8016,"KRN",9.8,"NM",16,0) PSOLBLN^^0^B61102291 "BLD",8016,"KRN",9.8,"NM",17,0) PSOLBLD^^0^B30177309 "BLD",8016,"KRN",9.8,"NM",18,0) PSOLMAO^^0^B1859588 "BLD",8016,"KRN",9.8,"NM",19,0) PSORXI^^0^B15276698 "BLD",8016,"KRN",9.8,"NM",20,0) PSODDPR4^^0^B99712200 "BLD",8016,"KRN",9.8,"NM",21,0) PSOLBL4^^0^B49656838 "BLD",8016,"KRN",9.8,"NM",22,0) PSODRDU2^^0^B22379293 "BLD",8016,"KRN",9.8,"NM",23,0) PSOORUT1^^0^B77945893 "BLD",8016,"KRN",9.8,"NM",24,0) PSON52^^0^B79042036 "BLD",8016,"KRN",9.8,"NM",25,0) PSORN52^^0^B58143232 "BLD",8016,"KRN",9.8,"NM",26,0) PSORN52C^^0^B50785719 "BLD",8016,"KRN",9.8,"NM",27,0) PSO52API^^0^B65813054 "BLD",8016,"KRN",9.8,"NM",28,0) PSOLLL8^^0^B28083638 "BLD",8016,"KRN",9.8,"NM","B","PSO52API",27) "BLD",8016,"KRN",9.8,"NM","B","PSOCPPRE",2) "BLD",8016,"KRN",9.8,"NM","B","PSODDPR4",20) "BLD",8016,"KRN",9.8,"NM","B","PSODDPRE",3) "BLD",8016,"KRN",9.8,"NM","B","PSODELI",13) "BLD",8016,"KRN",9.8,"NM","B","PSODGDGP",7) "BLD",8016,"KRN",9.8,"NM","B","PSODRDU2",22) "BLD",8016,"KRN",9.8,"NM","B","PSODRG",4) "BLD",8016,"KRN",9.8,"NM","B","PSOHLNEW",14) "BLD",8016,"KRN",9.8,"NM","B","PSOLBL",15) "BLD",8016,"KRN",9.8,"NM","B","PSOLBL4",21) "BLD",8016,"KRN",9.8,"NM","B","PSOLBLD",17) "BLD",8016,"KRN",9.8,"NM","B","PSOLBLN",16) "BLD",8016,"KRN",9.8,"NM","B","PSOLLL8",28) "BLD",8016,"KRN",9.8,"NM","B","PSOLLLI",12) "BLD",8016,"KRN",9.8,"NM","B","PSOLMAO",18) "BLD",8016,"KRN",9.8,"NM","B","PSON52",24) "BLD",8016,"KRN",9.8,"NM","B","PSOORRD2",5) "BLD",8016,"KRN",9.8,"NM","B","PSOORUT1",23) "BLD",8016,"KRN",9.8,"NM","B","PSORN52",25) "BLD",8016,"KRN",9.8,"NM","B","PSORN52C",26) "BLD",8016,"KRN",9.8,"NM","B","PSORXI",19) "BLD",8016,"KRN",9.8,"NM","B","PSOVER",8) "BLD",8016,"KRN",9.8,"NM","B","PSOVER1",9) "BLD",8016,"KRN",19,0) 19 "BLD",8016,"KRN",19.1,0) 19.1 "BLD",8016,"KRN",101,0) 101 "BLD",8016,"KRN",409.61,0) 409.61 "BLD",8016,"KRN",771,0) 771 "BLD",8016,"KRN",779.2,0) 779.2 "BLD",8016,"KRN",870,0) 870 "BLD",8016,"KRN",8989.51,0) 8989.51 "BLD",8016,"KRN",8989.52,0) 8989.52 "BLD",8016,"KRN",8994,0) 8994 "BLD",8016,"KRN","B",.4,.4) "BLD",8016,"KRN","B",.401,.401) "BLD",8016,"KRN","B",.402,.402) "BLD",8016,"KRN","B",.403,.403) "BLD",8016,"KRN","B",.5,.5) "BLD",8016,"KRN","B",.84,.84) "BLD",8016,"KRN","B",3.6,3.6) "BLD",8016,"KRN","B",3.8,3.8) "BLD",8016,"KRN","B",9.2,9.2) "BLD",8016,"KRN","B",9.8,9.8) "BLD",8016,"KRN","B",19,19) "BLD",8016,"KRN","B",19.1,19.1) "BLD",8016,"KRN","B",101,101) "BLD",8016,"KRN","B",409.61,409.61) "BLD",8016,"KRN","B",771,771) "BLD",8016,"KRN","B",779.2,779.2) "BLD",8016,"KRN","B",870,870) "BLD",8016,"KRN","B",8989.51,8989.51) "BLD",8016,"KRN","B",8989.52,8989.52) "BLD",8016,"KRN","B",8994,8994) "BLD",8016,"QUES",0) ^9.62^^ "BLD",8016,"REQB",0) ^9.611^1^1 "BLD",8016,"REQB",1,0) PSO*7.0*375^2 "BLD",8016,"REQB","B","PSO*7.0*375",1) "MBREQ") 0 "PKG",141,-1) 1^1 "PKG",141,0) OUTPATIENT PHARMACY^PSO^OUTPATIENT LABELS, PROFILE, INVENTORY, PRESCRIPTIONS "PKG",141,20,0) ^9.402P^^ "PKG",141,22,0) ^9.49I^1^1 "PKG",141,22,1,0) 7.0^2971216^2980917^11712 "PKG",141,22,1,"PAH",1,0) 387^3110725^10000000068 "PKG",141,22,1,"PAH",1,1,0) ^^37^37^3110719 "PKG",141,22,1,"PAH",1,1,1,0) This patch is a follow-up to MEDICATION ORDER CHECK HEALTHCARE "PKG",141,22,1,"PAH",1,1,2,0) APPLICATION (MOCHA) 1.0 group of patches. "PKG",141,22,1,"PAH",1,1,3,0) "PKG",141,22,1,"PAH",1,1,4,0) 1. A correction was made to address an occurrence reported in a "PKG",141,22,1,"PAH",1,1,5,0) test account where Order Checks did not occur and no message was "PKG",141,22,1,"PAH",1,1,6,0) displayed to the user. "PKG",141,22,1,"PAH",1,1,7,0) "PKG",141,22,1,"PAH",1,1,8,0) After the message "Now Processing Enhanced Order Checks! Please wait..." "PKG",141,22,1,"PAH",1,1,9,0) is displayed, the system calls a Pharmacy Data Management (PDM) "PKG",141,22,1,"PAH",1,1,10,0) Application Program Interface (API) that retrieves order check "PKG",141,22,1,"PAH",1,1,11,0) information. This API returns a value of -1 for error of some type "PKG",141,22,1,"PAH",1,1,12,0) occurred, 0 (zero) for order checks complete with no issues found, or 1 "PKG",141,22,1,"PAH",1,1,13,0) for interactions found. Outpatient Pharmacy was not checking for -1. "PKG",141,22,1,"PAH",1,1,14,0) This patch adds the check for -1, and displays a message when -1 is "PKG",141,22,1,"PAH",1,1,15,0) returned. "PKG",141,22,1,"PAH",1,1,16,0) "PKG",141,22,1,"PAH",1,1,17,0) 2. A misspelling of the word "Interoperability" was corrected in the "PKG",141,22,1,"PAH",1,1,18,0) first line of routine PSOORRD2. "PKG",141,22,1,"PAH",1,1,19,0) "PKG",141,22,1,"PAH",1,1,20,0) 3. An undefined error was corrected. Using the Rx Verification by Clerk "PKG",141,22,1,"PAH",1,1,21,0) option, a subscript error occurs after an unsuccessful request to First "PKG",141,22,1,"PAH",1,1,22,0) Data Bank (FDB) is recieved. The variable DFN is undefined and the error "PKG",141,22,1,"PAH",1,1,23,0) is displayed around the "Verify for" prompt. The error can present itself "PKG",141,22,1,"PAH",1,1,24,0) in the following ways: "PKG",141,22,1,"PAH",1,1,25,0) "PKG",141,22,1,"PAH",1,1,26,0) a. When a page feed occurs just prior to the "Verify for" prompt: "PKG",141,22,1,"PAH",1,1,27,0) VERIFY+2^PSOVER1 *DFN. "PKG",141,22,1,"PAH",1,1,28,0) "PKG",141,22,1,"PAH",1,1,29,0) b. During the order check process just before the PDM API is called: "PKG",141,22,1,"PAH",1,1,30,0) OBX+3^PSODDPRE ^TMP(547819387,"PSOPEPS","OUT",0). "PKG",141,22,1,"PAH",1,1,31,0) "PKG",141,22,1,"PAH",1,1,32,0) 4. For a technician entered order, the message "Remote data not available "PKG",141,22,1,"PAH",1,1,33,0) - Only local order checks processed" was rolling off the screen. This "PKG",141,22,1,"PAH",1,1,34,0) message is displayed in when remote data isn't available just before "PKG",141,22,1,"PAH",1,1,35,0) therapeutic duplications during the prescription order process. This has "PKG",141,22,1,"PAH",1,1,36,0) been corrected by adding an "Enter to continue" prompt after the message "PKG",141,22,1,"PAH",1,1,37,0) is displayed when the user is a technician. "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") 24 "RTN","PSO52API") 0^27^B65813054^B64959703 "RTN","PSO52API",1,0) PSO52API ;BHAM ISC/SAB- Encap II API to return Rx data ;04/07/05 10:30 am "RTN","PSO52API",2,0) ;;7.0;OUTPATIENT PHARMACY;**213,229,252,387**;DEC 1997;Build 13 "RTN","PSO52API",3,0) ; "RTN","PSO52API",4,0) ;Reference to ^PS(55 supported by DBIA 2228 "RTN","PSO52API",5,0) ; "RTN","PSO52API",6,0) RX(DFN,LIST,IEN,RX,NODE,SDATE,EDATE) ; "RTN","PSO52API",7,0) ;DFN: IEN from the PATIENT file (#2) [REQUIRED] "RTN","PSO52API",8,0) ;LIST: Subscript name used in ^TMP global [REQUIRED] "RTN","PSO52API",9,0) ;IEN: Internal prescription number [optional] "RTN","PSO52API",10,0) ;RX#: RX # field (#.01) of the PRESCRIPTION file (#52) [optional] "RTN","PSO52API",11,0) ;NODE: Determines data elements returned [optional] "RTN","PSO52API",12,0) ;SDATE: Start Date [optional] "RTN","PSO52API",13,0) ;EDATE: End Date [optional] "RTN","PSO52API",14,0) ; "RTN","PSO52API",15,0) Q:'$G(DFN) Q:$G(LIST)="" "RTN","PSO52API",16,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",17,0) I $G(IEN) D PROCESS G CLEAN "RTN","PSO52API",18,0) I $G(RX)]"",'$G(IEN) S IEN=$O(^PSRX("B",RX,0)) D G CLEAN "RTN","PSO52API",19,0) .I 'IEN S ^TMP($J,LIST,DFN,0)="-1^NO DATA FOUND" Q "RTN","PSO52API",20,0) .D PROCESS "RTN","PSO52API",21,0) D DATE "RTN","PSO52API",22,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",23,0) I ^TMP($J,LIST,DFN,0)=0 S ^TMP($J,LIST,DFN,0)="-1^NO DATA FOUND" "RTN","PSO52API",24,0) K DA,DR,DIC,ND,DAT,PST,LK,DIQ,DTE,I,X "RTN","PSO52API",25,0) Q "RTN","PSO52API",26,0) PROCESS ; "RTN","PSO52API",27,0) I DFN'=$P($G(^PSRX(IEN,0)),"^",2) S ^TMP($J,LIST,IEN,0)="-1^NO DATA FOUND (MISMATCHED PATIENT)" Q "RTN","PSO52API",28,0) I $G(^PSRX(IEN,0))']"" S ^TMP($J,LIST,IEN,0)="-1^NO RX DATA FOUND" Q "RTN","PSO52API",29,0) I $G(NODE)']"" D ZE,TW,TH,MI,ST,RF,CM,AT,LB,PT^PSO52B,SD^PSO52B,TB^PSO52B,OI^PSO52B,MLT^PSO52B S DAT="I" D IB Q "RTN","PSO52API",30,0) D ST F LK=1:1:$L(NODE,",") S DAT=$P(NODE,",",LK),ND=$P(DAT,"^") D "RTN","PSO52API",31,0) .I ND=0 D ZE Q "RTN","PSO52API",32,0) .I ND=2 D ZE,TW Q "RTN","PSO52API",33,0) .I ND=3 D TW,TH Q "RTN","PSO52API",34,0) .I ND="R" D RF Q "RTN","PSO52API",35,0) .I ND="I" D IB Q "RTN","PSO52API",36,0) .I ND="P" D PT^PSO52B Q "RTN","PSO52API",37,0) .I ND="O" D OI^PSO52B Q "RTN","PSO52API",38,0) .I ND="T" D TB^PSO52B Q "RTN","PSO52API",39,0) .I ND="L" D LB Q "RTN","PSO52API",40,0) .I ND="S" D SD^PSO52B Q "RTN","PSO52API",41,0) .I ND="M" D MI Q "RTN","PSO52API",42,0) .I ND="C" D CM Q "RTN","PSO52API",43,0) .I ND="A" D AT Q "RTN","PSO52API",44,0) .I ND="ST" D ST Q "RTN","PSO52API",45,0) .I ND="ICD" D MLT^PSO52B Q "RTN","PSO52API",46,0) .S ^TMP($J,LIST,DFN,IEN,"INVALID REQUEST",ND)="Invalid Data Requested" "RTN","PSO52API",47,0) Q "RTN","PSO52API",48,0) ZE ;zero "RTN","PSO52API",49,0) K PST S DIC=52,DA=IEN,DR=".01:9;10.3;10.6;11;16;17" D DIQ "RTN","PSO52API",50,0) F DR=.01,1,2,3,4,5,6,6.5,7,8,9,10.3,10.6,11,16,17 D "RTN","PSO52API",51,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",52,0) .S ^TMP($J,LIST,DFN,IEN,DR)=PST(52,DA,DR,"I") "RTN","PSO52API",53,0) K DA,DR,PST,DIC,DIQ "RTN","PSO52API",54,0) Q "RTN","PSO52API",55,0) TW ;two "RTN","PSO52API",56,0) Q:'$D(^PSRX(IEN,2)) "RTN","PSO52API",57,0) K PST S DIC=52,DA=IEN,DR="20:31;32.1;32.2;32.3;104" D DIQ "RTN","PSO52API",58,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",59,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",60,0) .S ^TMP($J,LIST,DFN,IEN,DR)=PST(52,DA,DR,"I") "RTN","PSO52API",61,0) K DA,DR,PST,DIC,DIQ "RTN","PSO52API",62,0) Q "RTN","PSO52API",63,0) TH ;three "RTN","PSO52API",64,0) Q:'$D(^PSRX(IEN,3)) "RTN","PSO52API",65,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",66,0) F DR=12,26.1,34.1,101,102,102.1,102.2,109,112 D "RTN","PSO52API",67,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",68,0) .S ^TMP($J,LIST,DFN,IEN,DR)=PST(52,DA,DR,"I") "RTN","PSO52API",69,0) K DA,DR,PST,DIC,DIQ "RTN","PSO52API",70,0) Q "RTN","PSO52API",71,0) MI ;sig "RTN","PSO52API",72,0) I $P($G(^PSRX(IEN,"SIG")),"^",2) D Q "RTN","PSO52API",73,0) .I '$O(^PSRX(IEN,"SIG1",0)) S ^TMP($J,LIST,DFN,IEN,"M",0)="-1^NO DATA FOUND" Q "RTN","PSO52API",74,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",75,0) I $P($G(^PSRX(IEN,"SIG")),"^")']"" S ^TMP($J,LIST,DFN,IEN,"M",0)="-1^NO DATA FOUND" Q "RTN","PSO52API",76,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",77,0) K X,INS1 "RTN","PSO52API",78,0) Q "RTN","PSO52API",79,0) ST ;status "RTN","PSO52API",80,0) I DT>$P(^PSRX(IEN,2),"^",6),$P(^PSRX(IEN,"STA"),"^")<11 D "RTN","PSO52API",81,0) .N PSOEXRX,PSOEXSTA,ORN,PIFN,PSUSD,PRFDT,PDA,PSST "RTN","PSO52API",82,0) .S PSOEXRX=IEN D EN2^PSOMAUEX K PSOEXRX,PSONM,PSONMX "RTN","PSO52API",83,0) K PST S DIC=52,DA=IEN,DR=".01;100" D DIQ "RTN","PSO52API",84,0) I PST(52,DA,100,"E")="DRUG INTERACTIONS" S PST(52,DA,100,"E")="NON-VERIFIED" "RTN","PSO52API",85,0) S ^TMP($J,LIST,DFN,IEN,100)=PST(52,DA,100,"I")_"^"_PST(52,DA,100,"E") "RTN","PSO52API",86,0) S ^TMP($J,LIST,"B",PST(52,DA,.01,"E"),IEN)="" "RTN","PSO52API",87,0) K DA,DR,PST,DIC,DIQ "RTN","PSO52API",88,0) Q "RTN","PSO52API",89,0) RF ;refill "RTN","PSO52API",90,0) I '$O(^PSRX(IEN,1,0)) S ^TMP($J,LIST,DFN,IEN,"RF",0)="-1^NO DATA FOUND" Q "RTN","PSO52API",91,0) I $P($G(DAT),"^",3) S DA(52.1)=$P(DAT,"^",3) D RFD K DA,DR,PST,DIC,DIQ Q "RTN","PSO52API",92,0) F RF=0:0 S RF=$O(^PSRX(IEN,1,RF)) Q:'RF S DA(52.1)=RF D RFD "RTN","PSO52API",93,0) K DA,DR,PST,DIC,DIQ,RF "RTN","PSO52API",94,0) Q "RTN","PSO52API",95,0) RFD K PST S DR(52.1)=".01:8;10.1;12;13;14;15;17",DIC=52,DA=IEN,DR=52 D DIQ "RTN","PSO52API",96,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",97,0) S ^TMP($J,LIST,DFN,IEN,"RF",0)=$G(^TMP($J,LIST,DFN,IEN,"RF",0))+1 "RTN","PSO52API",98,0) F DR=.01,1,1.1,1.2,2,3,4,5,6,7,8,10.1,12,13,14,15,17 D "RTN","PSO52API",99,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",100,0) .S ^TMP($J,LIST,DFN,IEN,"RF",DA(52.1),DR)=PST(52.1,DA(52.1),DR,"I") "RTN","PSO52API",101,0) Q "RTN","PSO52API",102,0) IB ;ib ori "RTN","PSO52API",103,0) I $P($G(DAT),"^",2)="R" D IBR Q "RTN","PSO52API",104,0) I $G(^PSRX(IEN,"IB"))']"" S ^TMP($J,LIST,DFN,IEN,"IB",0)="-1^NO DATA FOUND" Q "RTN","PSO52API",105,0) K PST S DIC=52,DA=IEN,DR="105;106;106.5;106.6" D DIQ "RTN","PSO52API",106,0) F DR=105,106,106.5,106.6 D "RTN","PSO52API",107,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",108,0) .S ^TMP($J,LIST,DFN,IEN,DR)=PST(52,DA,DR,"E") "RTN","PSO52API",109,0) K DA,DR,PST,DIC,DIQ "RTN","PSO52API",110,0) I $P($G(DAT),"^",2)="" D IBR Q "RTN","PSO52API",111,0) Q "RTN","PSO52API",112,0) IBR ;ib ref "RTN","PSO52API",113,0) I '$O(^PSRX(IEN,1,0)) S ^TMP($J,LIST,DFN,IEN,"IB",0)="-1^NO DATA FOUND" Q "RTN","PSO52API",114,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",115,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",116,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",117,0) K DA,DR,PST,DIC,DIQ,IB "RTN","PSO52API",118,0) Q "RTN","PSO52API",119,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",120,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",121,0) K PST S DR(52.1)="9;9.1",DIC=52,DA=IEN,DR=52 D DIQ "RTN","PSO52API",122,0) S ^TMP($J,LIST,DFN,IEN,"IB",0)=$G(^TMP($J,LIST,DFN,IEN,"IB",0))+1 "RTN","PSO52API",123,0) F DR=9,9.1 D "RTN","PSO52API",124,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",125,0) .S ^TMP($J,LIST,DFN,IEN,"IB",DA(52.1),DR)=PST(52.1,DA(52.1),DR,"I") "RTN","PSO52API",126,0) Q "RTN","PSO52API",127,0) CM ;cmop "RTN","PSO52API",128,0) I '$O(^PSRX(IEN,4,0)) S ^TMP($J,LIST,DFN,IEN,"C",0)="-1^NO DATA FOUND" Q "RTN","PSO52API",129,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",130,0) K DA,DR,PST,DIC,DIQ,CM "RTN","PSO52API",131,0) Q "RTN","PSO52API",132,0) CMP S ^TMP($J,LIST,DFN,IEN,"C",0)=$G(^TMP($J,LIST,DFN,IEN,"C",0))+1 "RTN","PSO52API",133,0) K PST S DR(52.01)="2;3;4",DIC=52,DA=IEN,DR=400 D DIQ "RTN","PSO52API",134,0) F DR=2,3,4 D "RTN","PSO52API",135,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",136,0) .S ^TMP($J,LIST,DFN,IEN,"C",DA(52.01),DR)=PST(52.01,DA(52.01),DR,"I") "RTN","PSO52API",137,0) Q "RTN","PSO52API",138,0) AT ;activity log "RTN","PSO52API",139,0) I '$O(^PSRX(IEN,"A",0)) S ^TMP($J,LIST,DFN,IEN,"A",0)="-1^NO DATA FOUND" Q "RTN","PSO52API",140,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",141,0) K DA,DR,PST,DIC,DIQ,AT "RTN","PSO52API",142,0) Q "RTN","PSO52API",143,0) ATP K PST S DR(52.3)=".01;.02;.03;.04;.05" S DIC=52,DA=IEN,DR=40 D DIQ "RTN","PSO52API",144,0) S ^TMP($J,LIST,DFN,IEN,"A",0)=$G(^TMP($J,LIST,DFN,IEN,"A",0))+1 "RTN","PSO52API",145,0) F DR=.01,.02,.03,.04,.05 D "RTN","PSO52API",146,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",147,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",148,0) .S ^TMP($J,LIST,DFN,IEN,"A",DA(52.3),DR)=PST(52.3,DA(52.3),DR,"I") "RTN","PSO52API",149,0) Q "RTN","PSO52API",150,0) LB ;label log "RTN","PSO52API",151,0) I '$O(^PSRX(IEN,"L",0)) S ^TMP($J,LIST,DFN,IEN,"L",0)="-1^NO DATA FOUND" Q "RTN","PSO52API",152,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",153,0) K DA,DR,PST,DIC,DIQ,LB "RTN","PSO52API",154,0) Q "RTN","PSO52API",155,0) LBP S ^TMP($J,LIST,DFN,IEN,"L",0)=$G(^TMP($J,LIST,DFN,IEN,"L",0))+1 "RTN","PSO52API",156,0) K PST S DR(52.032)=".01;1;2;3;4" S DIC=52,DA=IEN,DR=32 D DIQ "RTN","PSO52API",157,0) F DR=.01,1,2,3,4 D "RTN","PSO52API",158,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",159,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",160,0) .S ^TMP($J,LIST,DFN,IEN,"L",DA(52.032),DR)=PST(52.032,DA(52.032),DR,"I") "RTN","PSO52API",161,0) K DA,DR,PST,DIC,DIQ "RTN","PSO52API",162,0) Q "RTN","PSO52API",163,0) DATE ;date range "RTN","PSO52API",164,0) I $G(SDATE) S DTE=SDATE-1 D Q "RTN","PSO52API",165,0) .I $G(EDATE) D Q "RTN","PSO52API",166,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",167,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",168,0) I $G(EDATE),'$G(SDATE) S DTE=DT-1 D Q "RTN","PSO52API",169,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",170,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",171,0) Q "RTN","PSO52API",172,0) PROF(DFN,LIST,SDATE,EDATE) ; "RTN","PSO52API",173,0) D ^PSO52AP1 "RTN","PSO52API",174,0) Q "RTN","PSO52API",175,0) DIQ ;process fields "RTN","PSO52API",176,0) S DIQ="PST",DIQ(0)="IE" D EN^DIQ1 "RTN","PSO52API",177,0) Q "RTN","PSOCPPRE") 0^2^B9017722^B8382340 "RTN","PSOCPPRE",1,0) PSOCPPRE ;BIR/SAB - enhanced dup drug checker for copy orders ;09/21/06 11:34am "RTN","PSOCPPRE",2,0) ;;7.0;OUTPATIENT PHARMACY;**251,375,387**;DEC 1997;Build 13 "RTN","PSOCPPRE",3,0) ;External references PSOL and PSOUL^PSSLOCK supported by DBIA 2789 "RTN","PSOCPPRE",4,0) ;External references to ^ORRDI1 controlled subscription supported by DBIA 4659 "RTN","PSOCPPRE",5,0) ;External references to ^XTMP("ORRDI" supported by DBIA 4660 "RTN","PSOCPPRE",6,0) ;External references to ^PSSHRQ2 supported by DBIA 5369 "RTN","PSOCPPRE",7,0) S LIST="PSOPEP",$P(PSONULN,"-",79)="-",(STA,DNM)="" N PSODLQT "RTN","PSOCPPRE",8,0) F S STA=$O(PSOSD(STA)) Q:STA="" F S DNM=$O(PSOSD(STA,DNM)) Q:DNM="" D Q:$G(PSORX("DFLG")) "RTN","PSOCPPRE",9,0) .I STA="PENDING" D ^PSODDPR1 Q "RTN","PSOCPPRE",10,0) .I STA="ZNONVA" D NVA^PSODDPR1 Q "RTN","PSOCPPRE",11,0) .D:PSODRUG("NAME")=$P(DNM,"^")&('$D(^XUSEC("PSORPH",DUZ))) Q:$G(PSORX("DFLG")) "RTN","PSOCPPRE",12,0) ..I $P($G(PSOPAR),"^",16) D DUP^PSODDPRE Q:$G(PSORX("DFLG")) "RTN","PSOCPPRE",13,0) ..I $P(PSOPAR,"^",2),'$P($G(PSOPAR),"^",16) D DUP^PSODDPRE Q:$G(PSORX("DFLG")) "RTN","PSOCPPRE",14,0) ..I '$P(PSOPAR,"^",2),'$P($G(PSOPAR),"^",16) D DUP^PSODDPRE Q:$G(PSORX("DFLG")) "RTN","PSOCPPRE",15,0) .D:PSODRUG("NAME")=$P(DNM,"^")&($D(^XUSEC("PSORPH",DUZ))) DUP^PSODDPRE "RTN","PSOCPPRE",16,0) Q:$G(PSORX("DFLG")) "RTN","PSOCPPRE",17,0) D HD^PSODDPR2():(($Y+5)'>IOSL) "RTN","PSOCPPRE",18,0) D REMOTE "RTN","PSOCPPRE",19,0) Q "RTN","PSOCPPRE",20,0) OBX S LIST="PSOPEPS" "RTN","PSOCPPRE",21,0) K ^TMP($J,"DD"),^TMP($J,"DC"),^TMP($J,"DI"),PSODLQT,DTOUT,DUOUT,DIRUT,PSODOSD "RTN","PSOCPPRE",22,0) K HZVA,ZVA,ZORS,ZZDGDG,ON,DRG,SV,DGI,PSORX("INTERVENE"),DIR,ZTHER,IT "RTN","PSOCPPRE",23,0) K DIR I $P(^TMP($J,LIST,"OUT",0),"^")=-1 G EXIT "RTN","PSOCPPRE",24,0) K ^TMP($J,LIST,"IN","PING"),^TMP($J,LIST,"OUT","DRUGDRUG"),^TMP($J,LIST,"OUT","THERAPY") "RTN","PSOCPPRE",25,0) W !,"Now Processing Enhanced Order Checks! Please wait...",! H 2 "RTN","PSOCPPRE",26,0) D FDB^PSODDPRE S PDRG=PSODRUG("IEN"),DO=0 D REMOTE^PSODDPR4 "RTN","PSOCPPRE",27,0) D IN^PSSHRQ2(LIST) ;if patient has meds "RTN","PSOCPPRE",28,0) ; "RTN","PSOCPPRE",29,0) K DIR "RTN","PSOCPPRE",30,0) I $P(^TMP($J,LIST,"OUT",0),"^")=-1 D DATACK^PSODDPRE G EXIT "RTN","PSOCPPRE",31,0) D ^PSODDPR2 ;if order checks returned "RTN","PSOCPPRE",32,0) ; "RTN","PSOCPPRE",33,0) EXIT ; "RTN","PSOCPPRE",34,0) I $G(PSODLQT)!$G(PSORX("DFLG")) S PSODOSD=1 "RTN","PSOCPPRE",35,0) D ^PSOBUILD K CAN,DA,DIR,DNM,DUPRX0,ISSD,J,LSTFL,MSG,PHYS,PSOCLC,PSONULN,REA,RFLS,RX0,RX2,RXREC,ST,Y,ZZ,ACT,PSOCLOZ,PSOLR,PSOLDT,PSOCD,SIG "RTN","PSOCPPRE",36,0) K ^TMP($J,LIST,"IN","PING"),^TMP($J,LIST,"OUT","DRUGDRUG"),^TMP($J,LIST,"OUT","THERAPY"),^TMP($J,"PSOPEPS"),^TMP($J,"PSORDI") "RTN","PSOCPPRE",37,0) K DO,LIST,DNM,PSONULN,PSORX("DFLG"),RXRECCOP,STA,Y,PSODLQT "RTN","PSOCPPRE",38,0) K HZVA,ZVA,ZORS,ZZDGDG,ON,DRG,SV,DGI,PSORX("INTERVENE"),DIR,ZTHER,IT "RTN","PSOCPPRE",39,0) S VALMBCK="R" "RTN","PSOCPPRE",40,0) Q "RTN","PSOCPPRE",41,0) ULRX ; "RTN","PSOCPPRE",42,0) I '$G(RXRECCOP) Q "RTN","PSOCPPRE",43,0) D PSOUL^PSSLOCK(RXRECCOP) "RTN","PSOCPPRE",44,0) Q "RTN","PSOCPPRE",45,0) ; "RTN","PSOCPPRE",46,0) REMOTE ; "RTN","PSOCPPRE",47,0) I $T(HAVEHDR^ORRDI1)']"" Q "RTN","PSOCPPRE",48,0) I '$$HAVEHDR^ORRDI1 Q "RTN","PSOCPPRE",49,0) I $D(^XTMP("ORRDI","OUTAGE INFO","DOWN")) G REMOTE2 "RTN","PSOCPPRE",50,0) D HD^PSODDPR2():(($Y+5)'>IOSL) "RTN","PSOCPPRE",51,0) W !!,"Now doing remote order checks. Please wait...",! "RTN","PSOCPPRE",52,0) D REMOTE^PSOORRDI(PSODFN,PSODRUG("IEN")) "RTN","PSOCPPRE",53,0) D HD^PSODDPR2():(($Y+5)'>IOSL) "RTN","PSOCPPRE",54,0) I '$D(^XUSEC("PSORPH",DUZ)),$P(PSOPAR,"^",2),$G(PSOTECCK) G REMOTE2 "RTN","PSOCPPRE",55,0) I $D(^TMP($J,"DD")) D DUP^PSOORRD2 "RTN","PSOCPPRE",56,0) REMOTE2 ; "RTN","PSOCPPRE",57,0) K ^TMP($J,"DD"),^TMP($J,"DC"),^TMP($J,"DI") "RTN","PSOCPPRE",58,0) Q "RTN","PSODDPR4") 0^20^B99712200^B96800031 "RTN","PSODDPR4",1,0) PSODDPR4 ;BHAM - ISC/EJW,SAB - build local OP & RDI profiles ;07/19/07 "RTN","PSODDPR4",2,0) ;;7.0;OUTPATIENT PHARMACY;**251,375,387**;DEC 1997;Build 13 "RTN","PSODDPR4",3,0) ;External references to ^ORRDI1 supported by DBIA 4659 "RTN","PSODDPR4",4,0) ;External references to ^XTMP("ORRDI" supported by DBIA 4660 "RTN","PSODDPR4",5,0) ;External reference to ^PSDRUG supported by DBIA 221 "RTN","PSODDPR4",6,0) ;External reference to IN^PSJBLDOC supported by DBIA 5306 "RTN","PSODDPR4",7,0) ;External references to ^PSSDSAPM supported by DBIA 5570 "RTN","PSODDPR4",8,0) ;External reference to ^PS(55 supported by DBIA 2228 "RTN","PSODDPR4",9,0) ;External reference to ENCHK^PSJORUT2 supported by DBIA 2376 "RTN","PSODDPR4",10,0) ;External reference to IN^PSSHRQ2 supported by DBIA 5369 "RTN","PSODDPR4",11,0) ; "RTN","PSODDPR4",12,0) BLD(PSODFN,LIST,PDRG,PTY) ; "RTN","PSODDPR4",13,0) ;build OP, RDI, INP MEDS profiles "RTN","PSODDPR4",14,0) ;PTY - P1;P2 where P1="I" for IP & "O" for OP (required), P2=Pharm order# (optional) "RTN","PSODDPR4",15,0) I '$D(PSODFN) W !,"Patient UNDEFINED!",! Q "RTN","PSODDPR4",16,0) I '$D(LIST) W !,"Input Base UNDEFINED!",! Q "RTN","PSODDPR4",17,0) K ^TMP($J,LIST) "RTN","PSODDPR4",18,0) ORD N PSODTCUT,X1,X2,ODRG,ORTYP,ORN,DO,IEN,NAME,PROF,PSOON S (PROF,CNT)=0 "RTN","PSODDPR4",19,0) F ZI=0:0 S ZI=$O(PDRG(ZI)) Q:'ZI S IEN=$P(PDRG(ZI),"^"),NAME=$P(PDRG(ZI),"^",2) D DRG "RTN","PSODDPR4",20,0) Q:$O(^TMP($J,LIST,"IN","PROSPECTIVE",""))="" ;no prospective drugs to pass in "RTN","PSODDPR4",21,0) S X1=DT,X2=-120 D C^%DTC S PSODTCUT=X D ^PSOBUILD,PROFILE "RTN","PSODDPR4",22,0) K PSOSD D REMOTE D:$P($G(PTY),";")="I" IN^PSJBLDOC(PSODFN,LIST,.PDRG,$G(PTY)) "RTN","PSODDPR4",23,0) S ^TMP($J,LIST,"IN","IEN")=PSODFN,^TMP($J,LIST,"IN","DRUGDRUG")="",^TMP($J,LIST,"IN","THERAPY")="" "RTN","PSODDPR4",24,0) S ^TMP($J,LIST,"IN","SOURCE")=$P($G(PTY),";") "RTN","PSODDPR4",25,0) N PSOICT,PSODRUG,PSOY,CNT,ZI "RTN","PSODDPR4",26,0) D IN^PSSHRQ2(LIST) "RTN","PSODDPR4",27,0) D NSRT "RTN","PSODDPR4",28,0) Q "RTN","PSODDPR4",29,0) PROFILE ;build profile drug input "RTN","PSODDPR4",30,0) N ID,ORTYP,DD,PSOI,ORN,RECTYP S (STA,DNM)="",DO=0 "RTN","PSODDPR4",31,0) F S STA=$O(PSOSD(STA)) Q:STA="" F S DNM=$O(PSOSD(STA,DNM)) Q:DNM="" D "RTN","PSODDPR4",32,0) .I STA="PENDING" D Q "RTN","PSODDPR4",33,0) ..Q:$P(^PS(52.41,$P(PSOSD(STA,DNM),"^",10),0),"^",3)="RF" "RTN","PSODDPR4",34,0) ..S RXREC=$P(PSOSD(STA,DNM),"^",10),ORN=$P(^PS(52.41,RXREC,0),"^"),ODRG=$P(^(0),"^",9),ORTYP="P" "RTN","PSODDPR4",35,0) ..I ODRG D K ODRG Q "RTN","PSODDPR4",36,0) ...I $P($G(^PSDRUG(ODRG,0)),"^",3)["S"!($E($P($G(^PSDRUG(ODRG,0)),"^",2),1,2)="XA") Q "RTN","PSODDPR4",37,0) ...S DRNM=$P(^PSDRUG(ODRG,0),"^"),DO=DO+1 D ID "RTN","PSODDPR4",38,0) ..E N PSOI,DDRG,ODRG,SEQN,DDRG S PSOI=$P(^PS(52.41,RXREC,0),"^",8) D "RTN","PSODDPR4",39,0) ...S DRNM=$P(^PS(50.7,PSOI,0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^") "RTN","PSODDPR4",40,0) ...S DDRG=$$DRG^PSSDSAPM(PSOI,"O") I '$P(DDRG,";") D OIX Q "RTN","PSODDPR4",41,0) ...I $P($G(^PSDRUG($P(DDRG,";"),0)),"^",3)["S"!($E($P($G(^PSDRUG($P(DDRG,";"),0)),"^",2),1,2)="XA") Q "RTN","PSODDPR4",42,0) ...S ODRG=$P(DDRG,";"),SEQN=+$P(DDRG,";",3) K PSOI "RTN","PSODDPR4",43,0) ...N ID S ID=+$$GETVUID^XTID(50.68,,+$P($G(^PSDRUG(ODRG,"ND")),"^",3)_",") "RTN","PSODDPR4",44,0) ...D ID1 "RTN","PSODDPR4",45,0) .I STA="ZNONVA" D Q "RTN","PSODDPR4",46,0) ..S RXREC=$P(PSOSD(STA,DNM),"^",10),ODRG=$P(^PS(55,PSODFN,"NVA",RXREC,0),"^",2),ORN=$P($G(^(0)),"^",8),ORTYP="N" "RTN","PSODDPR4",47,0) ..I ODRG D K ODRG Q "RTN","PSODDPR4",48,0) ...I $P($G(^PSDRUG(ODRG,0)),"^",3)["S"!($E($P($G(^PSDRUG(ODRG,0)),"^",2),1,2)="XA") Q "RTN","PSODDPR4",49,0) ...S DRNM=$P(^PSDRUG(ODRG,0),"^"),DO=DO+1 D ID "RTN","PSODDPR4",50,0) ..E N PSOI,DDRG,ODRG,SEQN,DDRG,DRNM S PSOI=$P(^PS(55,PSODFN,"NVA",RXREC,0),"^") D "RTN","PSODDPR4",51,0) ...S DRNM=$P(^PS(50.7,PSOI,0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^") "RTN","PSODDPR4",52,0) ...S DDRG=$$DRG^PSSDSAPM(PSOI,"O") I '$P(DDRG,";") D OIX Q "RTN","PSODDPR4",53,0) ...I $P($G(^PSDRUG($P(DDRG,";"),0)),"^",3)["S"!($E($P($G(^PSDRUG($P(DDRG,";"),0)),"^",2),1,2)="XA") Q "RTN","PSODDPR4",54,0) ...S ODRG=$P(DDRG,";"),SEQN=+$P(DDRG,";",3),DO=DO+1 K PSOI "RTN","PSODDPR4",55,0) ...N ID S ID=+$$GETVUID^XTID(50.68,,+$P($G(^PSDRUG(ODRG,"ND")),"^",3)_",") "RTN","PSODDPR4",56,0) ...D ID1 "RTN","PSODDPR4",57,0) .S RXREC=+PSOSD(STA,DNM) "RTN","PSODDPR4",58,0) .I $P($G(PTY),";")="O",$P($G(PTY),";",2)=RXREC Q "RTN","PSODDPR4",59,0) .I $P($G(^PSRX(RXREC,0)),"^",6) S ODRG=$P(^PSRX(RXREC,0),"^",6) D "RTN","PSODDPR4",60,0) ..I $P($G(^PSDRUG(ODRG,0)),"^",3)["S"!($E($P($G(^PSDRUG(ODRG,0)),"^",2),1,2)="XA") Q "RTN","PSODDPR4",61,0) ..S ORN=$P($G(^PSRX(RXREC,"OR1")),"^",2),ORTYP="O",DRNM=$P(^PSDRUG(ODRG,0),"^"),DO=DO+1 D ID "RTN","PSODDPR4",62,0) K RXREC,ID,STA,DNM,SEQN,PSOI,PSODD,P1,P3,OR1,P2,PSODRUG,DD,DRNM,DDRG "RTN","PSODDPR4",63,0) Q "RTN","PSODDPR4",64,0) ID N ID S ID=+$$GETVUID^XTID(50.68,,+$P($G(^PSDRUG(ODRG,"ND")),"^",3)_",") "RTN","PSODDPR4",65,0) S P1=$P($G(^PSDRUG(ODRG,"ND")),"^"),P2=$P($G(^("ND")),"^",3),X=$$PROD0^PSNAPIS(P1,P2),SEQN=+$P(X,"^",7) "RTN","PSODDPR4",66,0) ID1 S ^TMP($J,LIST,"IN","PROFILE",ORTYP_";"_RXREC_";PROFILE;"_DO)=SEQN_"^"_ID_"^"_ODRG_"^"_DRNM_"^"_ORN_"^O" K ID "RTN","PSODDPR4",67,0) Q "RTN","PSODDPR4",68,0) OIX S ^TMP($J,LIST,"IN","EXCEPTIONS","OI",DRNM)=1_"^"_ORTYP_";"_RXREC_";PROFILE;"_DO "RTN","PSODDPR4",69,0) K TU "RTN","PSODDPR4",70,0) Q "RTN","PSODDPR4",71,0) REMOTE ; "RTN","PSODDPR4",72,0) I $T(HAVEHDR^ORRDI1)']"" Q "RTN","PSODDPR4",73,0) I '$$HAVEHDR^ORRDI1 Q "RTN","PSODDPR4",74,0) I $D(^XTMP("ORRDI","OUTAGE INFO","DOWN")) D Q "RTN","PSODDPR4",75,0) .I $T(REMOTE^PSORX1)]"" Q "RTN","PSODDPR4",76,0) .D HD^PSODDPR2():(($Y+5)'>IOSL) "RTN","PSODDPR4",77,0) .W !!,"Remote data not available - Only local order checks processed.",! D HD^PSODDPR2():(($Y+5)'>IOSL) "RTN","PSODDPR4",78,0) I $P($G(^XTMP("ORRDI","PSOO",PSODFN,0)),"^",3)<0 W !!,"Remote data not available - Only local order checks processed." D HD^PSODDPR2():(($Y+5)'>IOSL) Q "RTN","PSODDPR4",79,0) N PSORDI,RDIINST,RDIVUID,RDIRX,RDIDNAM,RDISTA,RDISIG,RDIDAYS,RDIQTY,RDIFILL,RDIEXP,RDIISS,RDIFILL,ZI "RTN","PSODDPR4",80,0) N RDIREF,RDIPHYS,PSOPROD,PSOCLASS,DRNM,RDITMP,PSODC,IT,PSOICT,NDF,RDIDI,PSOPRODA,PSOFILE,PSOSIG,PSOSEQN,X "RTN","PSODDPR4",81,0) I '$G(DT) S DT=$$DT^XLFDT "RTN","PSODDPR4",82,0) S PSORDI=0 "RTN","PSODDPR4",83,0) I $T(GET^ORRDI1)]"" S PSORDI=$$GET^ORRDI1(PSODFN,"PSOO") "RTN","PSODDPR4",84,0) I PSORDI<1 Q "RTN","PSODDPR4",85,0) I '$D(^XTMP("ORRDI","PSOO",PSODFN)) Q "RTN","PSODDPR4",86,0) K ^TMP($J,LIST,"OUT","REMOTE") "RTN","PSODDPR4",87,0) D PARSE,FILTER "RTN","PSODDPR4",88,0) I '$D(^TMP($J,LIST,"OUT","REMOTE")) Q "RTN","PSODDPR4",89,0) N DIC D REMO "RTN","PSODDPR4",90,0) Q "RTN","PSODDPR4",91,0) REMO ; "RTN","PSODDPR4",92,0) S (PSOON,PSORDI)=0 F S PSORDI=$O(^TMP($J,LIST,"OUT","REMOTE",PSORDI)) Q:'PSORDI S RDITMP=^(PSORDI) D K PSOSEQN "RTN","PSODDPR4",93,0) .Q:$P(RDITMP,"^",2)="" "RTN","PSODDPR4",94,0) .;screen out dc'd remotes "RTN","PSODDPR4",95,0) .I $P($G(^TMP($J,LIST,"OUT","REMOTE",PSORDI)),"^",4)["DISC" D I $G(PSOON) K PSOON Q "RTN","PSODDPR4",96,0) ..K X,Y,X1,X2 "RTN","PSODDPR4",97,0) ..S X=$P(^TMP($J,LIST,"OUT","REMOTE",PSORDI),"^",6) D ^%DT S X1=Y,X2=(+$P(^TMP($J,LIST,"OUT","REMOTE",PSORDI),"^",7)+7) "RTN","PSODDPR4",98,0) ..D C^%DTC I X
($E(DT,2,3)+1) S PSOPRE=PSOPRE-1 "RTN","PSODDPR4",128,0) ..S NEWISS=PSOPRE_$P(RDIISS,"/",3)_$P(RDIISS,"/")_$P(RDIISS,"/",2) I NEWISS>(DT-10000) S RDIEXP=RDIISS,BADEXP=0 "RTN","PSODDPR4",129,0) .I RDISTA["EXPIRE" S PSO30=0 D I PSO30 Q "RTN","PSODDPR4",130,0) ..S PSOPRE=$E(DT) I $P(RDIEXP,"/",3)>($E(DT,2,3)+1) S PSO30=1 Q "RTN","PSODDPR4",131,0) ..S NEWEXP=PSOPRE_$P(RDIEXP,"/",3)_$P(RDIEXP,"/")_$P(RDIEXP,"/",2) "RTN","PSODDPR4",132,0) ..S X1=NEWEXP,X2=30 D C^%DTC I X
($E(DT,2,3)+1) S PSO30=1 Q "RTN","PSODDPR4",137,0) ..S NEWDC=PSOPRE_$P(RDIFILL,"/",3)_$P(RDIFILL,"/")_$P(RDIFILL,"/",2) "RTN","PSODDPR4",138,0) ..S X1=NEWDC,X2=30+RDIDAYS D C^%DTC I X
RDIEXP2 K ^TMP($J,"OUT","REMOTE",PSORDI) Q "RTN","PSODDPR4",174,0) .S PSOPRE=$E(DT) I $P(RDIEXP,"/",3)>($E(DT,2,3)+1) S PSOPRE=PSOPRE-1 "RTN","PSODDPR4",175,0) .S RDIEXP2=PSOPRE_$P(RDIEXP,"/",3)_$P(RDIEXP,"/")_$P(RDIEXP,"/",2) "RTN","PSODDPR4",176,0) .S PSOPRE=$E(DT) I $P(OLDEXP,"/",3)>($E(DT,2,3)+1) S PSOPRE=PSOPRE-1 "RTN","PSODDPR4",177,0) .S OLDEXP2=PSOPRE_$P(OLDEXP,"/",3)_$P(OLDEXP,"/")_$P(OLDEXP,"/",2) "RTN","PSODDPR4",178,0) S OLDRDI=$P(ZZ,"^") K ^TMP($J,LIST,"OUT","REMOTE",OLDRDI) D SETRDI "RTN","PSODDPR4",179,0) Q "RTN","PSODDPR4",180,0) ; "RTN","PSODDPR4",181,0) SETRDI ; "RTN","PSODDPR4",182,0) S RDI(RDIINST,RDIVUID)=PSORDI_"^"_RDISTA_"^"_RDIEXP "RTN","PSODDPR4",183,0) Q "RTN","PSODDPR4",184,0) CPRS(PSODFN,LIST,PDRG,PTY) ; "RTN","PSODDPR4",185,0) ;PDRG - Drug array in format of PDRG(n)=IEN (#50) ^ Drug name "RTN","PSODDPR4",186,0) ;PTY - P1;P2 where P1="I" for IP & "O" for OP (required), P2=Pharm order# (optional) "RTN","PSODDPR4",187,0) I '$G(PSODFN) W !,"Patient UNDEFINED!",! Q "RTN","PSODDPR4",188,0) I '$O(PDRG(0)) W !,"Dispense Drug(s) UNDEFINED!",! Q "RTN","PSODDPR4",189,0) I '$D(LIST) W !,"Input Base UNDEFINED!",! Q "RTN","PSODDPR4",190,0) K ^TMP($J,"ORDERS"),^TMP($J,"DD"),^TMP($J,LIST) S (INDX,INDD)=0 "RTN","PSODDPR4",191,0) ;build patient's drug profile outpat/inpat/non-va "RTN","PSODDPR4",192,0) D BLD^PSOORDRG,ENCHK^PSJORUT2(PSODFN,.INDX),NVA^PSOORDRG "RTN","PSODDPR4",193,0) ;dup drug check CPRS ONLY "RTN","PSODDPR4",194,0) S PSOICT="",CNT=0 F ZII=0:0 S ZII=$O(PDRG(ZII)) Q:'ZII D "RTN","PSODDPR4",195,0) .S PSOY=$P(PDRG(ZII),"^")_"^"_$P($G(^PSDRUG($P(PDRG(ZII),"^"),0)),"^"),PSOY(0)=$G(^PSDRUG(PDRG(ZII),0)) "RTN","PSODDPR4",196,0) .S IEN=+PSOY,NAME=$P(PSOY,"^",2),DNM=0 K PSOX1,PSOY "RTN","PSODDPR4",197,0) .F S DNM=$O(^TMP($J,"ORDERS",DNM)) Q:'DNM I NAME=$P(^TMP($J,"ORDERS",DNM),"^",3) D "RTN","PSODDPR4",198,0) ..S INDD=$G(INDD)+1,^TMP($J,"DD",INDD,0)=IEN_"^"_NAME_"^"_$P(^TMP($J,"ORDERS",DNM),"^",4)_"^"_$P(^(DNM),"^",5) "RTN","PSODDPR4",199,0) K ^TMP($J,"ORDERS") "RTN","PSODDPR4",200,0) D ORD "RTN","PSODDPR4",201,0) Q "RTN","PSODDPR4",202,0) DRG ; "RTN","PSODDPR4",203,0) I $P($G(^PSDRUG(IEN,0)),"^",3)["S"!($E($P($G(^PSDRUG(IEN,0)),"^",2),1,2)="XA") Q "RTN","PSODDPR4",204,0) N ID,SEQN S PSODRUG("NDF")=$S($G(^PSDRUG(IEN,"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:0) "RTN","PSODDPR4",205,0) S ID=$$GETVUID^XTID(50.68,,+$P($G(PSODRUG("NDF")),"A",2)_",") "RTN","PSODDPR4",206,0) S P1=$P($G(^PSDRUG(IEN,"ND")),"^"),P2=$P($G(^("ND")),"^",3),X=$$PROD0^PSNAPIS(P1,P2),SEQN=$P(X,"^",7) "RTN","PSODDPR4",207,0) S CNT=$G(CNT)+1,^TMP($J,LIST,"IN","PROSPECTIVE",$P(PTY,";")_";"_$P(PTY,";",2)_";PROSPECTIVE;"_CNT)=SEQN_"^"_+ID_"^"_IEN_"^"_NAME "RTN","PSODDPR4",208,0) K ID,SEQN,P1,P2,X,DNM "RTN","PSODDPR4",209,0) Q "RTN","PSODDPR4",210,0) NSRT ;screen out dc'd & expired rxs pso*7*387 "RTN","PSODDPR4",211,0) N ON,DRG,SV,CT S (ON,DRG,SV)="",CT=0 "RTN","PSODDPR4",212,0) F S SV=$O(^TMP($J,LIST,"OUT","DRUGDRUG",SV)) Q:SV="" F S DRG=$O(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG)) Q:DRG="" D "RTN","PSODDPR4",213,0) .F S ON=$O(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG,ON)) Q:ON="" F S CT=$O(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT)) Q:'CT D "RTN","PSODDPR4",214,0) ..Q:$P(ON,";",2)=0 "RTN","PSODDPR4",215,0) ..I $P(ON,";")="O",$P(^PSRX($P(ON,";",2),"STA"),"^")>5,$P(^PSRX($P(ON,";",2),"STA"),"^")'=16 K ^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT) "RTN","PSODDPR4",216,0) Q "RTN","PSODDPRE") 0^3^B116150731^B107494371 "RTN","PSODDPRE",1,0) PSODDPRE ;BIR/SAB - Enhanced OP order checks ;09/20/06 3:38pm "RTN","PSODDPRE",2,0) ;;7.0;OUTPATIENT PHARMACY;**251,375,387**;DEC 1997;Build 13 "RTN","PSODDPRE",3,0) ;External references PSOL and PSOUL^PSSLOCK supported by DBIA 2789 "RTN","PSODDPRE",4,0) ;External references to ^PSSDSAPM supported by DBIA 5570 "RTN","PSODDPRE",5,0) ;External references to ^PSSHRQ2 supported by DBIA 5369 "RTN","PSODDPRE",6,0) ;External reference to ^PS(50.7 supported by DBIA 2223 "RTN","PSODDPRE",7,0) ;External reference to ^PS(55 supported by DBIA 2228 "RTN","PSODDPRE",8,0) ;External reference to ^PSDRUG( supported by DBIA 221 "RTN","PSODDPRE",9,0) ; "RTN","PSODDPRE",10,0) K IT,^TMP("PSORXDC",$J),^TMP("PSORXDD",$J),CLS,^TMP($J,"PSONVADD"),^TMP($J,"PSONRVADD"),^TMP($J,"PSORDI"),^TMP($J,"PSORMDD") "RTN","PSODDPRE",11,0) N PSONULN,PSODLQT,ZZPSODRG S LIST="PSOPEPS",$P(PSONULN,"-",79)="-",(STA,DNM)="" "RTN","PSODDPRE",12,0) D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT) "RTN","PSODDPRE",13,0) F S STA=$O(PSOSD(STA)) Q:STA="" F S DNM=$O(PSOSD(STA,DNM)) Q:DNM=""!$G(PSORX("DFLG")) I $P(PSOSD(STA,DNM),"^")'=$G(PSORENW("OIRXN")) D Q:$G(PSORX("DFLG")) "RTN","PSODDPRE",14,0) .I STA="PENDING" D ^PSODDPR1 Q "RTN","PSODDPRE",15,0) .I STA="ZNONVA" D NVA^PSODDPR1 Q "RTN","PSODDPRE",16,0) .D:PSODRUG("NAME")=$P(DNM,"^")&('$D(^XUSEC("PSORPH",DUZ))) Q:$G(PSORX("DFLG")) "RTN","PSODDPRE",17,0) ..I '$P(PSOPAR,"^",2),'$P(PSOPAR,"^",16) D DUP I $G(PSOTECCK) S PSORX("DFLG")=1 Q "RTN","PSODDPRE",18,0) ..I '$P(PSOPAR,"^",2),$P(PSOPAR,"^",16),$G(PSOTECCK) D DUP Q "RTN","PSODDPRE",19,0) ..I $P(PSOPAR,"^",2),$G(PSOTECCK) D Q "RTN","PSODDPRE",20,0) ...S DA=+PSOSD(STA,DNM),PSOCLC=DUZ "RTN","PSODDPRE",21,0) ...S MSG="Discontinued During Reinstating Prescription Entry",ACT="Discontinued during Rx Reinstate." "RTN","PSODDPRE",22,0) ...S ^TMP("PSORXDC",$J,DA,0)="52^"_DA_"^"_MSG_"^C^"_ACT_"^"_STA_"^"_DNM,PSONOOR="D",^TMP("PSORXDD",$J)=DNM "RTN","PSODDPRE",23,0) ..I $P($G(PSOPAR),"^",16) D DUP Q "RTN","PSODDPRE",24,0) ..I $P(PSOPAR,"^",2),'$P(PSOPAR,"^",16) D DUP S PSORX("DFLG")=1 Q "RTN","PSODDPRE",25,0) .D:PSODRUG("NAME")=$P(DNM,"^")&($D(^XUSEC("PSORPH",DUZ))) DUP "RTN","PSODDPRE",26,0) K ^TMP($J,"DD"),^TMP($J,"DC"),^TMP($J,"DI"),^TMP($J,"PSODRDI") "RTN","PSODDPRE",27,0) Q:$G(PSORX("DFLG")) "RTN","PSODDPRE",28,0) M ZZPSODRG=PSODRUG "RTN","PSODDPRE",29,0) S LIST="PSOPEPS" D REMOTE^PSOCPPRE "RTN","PSODDPRE",30,0) M PSODRUG=ZZPSODRG "RTN","PSODDPRE",31,0) Q "RTN","PSODDPRE",32,0) OBX ;process enhanced order checks "RTN","PSODDPRE",33,0) K ZDGDG,ZTHER,IT "RTN","PSODDPRE",34,0) S LIST="PSOPEPS" K PSODLQT,DTOUT,DUOUT,DIRUT,PSODOSD "RTN","PSODDPRE",35,0) I $P(^TMP($J,LIST,"OUT",0),"^")=-1 G EXIT "RTN","PSODDPRE",36,0) W !,"Now Processing Enhanced Order Checks! Please wait...",! H 2 "RTN","PSODDPRE",37,0) D FDB S PDRG=PSODRUG("IEN"),DO=0 D IN^PSSHRQ2(LIST) ;call 2 fdb "RTN","PSODDPRE",38,0) ; "RTN","PSODDPRE",39,0) K DIR "RTN","PSODDPRE",40,0) I $P(^TMP($J,LIST,"OUT",0),"^")=-1 D DATACK G EXIT "RTN","PSODDPRE",41,0) D ^PSODDPR2 ;if order checks returned "RTN","PSODDPRE",42,0) ; "RTN","PSODDPRE",43,0) EXIT ; "RTN","PSODDPRE",44,0) D ^PSOBUILD "RTN","PSODDPRE",45,0) K CAN,DA,DIR,DNM,DUPRX0,ISSD,J,LSTFL,MSG,PHYS,PSOCLC,PSONULN,REA,RFLS,RX0,RX2,RXN,RXREC,ST,Y,ZZ,ACT,PSOCLOZ,PSOLR,PSOLDT,PSOCD,SIG "RTN","PSODDPRE",46,0) K DO,PDRG,IT,PSODLQT "RTN","PSODDPRE",47,0) K ^TMP($J,LIST,"IN","PING"),^TMP($J,LIST,"OUT","EXCEPTIONS"),^TMP($J,"PSOPEPS"),^TMP($J,"PSORDI") "RTN","PSODDPRE",48,0) Q "RTN","PSODDPRE",49,0) DUP S:$P(PSOSD(STA,DNM),"^",2)<10!($P(PSOSD(STA,DNM),"^",2)=16) DUP=1 W !,PSONULN,!,$C(7),"Duplicate Drug in Local Rx:",! "RTN","PSODDPRE",50,0) S RXREC=+PSOSD(STA,DNM),MSG="Discontinued During "_$S('$G(PSONV):"New Prescription Entry",1:"Verification")_" - Duplicate Drug" "RTN","PSODDPRE",51,0) DATA S DUPRX0=^PSRX(RXREC,0),RFLS=$P(DUPRX0,"^",9),ISSD=$P(^PSRX(RXREC,0),"^",13),RX0=DUPRX0,RX2=^PSRX(RXREC,2),$P(RX0,"^",15)=+$G(^PSRX(RXREC,"STA")) "RTN","PSODDPRE",52,0) S RXRECLOC=$G(RXREC) "RTN","PSODDPRE",53,0) S DA=RXREC "RTN","PSODDPRE",54,0) D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT) "RTN","PSODDPRE",55,0) W !,$J("Rx: ",24)_$P(^PSRX(+PSOSD(STA,DNM),0),"^") "RTN","PSODDPRE",56,0) W !,$J("Drug: ",24)_$P(DNM,"^") "RTN","PSODDPRE",57,0) K FSIG,BSIG I $P($G(^PSRX(RXREC,"SIG")),"^",2) D FSIG^PSOUTLA("R",RXREC,54) F PSREV=1:1 Q:'$D(FSIG(PSREV)) S BSIG(PSREV)=FSIG(PSREV) "RTN","PSODDPRE",58,0) K FSIG,PSREV I '$P($G(^PSRX(RXREC,"SIG")),"^",2) D EN2^PSOUTLA1(RXREC,54) "RTN","PSODDPRE",59,0) W !,$J("SIG: ",24) W $G(BSIG(1)) "RTN","PSODDPRE",60,0) I $O(BSIG(1)) F PSREV=1:0 S PSREV=$O(BSIG(PSREV)) Q:'PSREV W !?24,$G(BSIG(PSREV)) "RTN","PSODDPRE",61,0) K BSIG,PSREV "RTN","PSODDPRE",62,0) D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT) "RTN","PSODDPRE",63,0) W !,$J("QTY: ",24)_$P(DUPRX0,"^",7),?42,$J("Refills remaining: ",24),RFLS-$S($D(^PSRX(RXREC,1,0)):$P(^(0),"^",4),1:0) "RTN","PSODDPRE",64,0) S PHYS=$S($D(^VA(200,+$P(DUPRX0,"^",4),0)):$P(^(0),"^"),1:"UNKNOWN") "RTN","PSODDPRE",65,0) W !,$J("Provider: ",24)_PHYS,?42,$J("Issued: ",24),$E(ISSD,4,5)_"/"_$E(ISSD,6,7)_"/"_$E(ISSD,2,3) "RTN","PSODDPRE",66,0) W !,$J("Status: ",24) S J=RXREC D STAT^PSOFUNC W ST K RX0,RX2 "RTN","PSODDPRE",67,0) S LSTFL=+^PSRX(RXREC,3) W ?42,$J("Last filled: ",24)_$E(LSTFL,4,5)_"/"_$E(LSTFL,6,7)_"/"_$E(LSTFL,2,3) "RTN","PSODDPRE",68,0) D PRSTAT(RXREC) "RTN","PSODDPRE",69,0) W !?42,$J("Days Supply: ",24)_$P(DUPRX0,"^",8) "RTN","PSODDPRE",70,0) W !,PSONULN,! I $P($G(^PS(53,+$P($G(PSORX("PATIENT STATUS")),"^"),0)),"^")["AUTH ABS"!($G(PSORX("PATIENT STATUS"))["AUTH ABS")&'$P(PSOPAR,"^",5) W !,"PATIENT ON AUTHORIZED ABSENCE!" K RXRECLOC Q "RTN","PSODDPRE",71,0) ASKCAN I $P(PSOSD(STA,DNM),"^",2)>10,$P(PSOSD(STA,DNM),"^",2)'=16 D Q "RTN","PSODDPRE",72,0) .K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to continue" D ^DIR S:($D(DTOUT))!($D(DUOUT)) PSODLQT=1,PSORX("DFLG")=1 K DIR,DTOUT,DUOUT,DIRUT,RXRECLOC "RTN","PSODDPRE",73,0) .S ^TMP("PSORXDD",$J,RXREC,0)=1 "RTN","PSODDPRE",74,0) I '$P(PSOPAR,"^",16),'$D(^XUSEC("PSORPH",DUZ)) D Q "RTN","PSODDPRE",75,0) .S PSORX("DFLG")=1 K RXRECLOC,DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to continue" "RTN","PSODDPRE",76,0) .D ^DIR K DIR "RTN","PSODDPRE",77,0) I $P(PSOSD(STA,DNM),"^",2)=16,$G(DUP) D Q "RTN","PSODDPRE",78,0) .W !!,"Prescription "_$P($G(^PSRX(+$G(RXRECLOC),0)),"^")_" is on Provider Hold, it cannot be discontinued.",! "RTN","PSODDPRE",79,0) .K DUP,DIR,RXRECLOC S PSORX("DFLG")=1 S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to continue" D ^DIR K DIR "RTN","PSODDPRE",80,0) D PSOL^PSSLOCK(RXRECLOC) I '$G(PSOMSG) D K PSOMSG,DIR,DUP,RXRECLOC S DIR("A")="Press Return to continue",DIR(0)="E",DIR("?")="Press Return to continue" D ^DIR K DIR S PSORX("DFLG")=1 Q "RTN","PSODDPRE",81,0) .I $P($G(PSOMSG),"^",2)'="" W !!,$P(PSOMSG,"^",2),! Q "RTN","PSODDPRE",82,0) .W !!,"Another person is editing Rx "_$P($G(^PSRX(RXRECLOC,0)),"^"),! "RTN","PSODDPRE",83,0) K PSOMSG S DIR("A")=$S($P(PSOSD(STA,DNM),"^",2)=12:"Reinstate",1:"Discontinue")_" RX # "_$P(^PSRX(+PSOSD(STA,DNM),0),"^")_" "_$P(DNM,"^")_" Y/N",DIR(0)="Y" "RTN","PSODDPRE",84,0) S DIR("?")="Enter Y to "_$S($P(PSOSD(STA,DNM),"^",2)=12:"reinstate",1:"discontinue")_" this RX." "RTN","PSODDPRE",85,0) D ^DIR K DIR S DA=RXREC S ACT=$S($D(SPCANC):"Reinstated during Rx cancel.",1:$S($P(PSOSD(STA,DNM),"^",2)=12:"Reinstated",1:"Discontinued")_" while "_$S('$G(PSONV):"entering",1:"verifying")_" new RX") "RTN","PSODDPRE",86,0) D CMOP^PSOUTL I $G(CMOP("S"))="L" W !,"A CMOP Rx cannot be discontinued during transmission!",! S Y=0 K CMOP "RTN","PSODDPRE",87,0) I 'Y W !,$C(7)," -Prescription was not "_$S($P(PSOSD(STA,DNM),"^",2)=12:"reinstated",1:"discontinued")_"..." D Q "RTN","PSODDPRE",88,0) .S:'$D(PSOCLC) PSOCLC=DUZ S MSG=ACT,REA=$S($P(PSOSD(STA,DNM),"^",2)=12:"R",1:"C") S:$G(DUP) PSORX("DFLG")=1 K DUP D ULRX K RXRECLOC "RTN","PSODDPRE",89,0) .K ^TMP("PSORXDC",$J,RXREC,0) "RTN","PSODDPRE",90,0) I $P(PSOSD(STA,DNM),"^",2)=16,$G(CLS) W !!,"Prescription "_$P($G(^PSRX(+$G(RXRECLOC),0)),"^")_" is on Provider Hold, it cannot be discontinued.",! D ULRX K CLS,DUP,RXRECLOC S PSORX("DFLG")=1 H 2 Q "RTN","PSODDPRE",91,0) S PSOCLC=DUZ,MSG=$S($G(MSG)]"":MSG,1:ACT_" During New RX "_$S('$G(PSONV):"Entry",1:"Verification")_" - Duplicate Rx"),REA=$S($P(PSOSD(STA,DNM),"^",2)=12:"R",1:"C") "RTN","PSODDPRE",92,0) W !! K ^UTILITY($J,"W") S DIWL=1,DIWR=75,DIWF="" "RTN","PSODDPRE",93,0) S X="Rx #"_$P(^PSRX(+PSOSD(STA,DNM),0),"^")_" "_DNM_" will be discontinued after"_$S('$G(PSOTECCK):" the acceptance of the new order.",1:" reinstating the order.") D ^DIWP "RTN","PSODDPRE",94,0) F ZX=0:0 S ZX=$O(^UTILITY($J,"W",1,ZX)) Q:'ZX W !,^UTILITY($J,"W",1,ZX,0) "RTN","PSODDPRE",95,0) K ^UTILITY($J,"W"),X,DIWL,DIWR,DIWF W ! "RTN","PSODDPRE",96,0) S ^TMP("PSORXDC",$J,RXREC,0)="52^"_DA_"^"_MSG_"^"_REA_"^"_ACT_"^"_STA_"^"_DNM,PSONOOR="D",^TMP("PSORXDD",$J)=DNM H 2 "RTN","PSODDPRE",97,0) K RXRECLOC,DUP,CLS,PSONOOR "RTN","PSODDPRE",98,0) Q "RTN","PSODDPRE",99,0) FDB ;build drug check input "RTN","PSODDPRE",100,0) N ID,ORTYP,PSOI,ORN S DFN=PSODFN,CT=0 "RTN","PSODDPRE",101,0) S ID=+$$GETVUID^XTID(50.68,,+$P(PSODRUG("NDF"),"A",2)_",") "RTN","PSODDPRE",102,0) S P1=$P(PSODRUG("NDF"),"A"),P2=$P(PSODRUG("NDF"),"A",2),X=$$PROD0^PSNAPIS(P1,P2),SEQN=+$P(X,"^",7) "RTN","PSODDPRE",103,0) I 'SEQN K ^TMP($J,LIST,"OUT","EXCEPTIONS"),^TMP($J,LIST,"IN") "RTN","PSODDPRE",104,0) S ^TMP($J,LIST,"IN","PROSPECTIVE","Z;1;PROSPECTIVE;1")=SEQN_"^"_ID_"^"_PSODRUG("IEN")_"^"_$P(^PSDRUG(PSODRUG("IEN"),0),"^") "RTN","PSODDPRE",105,0) S ^TMP($J,LIST,"IN","IEN")=PSODFN,^TMP($J,LIST,"IN","DRUGDRUG")="",^TMP($J,LIST,"IN","THERAPY")="" "RTN","PSODDPRE",106,0) K ID,P1,P2 N ODRG,TU S (STA,DNM)="" I '$G(PSOCOPY),'$G(SEQN) K SEQN Q "RTN","PSODDPRE",107,0) ;build profile drug order checks "RTN","PSODDPRE",108,0) F S STA=$O(PSOSD(STA)) Q:STA="" F S DNM=$O(PSOSD(STA,DNM)) Q:DNM="" D ;I $P(PSOSD(STA,DNM),"^")'=$G(PSORENW("OIRXN")) S CT=CT+1 D "RTN","PSODDPRE",109,0) .Q:$P(PSOSD(STA,DNM),"^")=$G(PSORENW("OIRXN"))&('$G(PSOCOPY)) "RTN","PSODDPRE",110,0) .S CT=CT+1 "RTN","PSODDPRE",111,0) .I STA="PENDING" N DDRG D "RTN","PSODDPRE",112,0) ..Q:$G(^TMP("PSORXDC",$J,$P(PSOSD(STA,DNM),"^",10),0))]"" "RTN","PSODDPRE",113,0) ..Q:$G(PSODRUG("IEN"))=$P(^PS(52.41,$P(PSOSD(STA,DNM),"^",10),0),"^",9) "RTN","PSODDPRE",114,0) ..Q:$P(^PS(52.41,$P(PSOSD(STA,DNM),"^",10),0),"^",3)="RF" "RTN","PSODDPRE",115,0) ..Q:$G(^TMP("PSORXPO",$J,$P(PSOSD(STA,DNM),"^",10),0)) "RTN","PSODDPRE",116,0) ..S RXREC=$P(PSOSD(STA,DNM),"^",10),ORN=$P(^PS(52.41,RXREC,0),"^"),ODRG=$P(^(0),"^",9),ORTYP="P" "RTN","PSODDPRE",117,0) ..I ODRG D K ODRG Q "RTN","PSODDPRE",118,0) ...I $P($G(^PSDRUG(ODRG,0)),"^",3)["S"!($E($P($G(^PSDRUG(ODRG,0)),"^",2),1,2)="XA") Q "RTN","PSODDPRE",119,0) ...S PDNM=$P(^PSDRUG(ODRG,0),"^") D ID "RTN","PSODDPRE",120,0) ..E N PSOI,DDRG,ODRG,SEQN,DDRG S PSOI=$P(^PS(52.41,RXREC,0),"^",8) D "RTN","PSODDPRE",121,0) ...S PDNM=$P(^PS(50.7,PSOI,0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^") "RTN","PSODDPRE",122,0) ...S DDRG=$$DRG^PSSDSAPM(PSOI,"O") I '$P(DDRG,";") D OIX Q "RTN","PSODDPRE",123,0) ...I $P($G(^PSDRUG($P(DDRG,";"),0)),"^",3)["S"!($E($P($G(^PSDRUG($P(DDRG,";"),0)),"^",2),1,2)="XA") Q "RTN","PSODDPRE",124,0) ...S ODRG=$P(DDRG,";"),SEQN=+$P(DDRG,";",3) K PSOI "RTN","PSODDPRE",125,0) ...N ID S ID=+$$GETVUID^XTID(50.68,,+$P($G(^PSDRUG(ODRG,"ND")),"^",3)_",") "RTN","PSODDPRE",126,0) ...D ID1 "RTN","PSODDPRE",127,0) .I STA="ZNONVA" D Q "RTN","PSODDPRE",128,0) ..Q:$G(^TMP($J,"PSONVADD",$P(PSOSD(STA,DNM),"^",10),0))]"" "RTN","PSODDPRE",129,0) ..S RXREC=$P(PSOSD(STA,DNM),"^",10),ODRG=$P(^PS(55,PSODFN,"NVA",RXREC,0),"^",2),ORN=$P(^(0),"^",8),ORTYP="N" "RTN","PSODDPRE",130,0) ..I ODRG D K ODRG Q "RTN","PSODDPRE",131,0) ...I $P($G(^PSDRUG(ODRG,0)),"^",3)["S"!($E($P($G(^PSDRUG(ODRG,0)),"^",2),1,2)="XA") Q "RTN","PSODDPRE",132,0) ...S PDNM=$P(^PSDRUG(ODRG,0),"^") D ID "RTN","PSODDPRE",133,0) ..E N PSOI,DDRG,ODRG,SEQN,DDRG S PSOI=$P(^PS(55,PSODFN,"NVA",RXREC,0),"^") D "RTN","PSODDPRE",134,0) ...S PDNM=$P(^PS(50.7,PSOI,0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^") "RTN","PSODDPRE",135,0) ...S DDRG=$$DRG^PSSDSAPM(PSOI,"O") I '$P(DDRG,";") D OIX Q "RTN","PSODDPRE",136,0) ...I $P($G(^PSDRUG($P(DDRG,";"),0)),"^",3)["S"!($E($P($G(^PSDRUG($P(DDRG,";"),0)),"^",2),1,2)="XA") Q "RTN","PSODDPRE",137,0) ...S ODRG=$P(DDRG,";"),SEQN=+$P(DDRG,";",3) K PSOI "RTN","PSODDPRE",138,0) ...N ID S ID=+$$GETVUID^XTID(50.68,,+$P($G(^PSDRUG(ODRG,"ND")),"^",3)_",") "RTN","PSODDPRE",139,0) ...D ID1 "RTN","PSODDPRE",140,0) .I $P($G(^PSRX(+PSOSD(STA,DNM),0)),"^",6) D "RTN","PSODDPRE",141,0) ..Q:$G(^TMP("PSORXDC",$J,$P(PSOSD(STA,DNM),"^"),0))]"" "RTN","PSODDPRE",142,0) ..Q:$G(^TMP("PSORXBO",$J,$P(PSOSD(STA,DNM),"^"),0)) "RTN","PSODDPRE",143,0) ..Q:$G(^TMP("PSORXDD",$J,$P(PSOSD(STA,DNM),"^"),0)) "RTN","PSODDPRE",144,0) ..;I $P(PSOSD(STA,DNM),"^",2)>5,$P(PSOSD(STA,DNM),"^",2)'=16 Q "RTN","PSODDPRE",145,0) ..S RXREC=+PSOSD(STA,DNM),ODRG=$P(^PSRX(RXREC,0),"^",6),ORN=$P($G(^("OR1")),"^",2),ORTYP="O" "RTN","PSODDPRE",146,0) ..I ODRG D "RTN","PSODDPRE",147,0) ...I $P($G(^PSDRUG(ODRG,0)),"^",3)["S"!($E($P($G(^PSDRUG(ODRG,0)),"^",2),1,2)="XA") Q "RTN","PSODDPRE",148,0) ...S PDNM=$P(^PSDRUG(ODRG,0),"^") D ID "RTN","PSODDPRE",149,0) K RXREC,ID,STA,DNM,PSOI,ORN,ODRG,ORTYP,CT,PDNM,TU,DDRG "RTN","PSODDPRE",150,0) Q "RTN","PSODDPRE",151,0) ID N ID,P1,P2 S ID=+$$GETVUID^XTID(50.68,,+$P($G(^PSDRUG(ODRG,"ND")),"^",3)_",") "RTN","PSODDPRE",152,0) S P1=$P($G(^PSDRUG(ODRG,"ND")),"^"),P2=$P($G(^("ND")),"^",3),X=$$PROD0^PSNAPIS(P1,P2),SEQN=$P(X,"^",7) "RTN","PSODDPRE",153,0) ID1 S ^TMP($J,LIST,"IN","PROFILE",ORTYP_";"_RXREC_";PROFILE;"_CT)=SEQN_"^"_ID_"^"_ODRG_"^"_PDNM_"^"_ORN_"^O" K ID "RTN","PSODDPRE",154,0) Q "RTN","PSODDPRE",155,0) OIX S ^TMP($J,LIST,"IN","EXCEPTIONS","OI",PDNM)=1_"^"_ORTYP_";"_RXREC_";PROFILE;"_CT "RTN","PSODDPRE",156,0) Q "RTN","PSODDPRE",157,0) ULRX ; "RTN","PSODDPRE",158,0) I '$G(RXRECLOC) Q "RTN","PSODDPRE",159,0) D PSOUL^PSSLOCK(RXRECLOC) "RTN","PSODDPRE",160,0) Q "RTN","PSODDPRE",161,0) ; "RTN","PSODDPRE",162,0) PRSTAT(DA) ;Displays the prescription's status "RTN","PSODDPRE",163,0) N PSOTRANS,PSOREL,PSOCMOP,RXPSTA,PSOX,RFLZRO,PSOLRD,PSORTS,CMOP "RTN","PSODDPRE",164,0) D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT) S RXPSTA="Processing Status: ",PSOLRD=$P($G(^PSRX(RXREC,2)),"^",13) "RTN","PSODDPRE",165,0) D ^PSOCMOPA I $G(PSOCMOP)]"" D K CMOP,PSOTRANS,PSOREL "RTN","PSODDPRE",166,0) .S PSOTRANS=$E($P(PSOCMOP,"^",2),4,5)_"/"_$E($P(PSOCMOP,"^",2),6,7)_"/"_$E($P(PSOCMOP,"^",2),2,3) "RTN","PSODDPRE",167,0) .S PSOREL=$S(CMOP("L")=0:$P($G(^PSRX(DA,2)),"^",13),1:$P(^PSRX(DA,1,CMOP("L"),0),"^",18)) "RTN","PSODDPRE",168,0) .S PSOREL=$E(PSOREL,4,5)_"/"_$E(PSOREL,6,7)_"/"_$E(PSOREL,2,3)_"@"_$E($P(PSOREL,".",2),1,4) "RTN","PSODDPRE",169,0) .I '$D(IOINORM)!('$D(IOINHI)) S X="IORVOFF;IORVON;IOINHI;IOINORM" D ENDR^%ZISS "RTN","PSODDPRE",170,0) .I $P($G(^PSRX(RXREC,"STA")),"^")=0 W:$$TRANCMOP^PSOUTL(RXREC) ?5,IORVON_IOINHI "RTN","PSODDPRE",171,0) .S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J(RXPSTA,24)_$S($P(PSOCMOP,"^")=0!($P(PSOCMOP,"^")=2):"Transmitted to CMOP on "_PSOTRANS,$P(PSOCMOP,"^")=1:"Released by CMOP on "_PSOREL,1:"Not Dispensed"),IOINORM_IORVOFF "RTN","PSODDPRE",172,0) D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT) "RTN","PSODDPRE",173,0) I $G(PSOCMOP)']"" D "RTN","PSODDPRE",174,0) .F PSOX=0:0 S PSOX=$O(^PSRX(RXREC,1,PSOX)) Q:'PSOX D "RTN","PSODDPRE",175,0) ..S RFLZRO=$G(^PSRX(RXREC,1,PSOX,0)) "RTN","PSODDPRE",176,0) ..S:$P(RFLZRO,"^",18)'="" PSOLRD=$P(RFLZRO,"^",18) I $P(RFLZRO,"^",16) S PSOLRD=PSOLRD_"^R",PSORTS=$P(RFLZRO,"^",16) "RTN","PSODDPRE",177,0) .I '$O(^PSRX(RXREC,1,0)),$P(^PSRX(RXREC,2),"^",15) S PSOLRD=PSOLRD_"^R",PSORTS=$P(^PSRX(RXREC,2),"^",15) "RTN","PSODDPRE",178,0) .S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J(RXPSTA,24) "RTN","PSODDPRE",179,0) .I +$G(PSORTS) S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) "Returned to stock on "_$$FMTE^XLFDT(PSORTS,2) Q "RTN","PSODDPRE",180,0) .S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) $S(PSOLRD="":"Not released locally",1:"Released locally on "_$$FMTE^XLFDT($P(PSOLRD,"^"),2)_" "_$P(PSOLRD,"^",2))_$S($P(^PSRX(RXREC,0),"^",11)="W":" (Window)",1:" (Mail)") "RTN","PSODDPRE",181,0) Q "RTN","PSODDPRE",182,0) ; "RTN","PSODDPRE",183,0) DATACK ;check FDB returned data to determine whether to continue processing. "RTN","PSODDPRE",184,0) S DIR(0)="E",DIR("A",1)="No Enhanced Order Checks can be performed." "RTN","PSODDPRE",185,0) S DIR("A",2)=" Reason: "_$P($G(^TMP($J,LIST,"OUT",0)),"^",2) "RTN","PSODDPRE",186,0) S DIR("A")="Press Return to continue...",DIR("?")="Press Return to continue" "RTN","PSODDPRE",187,0) W ! D ^DIR K DIRUT,DUOUT,DIR,X,Y W @IOF ;I $P(^TMP($J,LIST,"OUT",0),"^")=1 "RTN","PSODDPRE",188,0) Q "RTN","PSODELI") 0^13^B8034838^B7805536 "RTN","PSODELI",1,0) PSODELI ;IHS/DSD/JCM - DELETE ENTRIES IN APSP INTERVENTION FILE ;03/28/93 21:15 "RTN","PSODELI",2,0) ;;7.0;OUTPATIENT PHARMACY;**10,268,251,375,387**;DEC 1997;Build 13 "RTN","PSODELI",3,0) ;External reference to ^APSPQA(32.4 supported by DBIA 2179 "RTN","PSODELI",4,0) ;External reference to ^DD("DILOCKTM" supported by DBIA 4909 "RTN","PSODELI",5,0) ; "RTN","PSODELI",6,0) ; This routine is called by the option that delete entries in "RTN","PSODELI",7,0) ; the APSP INTERVENTION file. "RTN","PSODELI",8,0) ; These options are locked with the PSZMGR key. "RTN","PSODELI",9,0) ; "RTN","PSODELI",10,0) ; External Calls : ^DIE,^DIC,^DIR "RTN","PSODELI",11,0) ;----------------------------------------------------------------- "RTN","PSODELI",12,0) START ; "RTN","PSODELI",13,0) K DIC,DR,DIE,DA "RTN","PSODELI",14,0) D INTERV ; Sets up DIC and DIE calls for files "RTN","PSODELI",15,0) END D EOJ ; Cleans up variables "RTN","PSODELI",16,0) Q "RTN","PSODELI",17,0) ;------------------------------------------------------------------ "RTN","PSODELI",18,0) INTERV ; Deletes entries from APSP INTERVENTION file "RTN","PSODELI",19,0) W !,"You may only delete entries entered on the current day.",! "RTN","PSODELI",20,0) S PSODELI("QFLG")=0,APSP("LOG DEL FLG")="INTERV" "RTN","PSODELI",21,0) F PSODELI=0:0 S DIC(0)="QEAM",(PSODELI("DIC"),DIC)="^APSPQA(32.4,",DIC("S")="I DT=$P(^(0),U,1)" Q:PSODELI("QFLG") D DEL "RTN","PSODELI",22,0) Q "RTN","PSODELI",23,0) DEL ; Does actual lookup and deletion of entries "RTN","PSODELI",24,0) K PSODELI("DA") D ^DIC K DIC,DA,DR "RTN","PSODELI",25,0) I Y=-1 S PSODELI("QFLG")=1 G DELX "RTN","PSODELI",26,0) S PSODELI("DA")=+Y,DIR(0)="Y",Y=0,DIR("A")="SURE YOU WANT TO DELETE THE ENTIRE ENTRY" "RTN","PSODELI",27,0) D ^DIR K DIR G:$D(DIRUT)!('Y) DELX "RTN","PSODELI",28,0) S DIE=PSODELI("DIC"),DA=PSODELI("DA"),DR=".01///@",DIDEL=9009032.4 "RTN","PSODELI",29,0) L +^APSPQA(32.4,PSODELI("DA")):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) "RTN","PSODELI",30,0) D ^DIE K DIE,DA,DR "RTN","PSODELI",31,0) L -^APSPQA(32.4,PSODELI("DA")) "RTN","PSODELI",32,0) DELX ; Exit point from DEL "RTN","PSODELI",33,0) K DIC,DIR,DA,X,Y,PSODELI("DIC"),DIRUT S VALMBCK="R" "RTN","PSODELI",34,0) Q "RTN","PSODELI",35,0) EOJ ; Clean up variables "RTN","PSODELI",36,0) K PSODELI,APSP("LOG DEL FLG"),X,Y,DIRUT,DTOUT,DUOUT,DIC,DIK,DA,DR,DIDEL,DIE "RTN","PSODELI",37,0) Q "RTN","PSODELI",38,0) EDIT ;Edit Pharmacy Intervention "RTN","PSODELI",39,0) N DIC,DLAYGO,DA,Y,DIE,DR "RTN","PSODELI",40,0) W @IOF W !!,"Edit Existing Intervention",!! "RTN","PSODELI",41,0) F S DIC(0)="QEAM",DIC="^APSPQA(32.4,",DIC("A")="Select INTERVENTION:" D ^DIC K:Y=-1 X,DIC,DA,DIE Q:Y=-1 D "RTN","PSODELI",42,0) .S DA=+Y,DIE=DIC,DR="[PSO INTERVENTION EDIT]" D ^DIE "RTN","PSODELI",43,0) D EOJ S VALMBCK="R" "RTN","PSODELI",44,0) Q "RTN","PSODELI",45,0) NEW ;Enter Pharmacy Intervention "RTN","PSODELI",46,0) N DIC,DLAYGO,Y,DIE,DR,DIADD "RTN","PSODELI",47,0) W @IOF W !!,"Enter Pharmacy Intervention",!! "RTN","PSODELI",48,0) F S DIC(0)="QEMAL",DIC="^APSPQA(32.4,",DLAYGO=9009032.4,DIADD="" D ^DIC K DA,DR,DIADD K:Y=-1 X,DIC,DIADD,DA,DIE Q:Y=-1 D "RTN","PSODELI",49,0) .S DA=+Y,DIE=DIC,DR="[PSO INTERVENTION NEW]" K DIC D ^DIE "RTN","PSODELI",50,0) D EOJ S VALMBCK="R" "RTN","PSODELI",51,0) Q "RTN","PSODELI",52,0) OUT ; Print Pharmacy Intervention "RTN","PSODELI",53,0) N L,DIC,FLDS,BY,Y "RTN","PSODELI",54,0) W @IOF W !!,"Print Pharmacy Intervention",!! "RTN","PSODELI",55,0) S L=0,DIC="^APSPQA(32.4,",FLDS="[PSO INTERVENTIONS]",BY="[PSO INTERVENTIONS]" "RTN","PSODELI",56,0) D EN1^DIP W !!,"Pharmacy Intervention Menu",!! "RTN","PSODELI",57,0) D EOJ S VALMBCK="R" "RTN","PSODELI",58,0) Q "RTN","PSODELI",59,0) VIEW ;View Pharmacy Interventions "RTN","PSODELI",60,0) D FULL^VALM1 "RTN","PSODELI",61,0) W @IOF,!!,"View Interventions",!! S PSOVWI("DIC")="^APSPQA(32.4," D ^PSOVWI "RTN","PSODELI",62,0) D EOJ S VALMBCK="R" "RTN","PSODELI",63,0) Q "RTN","PSODGDGP") 0^7^B47871096^B48532465 "RTN","PSODGDGP",1,0) PSODGDGP ;BIR/SAB - drug drug interaction checker ;4/14/93 "RTN","PSODGDGP",2,0) ;;7.0;OUTPATIENT PHARMACY;**251,387**;DEC 1997;Build 13 "RTN","PSODGDGP",3,0) ;External reference to ^PS(56 supported by DBIA 2229 "RTN","PSODGDGP",4,0) ;External reference to ^PSDRUG supported by DBIA 221 "RTN","PSODGDGP",5,0) ;External references PSOL and PSOUL^PSSLOCK supported by DBIA 2789 "RTN","PSODGDGP",6,0) ;External references to ^ORRDI1 supported by DBIA 4659 "RTN","PSODGDGP",7,0) ;External reference ^XTMP("ORRDI" supported by DBIA 4660 "RTN","PSODGDGP",8,0) ;External reference to $$DS^PSSDSAPI supported by DBIA 5425 "RTN","PSODGDGP",9,0) N DRG,PSOREMOT S (CRIT,DRG,LSI,DGI,DGS,SER,SERS,STA,PSOICT)="",PSOREMOT=0 "RTN","PSODGDGP",10,0) D BLD Q:+$G(PSORX("DFLG"))!($G(PSODLQT)) "RTN","PSODGDGP",11,0) I '$D(^XUSEC("PSORPH",DUZ)),$G(DGI)]"" S:$G(CRIT) PSONEW("STATUS")=4 W $C(7),!,"DRUG INTERACTON WITH RX #s: "_LSI,! "RTN","PSODGDGP",12,0) I '$D(^XUSEC("PSORPH",DUZ)),(","_$G(^TMP("PSOSER",$J,0))_",")[(",1,") S:$D(^TMP("PSODGI",$J,0)) PSONEW("STATUS")=4 "RTN","PSODGDGP",13,0) K DRG,NDF,PSOICT,IT,LSI "RTN","PSODGDGP",14,0) I +$G(PSORX("DFLG")) Q "RTN","PSODGDGP",15,0) I +$G(PSODRUG("NDF"))'=0 D "RTN","PSODGDGP",16,0) .I $T(HAVEHDR^ORRDI1)']"" Q "RTN","PSODGDGP",17,0) .I '$$HAVEHDR^ORRDI1 Q "RTN","PSODGDGP",18,0) .D HD^PSODDPR2():(($Y+5)>IOSL) "RTN","PSODGDGP",19,0) .I $P($G(^XTMP("ORRDI","PSOO",PSODFN,0)),"^",3)<0 W !!,"Remote data not available - Only local order checks processed.",!! S PSOREMOT=1 D HD^PSODDPR2():(($Y+5)>IOSL) Q "RTN","PSODGDGP",20,0) .I $D(^TMP($J,"DI"_PSODFN)) K ^TMP($J,"DI") M ^TMP($J,"DI")=^TMP($J,"DI"_PSODFN) D DRGINT^PSOORRD2 "RTN","PSODGDGP",21,0) .K ^TMP($J,"DI"_PSODFN),^TMP($J,"DI") "RTN","PSODGDGP",22,0) I '$D(^XUSEC("PSORPH",DUZ)),$G(PSOREMOT)!($G(DGI)]"") K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to Continue..." D ^DIR K DIR,DUOUT,DTOUT "RTN","PSODGDGP",23,0) Q "RTN","PSODGDGP",24,0) TECH ;add tech entry to RX VERIFY file (#52.4); called from new order/copy/renew "RTN","PSODGDGP",25,0) I $$DS^PSSDSAPI,+$G(^TMP("PSODOSF",$J,0)) S ^PS(52.4,PSOX("IRXN"),1)=^TMP("PSODOSF",$J,0) "RTN","PSODGDGP",26,0) I $G(^TMP("PSODGI",$J,0))'="" D "RTN","PSODGDGP",27,0) .S $P(^PSRX(PSOX("IRXN"),"DRI"),"^")=^TMP("PSOSER",$J,0)_"^"_^TMP("PSODGI",$J,0) "RTN","PSODGDGP",28,0) .S $P(^PS(52.4,PSOX("IRXN"),0),"^",8)=1,$P(^PS(52.4,PSOX("IRXN"),0),"^",9)=^TMP("PSOSER",$J,0),$P(^PS(52.4,PSOX("IRXN"),0),"^",10)=^TMP("PSODGI",$J,0) "RTN","PSODGDGP",29,0) Q "RTN","PSODGDGP",30,0) BLD I $D(^XUSEC("PSORPH",DUZ)) S PSORX("PHARM")=DUZ D PHARM Q "RTN","PSODGDGP",31,0) BLD2 ; "RTN","PSODGDGP",32,0) Q:$P(ON,";")'="O" "RTN","PSODGDGP",33,0) S LSI=$P(^PSRX($P(ON,";",2),0),"^")_"/"_$P(^PSDRUG($P(^PSRX($P(ON,";",2),0),"^",6),0),"^")_","_LSI "RTN","PSODGDGP",34,0) I '$D(^TMP("PSODGI",$J,0)) D "RTN","PSODGDGP",35,0) . S ^TMP("PSODGI",$J,0)=$P(ON,";",2)_","_$G(^TMP("PSODGI",$J,0)),^TMP("PSOSER",$J,0)=IT_","_$G(^TMP("PSOSER",$J,0)) "RTN","PSODGDGP",36,0) I ^TMP("PSODGI",$J,0)'[$P(ON,";",2) D "RTN","PSODGDGP",37,0) .S ^TMP("PSODGI",$J,0)=$P(ON,";",2)_","_$G(^TMP("PSODGI",$J,0)) "RTN","PSODGDGP",38,0) .S ^TMP("PSOSER",$J,0)=IT_","_$G(^TMP("PSOSER",$J,0)) "RTN","PSODGDGP",39,0) I IT=2 S ^TMP("PSOSERS",$J,0)=IT_","_$G(^TMP("PSOSERS",$J,0)),^TMP("PSODGS",$J,0)=$P(ON,";",2)_","_$G(^TMP("PSODGS",$J,0)) "RTN","PSODGDGP",40,0) S:IT=1 ^TMP("PSOTDD",$J,1)=1 "RTN","PSODGDGP",41,0) Q "RTN","PSODGDGP",42,0) PHARM ;pharmacist verification of drug interaction "RTN","PSODGDGP",43,0) D PSOL^PSSLOCK($P(ON,";",2)) I '$G(PSOMSG) D K PSOMSG S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to Continue" D ^DIR K DIR S PSORX("DFLG")=1 Q "RTN","PSODGDGP",44,0) .I $P($G(PSOMSG),"^",2)'="" W !!,$P(PSOMSG,"^",2) D Q "RTN","PSODGDGP",45,0) ..W !,"Rx: "_$P($G(^PSRX($P(ON,";",2),0)),"^")_" Drug: "_$P($G(^PSDRUG(+$P($G(^(0)),"^",6),0)),"^") "RTN","PSODGDGP",46,0) ..W !,"which interacts with the drug you are entering!",! "RTN","PSODGDGP",47,0) .W !!,"Another person is editing Rx "_$P($G(^PSRX($P(ON,";",2),0)),"^")_",",!,"which interacts with the drug you are entering!",! "RTN","PSODGDGP",48,0) S PSODGRLX=$P(ON,";",2) "RTN","PSODGDGP",49,0) S DIR("?",1)="Answer 'YES' if you DO want to "_$S(IT=1:"continue processing",1:"enter an intervention for")_" this medication," "RTN","PSODGDGP",50,0) S DIR("?")=" 'NO' if you DON'T want to "_$S(IT=1:"continue processing",1:"enter an intervention for")_" this medication," "RTN","PSODGDGP",51,0) W ! S DIR(0)="SA^1:YES;0:NO",DIR("A")="Do you want to "_$S(IT=1:"Continue? ",1:"Intervene? "),DIR("B")="Y" D ^DIR "RTN","PSODGDGP",52,0) I 'Y,IT=1 S PSORX("DFLG")=1,DGI="" K DIR,DTOUT,DIRUT,DIROUT,DUOUT Q "RTN","PSODGDGP",53,0) I Y,IT=1 S PSORX("INTERVENE")=1,DGI="" K DIR,DTOUT,DIRUT,DIROUT,DUOUT G CRI Q "RTN","PSODGDGP",54,0) I 'Y,IT=2 S:$G(DIRUT) PSORX("DFLG")=1 K DIR,DTOUT,DIRUT,DIROUT,DUOUT D ULRX Q "RTN","PSODGDGP",55,0) I Y,IT=2 S PSORX("INTERVENE")=2,DGI="" K DIR,DTOUT,DIRUT,DIROUT,DUOUT "RTN","PSODGDGP",56,0) D ULRX "RTN","PSODGDGP",57,0) Q "RTN","PSODGDGP",58,0) CRI ;process new drug interactions entered by pharmacist "RTN","PSODGDGP",59,0) K DIR ;G:$P(PSOSD(STA,DRG),"^",9) CRITN "RTN","PSODGDGP",60,0) S DIR("A",1)="",DIR("A",2)="Do you want to Process medication",DIR("A")=PSODRUG("NAME")_": ",DIR(0)="SA^1:PROCESS;0:ABORT ORDER ENTRY",DIR("B")="P" "RTN","PSODGDGP",61,0) S DIR("?",1)="Enter '1' or 'P' to Activate medication",DIR("?")=" '0' or 'A' to Abort Order Entry process" D ^DIR K X1,DIR I 'Y S PSORX("DFLG")=1,DGI="" K DTOUT,DIRUT,DIROUT,DUOUT,PSORX("INTERVENE") D ULRX Q "RTN","PSODGDGP",62,0) I IT=1 D "RTN","PSODGDGP",63,0) .S PSORX("INTERVENE")=IT "RTN","PSODGDGP",64,0) .D SIG^XUSESIG I X1="" K PSORX("INTERVENE") S PSORX("DFLG")=1 Q "RTN","PSODGDGP",65,0) K DUOUT,DTOUT,DIRUT,DIROUT D ULRX Q "RTN","PSODGDGP",66,0) CRITN ;process multiple new drug interactions "RTN","PSODGDGP",67,0) K X1,DIR S DIR("A",1)="",DIR("A",2)="Do you want to: ",DIR("A",3)=" 1. Delete NEW medication "_PSODRUG("NAME"),DIR("A",4)=" 2. Cancel ACTIVE New Rx #"_$P(^PSRX($P(ON,";",2),0),"^")_" DRUG: "_DRG "RTN","PSODGDGP",68,0) S DIR("A",5)=" 3. Delete 1 and Cancel 2",DIR("A")=" 4. Continue ?: ",DIR(0)="SA^1:NEW MEDICATION;2:ACTIVE New Rx "_DRG_";3:BOTH;4:CONTINUE" "RTN","PSODGDGP",69,0) S DIR("?",1)="Enter '1' or 'N' to Delete New Medication and Dispense Rx #"_$P(^PSRX($P(ON,";",2),0),"^") "RTN","PSODGDGP",70,0) S DIR("?",2)=" '2' or 'A' to Cancel Active Rx #"_$P(^PSRX($P(ON,";",2),0),"^")_" and Dispense New Rx" "RTN","PSODGDGP",71,0) S DIR("?",3)=" '3' or 'B' to Delete 1 and Cancel 2",DIR("?")=" '4' or 'C' to do nothing to either Rx" D ^DIR K DIR "RTN","PSODGDGP",72,0) I Y=1 S PSORX("DFLG")=1,DGI="",PSHLDDRG=PSODRUG("IEN") D D ULRX Q "RTN","PSODGDGP",73,0) .I $G(PSORXED) D Q "RTN","PSODGDGP",74,0) ..D NOOR^PSOCAN4 I $D(DIRUT) W $C(7)," ACTION NOT TAKEN!",! S PSORX("DFLG")=1 K PSORX("INTERVENE") Q "RTN","PSODGDGP",75,0) ..S DA=$P(ON,";",2) D MESS,ENQ^PSORXDL,FULL^VALM1 "RTN","PSODGDGP",76,0) ..K PSOSD($P(PSOLST($P(ON,";",2)),"^",3),PSODRUG("NAME")),DTOUT,DIROUT,DIRUT,DUOUT S:$G(PSOSD) PSOSD=PSOSD-1 S ZONE=1 "RTN","PSODGDGP",77,0) .S PSODRUG("IEN")=$P(^PSRX($P(ON,";",2),0),"^",6) D FULL^VALM1,^PSORXI "RTN","PSODGDGP",78,0) .S PSODRUG("IEN")=PSHLDDRG,VALMBCK="R" "RTN","PSODGDGP",79,0) .K DTOUT,DIRUT,DIROUT,DUOUT,PSHLDDRG "RTN","PSODGDGP",80,0) .I $G(OR0) D "RTN","PSODGDGP",81,0) ..D NOOR^PSOCAN4 I $D(DIRUT) D Q "RTN","PSODGDGP",82,0) ...W $C(7)," ACTION NOT TAKEN!",! K PSORX("INTERVENE") S PSORX("DFLG")=1 "RTN","PSODGDGP",83,0) ..D DC^PSOORFI2 "RTN","PSODGDGP",84,0) I Y=2 S (DA,PSOHOLDA)=$P(ON,";",2) D D ULRX Q "RTN","PSODGDGP",85,0) .D NOOR^PSOCAN4 I $D(DIRUT) D Q "RTN","PSODGDGP",86,0) ..W $C(7)," ACTION NOT TAKEN!",! K PSORX("INTERVENE") S PSORX("DFLG")=1 "RTN","PSODGDGP",87,0) .D MESS,ENQ^PSORXDL "RTN","PSODGDGP",88,0) .S DA=PSOHOLDA D FULL^VALM1,EN1^PSORXI(.DA),PPL "RTN","PSODGDGP",89,0) .K DTOUT,DIROUT,DIRUT,DUOUT,PSOHOLDA "RTN","PSODGDGP",90,0) .S:$G(PSOSD) PSOSD=PSOSD-1 S VALMBCK="R" "RTN","PSODGDGP",91,0) I Y=3 S (DA,PSOHOLDA)=$P(ON,";",2) D S VALMBCK="R" "RTN","PSODGDGP",92,0) .D NOOR^PSOCAN4 I $D(DIRUT) D Q "RTN","PSODGDGP",93,0) ..W $C(7)," ACTION NOT TAKEN!",! K PSORX("INTERVENE") S PSORX("DFLG")=1 "RTN","PSODGDGP",94,0) .S:$G(PSOSD) PSOSD=PSOSD-1 S PSORX("DFLG")=1 D MESS,ENQ^PSORXDL "RTN","PSODGDGP",95,0) .I $G(OR0) D DC^PSOORFI2 "RTN","PSODGDGP",96,0) .S DA=PSOHOLDA D FULL^VALM1,EN1^PSORXI(.DA),PPL K PSOHOLDA "RTN","PSODGDGP",97,0) .I $G(PSORXED) D "RTN","PSODGDGP",98,0) ..S DA=$P(ON,";",2) D MESS,ENQ^PSORXDL,FULL^VALM1 "RTN","PSODGDGP",99,0) ..K DTOUT,DIROUT,DIRUT,DUOUT S:$G(PSOSD) PSOSD=PSOSD-1 S ZONE=1 "RTN","PSODGDGP",100,0) K DTOUT,DIROUT,DIRUT,DUOUT "RTN","PSODGDGP",101,0) D ULRX "RTN","PSODGDGP",102,0) Q "RTN","PSODGDGP",103,0) MESS W !!,"Canceling Rx: "_$P($G(^PSRX(DA,0)),"^")_" "_"Drug: "_$P($G(^PSDRUG($P(^PSRX(DA,0),"^",6),0)),"^"),! Q "RTN","PSODGDGP",104,0) PPL F PSOSL=0:0 S PSOSL=$O(PSORX("PSOL",PSOSL)) Q:'PSOSL S PSOX2=PSOSL "RTN","PSODGDGP",105,0) I $G(PSOX2) D "RTN","PSODGDGP",106,0) .F PSOSL=0:1:PSOX2 S PSOSL=$O(PSORX("PSOL",PSOSL)) Q:'PSOSL F ENT=1:1:$L(PSORX("PSOL",PSOSL),",") I $P(PSORX("PSOL",PSOSL),",",ENT)=$P(ON,";",2) S PSOL(PSOSL,ENT)="" "RTN","PSODGDGP",107,0) .F PSOL=0:0 S PSOL=$O(PSOL(PSOL)) Q:'PSOL F ENT=0:0 S ENT=$O(PSOL(PSOL,ENT)) Q:'ENT D "RTN","PSODGDGP",108,0) ..I ENT=1,'$P(PSORX("PSOL",PSOL),",",2) K PSORX("PSOL",PSOL) Q "RTN","PSODGDGP",109,0) ..I ENT=1,$P(PSORX("PSOL",PSOL),",",2) S PSORX("PSOL",PSOL)=$P(PSORX("PSOL",PSOL),",",2,99) Q "RTN","PSODGDGP",110,0) ..S PSORX("PSOL",PSOL)=$P(PSORX("PSOL",PSOL),",",1,ENT-1)_","_$P(PSORX("PSOL",PSOL),",",ENT+1,99) "RTN","PSODGDGP",111,0) K PSOX2,PSOSL,PSOL,ENT Q "RTN","PSODGDGP",112,0) ULRX ; "RTN","PSODGDGP",113,0) I '$G(PSODGRLX) Q "RTN","PSODGDGP",114,0) D PSOUL^PSSLOCK(PSODGRLX) K PSODGRLX "RTN","PSODGDGP",115,0) Q "RTN","PSODRDU2") 0^22^B22379293^B22449078 "RTN","PSODRDU2",1,0) PSODRDU2 ;BHAM ISC/SAB - dup drug/class display for outpatient orders ;9/23/97 8:40am "RTN","PSODRDU2",2,0) ;;7.0;OUTPATIENT PHARMACY;**132,251,375,387**;DEC 1997;Build 13 "RTN","PSODRDU2",3,0) ;External reference ^PS(50.7 - 2223 "RTN","PSODRDU2",4,0) ;External reference ^PS(50.606 - 2174 "RTN","PSODRDU2",5,0) ;External reference ^PSDRUG( - 221 "RTN","PSODRDU2",6,0) ;External reference to ^PS(55 - 2228 "RTN","PSODRDU2",7,0) EN(PSODFN,ORN,LIST) ;psodfn=patient's ifn, orn=ordertype;order#;drugtype;counter "RTN","PSODRDU2",8,0) N DUPRXO,I,ISSD,J,BSIG,RFLS,RXREC,ST,PSONULN,LSTFL "RTN","PSODRDU2",9,0) S $P(PSONULN,"-",79)="-" "RTN","PSODRDU2",10,0) I $P(ORN,";")="O" G RX "RTN","PSODRDU2",11,0) I $P(ORN,";")="P" G PND "RTN","PSODRDU2",12,0) I $P(ORN,";")="N" G NVA "RTN","PSODRDU2",13,0) I $P(ORN,";")="R" G RDI "RTN","PSODRDU2",14,0) Q "RTN","PSODRDU2",15,0) RX ;Rx info "RTN","PSODRDU2",16,0) Q:'$D(^PSRX($P(ORN,";",2),0)) N ISSD,LSTFLD S RXREC=$P(ORN,";",2) "RTN","PSODRDU2",17,0) S DUPRX0=^PSRX(RXREC,0),RFLS=$P(DUPRX0,"^",9),ISSD=$P(^PSRX(RXREC,0),"^",13),ISSD=$E(ISSD,4,5)_"/"_$E(ISSD,6,7)_"/"_$E(ISSD,2,3) "RTN","PSODRDU2",18,0) S LSTFL=(+^PSRX(RXREC,3)),LSTFL=$E(LSTFL,4,5)_"/"_$E(LSTFL,6,7)_"/"_$E(LSTFL,2,3),RX0=DUPRX0,RX2=^PSRX(RXREC,2) "RTN","PSODRDU2",19,0) S STA="ACTIVE^NON-VERIFIED^REFILL^HOLD^NON-VERIFIED^SUSPENDED^^^^^DONE^EXPIRED^DISCONTINUED^DELETED^DISCONTINUED BY PROVIDER^DISCONTINUED (EDIT)^HELD BY PROVIDER" "RTN","PSODRDU2",20,0) S ST=$P(STA,"^",(+$P(^PSRX(RXREC,"STA"),"^")+1)) K STA "RTN","PSODRDU2",21,0) W !,"Local Rx #"_$P(DUPRX0,"^")_" ("_ST_") for "_$P(^PSDRUG($P(DUPRX0,"^",6),0),"^") "RTN","PSODRDU2",22,0) K FSIG,BSIG I $P($G(^PSRX(RXREC,"SIG")),"^",2) D FSIG^PSOUTLA("R",RXREC,60) F PSREV=1:1 Q:'$D(FSIG(PSREV)) S BSIG(PSREV)=FSIG(PSREV) "RTN","PSODRDU2",23,0) K FSIG,PSREV I '$P($G(^PSRX(RXREC,"SIG")),"^",2) D EN2^PSOUTLA1(RXREC,60) "RTN","PSODRDU2",24,0) W !,"SIG: "_$G(BSIG(1)) I $O(BSIG(1)) F PSREV=1:0 S PSREV=$O(BSIG(PSREV)) Q:'PSREV W !?20,$G(BSIG(PSREV)) "RTN","PSODRDU2",25,0) D PRSTAT(RXREC) W ! "RTN","PSODRDU2",26,0) Q "RTN","PSODRDU2",27,0) PND ;op pending orders "RTN","PSODRDU2",28,0) Q:'$D(^PS(52.41,$P(ORN,";",2),0)) "RTN","PSODRDU2",29,0) N DUPRX0,FSIG "RTN","PSODRDU2",30,0) S DUPRX0=^PS(52.41,$P(ORN,";",2),0) "RTN","PSODRDU2",31,0) W !,"Pending Outpatient Drug for "_$S('$P(DUPRX0,"^",9):$P(^PS(50.7,$P(DUPRX0,"^",8),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^"),1:$P(^PSDRUG($P(DUPRX0,"^",9),0),"^")) "RTN","PSODRDU2",32,0) D FSIG^PSOUTLA("P",$P(ORN,";",2),IOM-6) "RTN","PSODRDU2",33,0) W !,"SIG: " F I=0:0 S I=$O(FSIG(I)) Q:'I W FSIG(I),!?5 "RTN","PSODRDU2",34,0) Q "RTN","PSODRDU2",35,0) NVA ;non-va meds "RTN","PSODRDU2",36,0) Q:'$D(^PS(55,PSODFN,"NVA",$P(ORN,";",2),0)) "RTN","PSODRDU2",37,0) S DUPRX0=^PS(55,PSODFN,"NVA",$P(ORN,";",2),0) "RTN","PSODRDU2",38,0) W !,"NON-VA Med: "_$S('$P(DUPRX0,"^",2):$P(^PS(50.7,$P(DUPRX0,"^"),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^"),1:$P(^PSDRUG($P(DUPRX0,"^",2),0),"^")) ;_" (ACTIVE)" "RTN","PSODRDU2",39,0) W !,"Dosage: "_$P(DUPRX0,"^",3),?25,"Schedule: "_$P(DUPRX0,"^",5) "RTN","PSODRDU2",40,0) W ! "RTN","PSODRDU2",41,0) ;W !?3,"Date Documented: "_$E($P(DUPRX0,"^",10),4,5)_"/"_$E($P(DUPRX0,"^",10),6,7)_"/"_$E($P(DUPRX0,"^",10),2,3),?30,"Status: Active",! "RTN","PSODRDU2",42,0) K DUPRX0 "RTN","PSODRDU2",43,0) Q "RTN","PSODRDU2",44,0) RDI ;RDI orders "RTN","PSODRDU2",45,0) Q:'$D(^TMP($J,LIST,"OUT","REMOTE",$P(ORN,";",2))) "RTN","PSODRDU2",46,0) S RXREC=^TMP($J,LIST,"OUT","REMOTE",$P(ORN,";",2)) "RTN","PSODRDU2",47,0) W !,"LOCATION: "_$P(RXREC,"^") "RTN","PSODRDU2",48,0) W !,"Remote Rx #"_$P(RXREC,"^",5)_" ("_$P(RXREC,"^",4)_") for "_$P(RXREC,"^",3) "RTN","PSODRDU2",49,0) W !,"SIG: " S I="" F S I=$O(^TMP($J,LIST,"OUT","REMOTE",$P(ORN,";",2),"SIG",I)) Q:I="" D "RTN","PSODRDU2",50,0) .W ^TMP($J,LIST,"OUT","REMOTE",$P(ORN,";",2),"SIG",I),! "RTN","PSODRDU2",51,0) .I $O(^TMP($J,LIST,"OUT","REMOTE",$P(ORN,";",2),"SIG",I))'="" W ?5 "RTN","PSODRDU2",52,0) W "Last Filled On: "_$P(RXREC,"^",6),! "RTN","PSODRDU2",53,0) K RXREC,I "RTN","PSODRDU2",54,0) Q "RTN","PSODRDU2",55,0) PRSTAT(DA) ;Displays the prescription's status "RTN","PSODRDU2",56,0) N PSOTRANS,PSOREL,PSOCMOP,RXPSTA,PSOX,RFLZRO,PSOLRD,PSORTS,CMOP "RTN","PSODRDU2",57,0) D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT) S RXPSTA="Processing Status: ",PSOLRD=$P($G(^PSRX(RXREC,2)),"^",13) "RTN","PSODRDU2",58,0) D ^PSOCMOPA I $G(PSOCMOP)]"" D K CMOP,PSOTRANS,PSOREL "RTN","PSODRDU2",59,0) .S PSOTRANS=$E($P(PSOCMOP,"^",2),4,5)_"/"_$E($P(PSOCMOP,"^",2),6,7)_"/"_$E($P(PSOCMOP,"^",2),2,3) "RTN","PSODRDU2",60,0) .S PSOREL=$S(CMOP("L")=0:$P($G(^PSRX(DA,2)),"^",13),1:$P(^PSRX(DA,1,CMOP("L"),0),"^",18)) "RTN","PSODRDU2",61,0) .S PSOREL=$E(PSOREL,4,5)_"/"_$E(PSOREL,6,7)_"/"_$E(PSOREL,2,3)_"@"_$E($P(PSOREL,".",2),1,4) "RTN","PSODRDU2",62,0) .I '$D(IOINORM)!('$D(IOINHI)) S X="IORVOFF;IORVON;IOINHI;IOINORM" D ENDR^%ZISS "RTN","PSODRDU2",63,0) .I $P($G(^PSRX(RXREC,"STA")),"^")=0 W:$$TRANCMOP^PSOUTL(RXREC) ?5,IORVON_IOINHI "RTN","PSODRDU2",64,0) .W !,RXPSTA_$S($P(PSOCMOP,"^")=0!($P(PSOCMOP,"^")=2):"Transmitted to CMOP on "_PSOTRANS,$P(PSOCMOP,"^")=1:"Released by CMOP on "_PSOREL,1:"Not Dispensed"),IOINORM_IORVOFF "RTN","PSODRDU2",65,0) D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT) "RTN","PSODRDU2",66,0) I $G(PSOCMOP)']"" D "RTN","PSODRDU2",67,0) .F PSOX=0:0 S PSOX=$O(^PSRX(RXREC,1,PSOX)) Q:'PSOX D "RTN","PSODRDU2",68,0) ..S RFLZRO=$G(^PSRX(RXREC,1,PSOX,0)) "RTN","PSODRDU2",69,0) ..S:$P(RFLZRO,"^",18)'="" PSOLRD=$P(RFLZRO,"^",18) I $P(RFLZRO,"^",16) S PSOLRD=PSOLRD_"^R",PSORTS=$P(RFLZRO,"^",16) "RTN","PSODRDU2",70,0) .I '$O(^PSRX(RXREC,1,0)),$P(^PSRX(RXREC,2),"^",15) S PSOLRD=PSOLRD_"^R",PSORTS=$P(^PSRX(RXREC,2),"^",15) "RTN","PSODRDU2",71,0) .W !,RXPSTA I +$G(PSORTS) W "Returned to stock on "_$$FMTE^XLFDT(PSORTS,2) Q "RTN","PSODRDU2",72,0) .W $S(PSOLRD="":"Not released locally",1:"Released locally on "_$$FMTE^XLFDT($P(PSOLRD,"^"),2)_" "_$P(PSOLRD,"^",2))_$S($P(^PSRX(RXREC,0),"^",11)="W":" (Window)",1:" (Mail)") "RTN","PSODRDU2",73,0) Q "RTN","PSODRG") 0^4^B64923938^B66921179 "RTN","PSODRG",1,0) PSODRG ;IHS/DSD/JCM - ORDER ENTRY DRUG SELECTION ;03/30/93 "RTN","PSODRG",2,0) ;;7.0;OUTPATIENT PHARMACY;**20,23,36,53,54,46,112,139,207,148,243,268,324,251,375,387**;DEC 1997;Build 13 "RTN","PSODRG",3,0) ;Reference ^PSDRUG supported by DBIA 221 "RTN","PSODRG",4,0) ;Reference ^PS(50.7 supported by DBIA 2223 "RTN","PSODRG",5,0) ;Reference to PSSDIN supported by DBIA 3166 "RTN","PSODRG",6,0) ;Reference to $$NDCFMT^PSSNDCUT supported by IA 4707 "RTN","PSODRG",7,0) ;Reference to OROCAPI controlled subscription supported by IA 5367 "RTN","PSODRG",8,0) ;Reference to $$OITM^ORX8 supported by IA 5469 "RTN","PSODRG",9,0) ;Reference to ^VADPT supported by IA 10061 "RTN","PSODRG",10,0) ;Reference to IN^PSSHRQ2 supported by DBIA 5369 "RTN","PSODRG",11,0) ;---------------------------------------------------------- "RTN","PSODRG",12,0) START ; "RTN","PSODRG",13,0) S (PSONEW("DFLG"),PSONEW("FIELD"),PSODRG("QFLG"))=0 K PSORX("DFLG") "RTN","PSODRG",14,0) D @($S(+$G(PSOEDIT)=1&('$D(DA)):"SELECT^PSODRGN",1:"SELECT")) "RTN","PSODRG",15,0) G:$G(PSORXED("DFLG")) END ; Select Drug "RTN","PSODRG",16,0) I $G(PSORX("EDIT")),$G(PSOY),$G(PSODRUG("IEN"))=+PSOY D G:$G(PSORXED("DFLG")) END "RTN","PSODRG",17,0) . N NDC D NDC(+$G(PSORXED("IRXN")),0,+PSOY,.NDC) I $G(NDC)="^" S PSORXED("DFLG")=1 Q "RTN","PSODRG",18,0) . I $G(NDC)'="" S (PSODRUG("NDC"),PSORXED("FLD",27))=NDC "RTN","PSODRG",19,0) ; "RTN","PSODRG",20,0) I $G(PSORX("EDIT"))]"",'PSONEW("FIELD") D TRADE "RTN","PSODRG",21,0) G:$G(PSONEW("DFLG"))!($G(PSODRG("QFLG")))!($G(PSORXED("DFLG"))) END "RTN","PSODRG",22,0) D SET ; Set various drug information "RTN","PSODRG",23,0) D NFI ; Display dispense drug/orderable item text "RTN","PSODRG",24,0) D:'$G(PSOEDIT) POST I $G(PSORX("DFLG")) S PSONEW("DFLG")=1 K:'$G(PSORX("EDIT")) PSORX("DFLG") ; Do any post selection action "RTN","PSODRG",25,0) END ;D EOJ "RTN","PSODRG",26,0) Q "RTN","PSODRG",27,0) ;------------------------------------------------------------ "RTN","PSODRG",28,0) ; "RTN","PSODRG",29,0) SELECT ; "RTN","PSODRG",30,0) K:'$G(PSORXED) CLOZPAT "RTN","PSODRG",31,0) K IT,DIC,X,Y,PSODRUG("TRADE NAME"),PSODRUG("NDC"),PSODRUG("DAW"),PSODRUG("BAD") S:$G(POERR)&($P($G(OR0),"^",9)) Y=$P(^PSDRUG($P(OR0,"^",9),0),"^") "RTN","PSODRG",32,0) I $G(PSODRUG("IEN"))]"" S Y=PSODRUG("NAME"),PSONEW("OLD VAL")=PSODRUG("IEN") "RTN","PSODRG",33,0) W !,"DRUG: "_$S($G(Y)]"":Y_"// ",1:"") R X:$S($D(DTIME):DTIME,1:300) I '$T S DTOUT=1 "RTN","PSODRG",34,0) I X="",$G(Y)]"" S:Y X=Y S:'X X=$G(PSODRUG("IEN")) S:X X="`"_X "RTN","PSODRG",35,0) G:X="" SELECT "RTN","PSODRG",36,0) I X?1."?" W !!,"Answer with DRUG NUMBER, or GENERIC NAME, or VA PRODUCT NAME, or",!,"NATIONAL DRUG CLASS, or SYNONYM" G SELECT "RTN","PSODRG",37,0) I $G(PSORXED),X["^" S PSORXED("DFLG")=1 G SELECTX "RTN","PSODRG",38,0) I X="^"!(X["^^")!($D(DTOUT)) S PSONEW("DFLG")=1 G SELECTX "RTN","PSODRG",39,0) I '$G(POERR),X[U,$L(X)>1 S PSODIR("FLD")=PSONEW("FLD") D JUMP^PSODIR1 S:$G(PSODIR("FIELD")) PSONEW("FIELD")=PSODIR("FIELD") K PSODIR S PSODRG("QFLG")=1 G SELECTX "RTN","PSODRG",40,0) S DIC=50,DIC(0)="EMQZVT",DIC("T")="",D="B^C^VAPN^VAC" "RTN","PSODRG",41,0) S DIC("S")="I $S('$D(^PSDRUG(+Y,""I"")):1,'^(""I""):1,DT'>^(""I""):1,1:0),$S($P($G(^PSDRUG(+Y,2)),""^"",3)'[""O"":0,1:1),$D(^PSDRUG(""ASP"",+$G(^(2)),+Y))" "RTN","PSODRG",42,0) D MIX^DIC1 K DIC,D "RTN","PSODRG",43,0) I $D(DTOUT) S PSONEW("DFLG")=1 G SELECTX "RTN","PSODRG",44,0) I $D(DUOUT) K DUOUT G SELECT "RTN","PSODRG",45,0) I Y<0 G SELECT "RTN","PSODRG",46,0) S:$G(PSONEW("OLD VAL"))=+Y&('$G(PSOEDIT)) PSODRG("QFLG")=1 "RTN","PSODRG",47,0) K PSOY S PSOY=Y,PSOY(0)=Y(0) "RTN","PSODRG",48,0) I $P(PSOY(0),"^")="OTHER DRUG"!($P(PSOY(0),"^")="OUTSIDE DRUG") D TRADE "RTN","PSODRG",49,0) SELECTX K X,Y,DTOUT,DUOUT,PSONEW("OLD VAL") "RTN","PSODRG",50,0) Q "RTN","PSODRG",51,0) ; "RTN","PSODRG",52,0) NDC(RX,RFL,DRG,NDC) ; Editing NDC for ECME Released Rx's "RTN","PSODRG",53,0) S NDC=$S($G(NDC)'="":$G(NDC),1:$$GETNDC^PSONDCUT(RX,.RFL)) "RTN","PSODRG",54,0) I $$STATUS^PSOBPSUT(RX,RFL)="" Q "RTN","PSODRG",55,0) I '$$RXRLDT^PSOBPSUT(RX,RFL) Q "RTN","PSODRG",56,0) ; "RTN","PSODRG",57,0) S NDC=$S($G(NDC)'="":$G(NDC),1:$$GETNDC^PSONDCUT(RX,.RFL)) "RTN","PSODRG",58,0) D NDCEDT^PSONDCUT(RX,.RFL,$G(DRG),$G(PSOSITE),.NDC) "RTN","PSODRG",59,0) Q "RTN","PSODRG",60,0) ; "RTN","PSODRG",61,0) TRADE ; "RTN","PSODRG",62,0) K DIR,DIC,DA,X,Y "RTN","PSODRG",63,0) S DIR(0)="52,6.5" S:$G(PSOTRN)]"" DIR("B")=$G(PSOTRN) D ^DIR K DIR,DIC "RTN","PSODRG",64,0) I X="@" S Y=X K DIRUT "RTN","PSODRG",65,0) I $D(DIRUT) S:$D(DUOUT)!$D(DTOUT)&('$D(PSORX("EDIT"))) PSONEW("DFLG")=1 G TRADEX "RTN","PSODRG",66,0) S PSODRUG("TRADE NAME")=Y "RTN","PSODRG",67,0) TRADEX I $G(PSORXED("DFLG")),$D(DIRUT) S PSORXED("DFLG")=1 "RTN","PSODRG",68,0) K DIRUT,DTOUT,DUOUT,X,Y,DA,DR,DIE "RTN","PSODRG",69,0) Q "RTN","PSODRG",70,0) SET ; "RTN","PSODRG",71,0) N STAT S PSODRUG("IEN")=+PSOY,PSODRUG("VA CLASS")=$P(PSOY(0),"^",2) "RTN","PSODRG",72,0) S PSODRUG("NAME")=$P(PSOY(0),"^") "RTN","PSODRG",73,0) S:+$G(^PSDRUG(+PSOY,2)) PSODRUG("OI")=+$G(^(2)),PSODRUG("OIN")=$P(^PS(50.7,+$G(^(2)),0),"^") "RTN","PSODRG",74,0) S PSODRUG("NDF")=$S($G(^PSDRUG(+PSOY,"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:0) "RTN","PSODRG",75,0) S PSODRUG("MAXDOSE")=$P(PSOY(0),"^",4),PSODRUG("DEA")=$P(PSOY(0),"^",3) "RTN","PSODRG",76,0) S PSODRUG("CLN")=$S($D(^PSDRUG(+PSOY,"ND")):+$P(^("ND"),"^",6),1:0) "RTN","PSODRG",77,0) S PSODRUG("SIG")=$P(PSOY(0),"^",5) "RTN","PSODRG",78,0) I $G(PSODRUG("NDC"))="" S PSODRUG("NDC")=$$GETNDC^PSSNDCUT(+PSOY,$G(PSOSITE)) "RTN","PSODRG",79,0) S PSODRUG("DAW")=+$$GET1^DIQ(50,+PSOY,81) "RTN","PSODRG",80,0) S PSODRUG("STKLVL")=$G(^PSDRUG(+PSOY,660.1)) "RTN","PSODRG",81,0) G:$G(^PSDRUG(+PSOY,660))']"" SETX "RTN","PSODRG",82,0) S PSOX1=$G(^PSDRUG(+PSOY,660)) "RTN","PSODRG",83,0) S PSODRUG("COST")=$P($G(PSOX1),"^",6) "RTN","PSODRG",84,0) S PSODRUG("UNIT")=$P($G(PSOX1),"^",8) "RTN","PSODRG",85,0) S PSODRUG("EXPIRATION DATE")=$P($G(PSOX1),"^",9) "RTN","PSODRG",86,0) SETX K PSOX1,PSOY "RTN","PSODRG",87,0) Q "RTN","PSODRG",88,0) NFI ;display restriction/guidelines "RTN","PSODRG",89,0) D EN^PSSDIN(PSODRUG("OI"),PSODRUG("IEN")) S NFI=$$PROMPT^PSSDIN "RTN","PSODRG",90,0) I NFI]"","ODY"[NFI D TD^PSONFI "RTN","PSODRG",91,0) K NFI Q "RTN","PSODRG",92,0) POST ;order checks "RTN","PSODRG",93,0) N LIST S LIST="PSOPEPS" "RTN","PSODRG",94,0) K PSODOSD,^TMP("PSORXDC",$J),^TMP($J,LIST) "RTN","PSODRG",95,0) K ZDGDG,ZTHER,IT,PSODLQT,PSODOSD "RTN","PSODRG",96,0) S ^TMP($J,LIST,"IN","PING")="" D IN^PSSHRQ2(LIST) "RTN","PSODRG",97,0) K DIR I $P(^TMP($J,LIST,"OUT",0),"^")=-1 D DATACK^PSODDPRE "RTN","PSODRG",98,0) K ^TMP($J,LIST,"IN"),^TMP($J,LIST,"OUT","EXCEPTIONS") "RTN","PSODRG",99,0) G:$G(PSORX("DFLG"))!($G(PSORXED("DFLG"))) POSTX "RTN","PSODRG",100,0) K PSORX("INTERVENE") N STAT,SIG,PTR,NDF,VAP S PSORX("DFLG")=0 "RTN","PSODRG",101,0) W !! D HD^PSODDPR2():(($Y+5)'>IOSL) "RTN","PSODRG",102,0) D ^PSOBUILD "RTN","PSODRG",103,0) D @$S($G(COPY):"^PSOCPPRE",1:"^PSODDPRE") ; Duplicate drug check "RTN","PSODRG",104,0) G:$G(PSORX("DFLG")) POSTX "RTN","PSODRG",105,0) D HD^PSODDPR2():(($Y+5)'>IOSL) "RTN","PSODRG",106,0) I $P($G(^PSDRUG(PSODRUG("IEN"),"CLOZ1")),"^")="PSOCLO1" W !,"Now doing Clozapine Order checks. Please wait...",! D CLOZ "RTN","PSODRG",107,0) G:PSORX("DFLG") POSTX "RTN","PSODRG",108,0) D HD^PSODDPR2():(($Y+5)'>IOSL) "RTN","PSODRG",109,0) W !,"Now doing allergy checks. Please wait...",! "RTN","PSODRG",110,0) S PSONOAL="" D ALLERGY^PSOORUT2 D:PSONOAL'="" NOALRGY K PSONOAL "RTN","PSODRG",111,0) D HD^PSODDPR2():(($Y+5)'>IOSL) "RTN","PSODRG",112,0) G:PSORX("DFLG") POSTX "RTN","PSODRG",113,0) D ^PSODGAL1 K PSORX("INTERVENE") "RTN","PSODRG",114,0) ;aminoglycoside "RTN","PSODRG",115,0) N AOC "RTN","PSODRG",116,0) D HD^PSODDPR2():(($Y+5)'>IOSL) "RTN","PSODRG",117,0) S AOC=$$AOC^OROCAPI(PSODFN,$P(PSODRUG("NDF"),"A",2)) I $P(AOC,"^",4)]"" D "RTN","PSODRG",118,0) .W !!,"***Aminoglycoside Ordered***",!! "RTN","PSODRG",119,0) .K ^UTILITY($J,"W") S DIWL=1,DIWR=78,DIWF="" S X=$P(AOC,"^",4) D ^DIWP "RTN","PSODRG",120,0) .W !! F ZX=0:0 S ZX=$O(^UTILITY($J,"W",1,ZX)) Q:'ZX W ?2,^UTILITY($J,"W",1,ZX,0),! D HD^PSODDPR2():(($Y+5)'>IOSL) "RTN","PSODRG",121,0) .K ^UTILITY($J,"W") "RTN","PSODRG",122,0) D HD^PSODDPR2():(($Y+5)'>IOSL) "RTN","PSODRG",123,0) ;dangerous meds for pat >64 "RTN","PSODRG",124,0) I $G(PSODRUG("OI")) D "RTN","PSODRG",125,0) .N OI,OIR S OI=$$OITM^ORX8(PSODRUG("OI"),"99PSP") Q:'OI "RTN","PSODRG",126,0) .S OIR=$$DOC^OROCAPI(PSODFN,OI) I $P(OIR,"^",4)]"" D "RTN","PSODRG",127,0) ..D HD^PSODDPR2():(($Y+5)'>IOSL) W !!,"***Dangerous Meds for Patient >64***",!! S DFN=PSODFN D DEM^VADPT "RTN","PSODRG",128,0) ..K ^UTILITY($J,"W") S DIWL=1,DIWR=78,DIWF="" S X=$P(OIR,"^",4) D ^DIWP "RTN","PSODRG",129,0) ..F ZX=0:0 S ZX=$O(^UTILITY($J,"W",1,ZX)) Q:'ZX W ?2,^UTILITY($J,"W",1,ZX,0),! D HD^PSODDPR2():(($Y+5)'>IOSL) "RTN","PSODRG",130,0) ..K ^UTILITY($J,"W") "RTN","PSODRG",131,0) D HD^PSODDPR2():(($Y+5)'>IOSL) "RTN","PSODRG",132,0) ;metformin lab results "RTN","PSODRG",133,0) N GOC S GOC=$$GOC^OROCAPI(PSODFN,PSODRUG("NAME")) I $P(GOC,"^",4)]"" D "RTN","PSODRG",134,0) .W !!,"***Metformin Lab Results***",!! "RTN","PSODRG",135,0) .K ^UTILITY($J,"W") S DIWL=1,DIWR=78,DIWF="" S X=$P(GOC,"^",4) D ^DIWP "RTN","PSODRG",136,0) .F ZX=0:0 S ZX=$O(^UTILITY($J,"W",1,ZX)) Q:'ZX W ?2,^UTILITY($J,"W",1,ZX,0),! D HD^PSODDPR2():(($Y+5)'>IOSL) "RTN","PSODRG",137,0) .K ^UTILITY($J,"W") "RTN","PSODRG",138,0) D HD^PSODDPR2():(($Y+5)'>IOSL) "RTN","PSODRG",139,0) K DIWF,DIWL,DIWR,ZX,DFN "RTN","PSODRG",140,0) I $G(PSODRUG("DEA"))["S"!($E($G(PSODRUG("VA CLASS")),1,2)="XA") D G POSTX ;stops if drug is supply "RTN","PSODRG",141,0) .W !,"Now Processing Enhanced Order Checks! Please wait...",! H 1 "RTN","PSODRG",142,0) ;enhanced OC "RTN","PSODRG",143,0) D HD^PSODDPR2():(($Y+5)'>IOSL) "RTN","PSODRG",144,0) W ! D @$S($G(COPY):"OBX^PSOCPPRE",1:"OBX^PSODDPRE") ; Set PSORX("DFLG")=1 if process to stop new enhanced order checks "RTN","PSODRG",145,0) POSTX ; "RTN","PSODRG",146,0) K IT,^TMP($J,"DI"),PSORX("INTERVENE"),DA,^TMP($J,"PSODRDI"),ZDGDG,ZTHER K ^TMP($J,"DI"_PSODFN),PSZZQUIT "RTN","PSODRG",147,0) Q "RTN","PSODRG",148,0) ; "RTN","PSODRG",149,0) EOJ ; "RTN","PSODRG",150,0) K PSODRG "RTN","PSODRG",151,0) Q "RTN","PSODRG",152,0) WAIT ; "RTN","PSODRG",153,0) K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to continue..." W ! "RTN","PSODRG",154,0) D ^DIR K DIRUT,DUOUT,DIR,X,Y "RTN","PSODRG",155,0) Q "RTN","PSODRG",156,0) ; "RTN","PSODRG",157,0) CLOZ ; "RTN","PSODRG",158,0) S ANQRTN=$P(^PSDRUG(PSODRUG("IEN"),"CLOZ1"),"^"),ANQX=0 "RTN","PSODRG",159,0) S P(5)=PSODRUG("IEN"),DFN=PSODFN,X=ANQRTN "RTN","PSODRG",160,0) X ^%ZOSF("TEST") I D @("^"_ANQRTN) S:$G(ANQX) PSORX("DFLG")=1 "RTN","PSODRG",161,0) K P(5),ANQRTN,ANQX,X,DFN "RTN","PSODRG",162,0) Q "RTN","PSODRG",163,0) ; "RTN","PSODRG",164,0) EN(DRG) ;returns lab test identified for clozapine order checking "RTN","PSODRG",165,0) K LAB I $P($G(^PSDRUG(DRG,"CLOZ1")),"^")'="PSOCLO1" S LAB("NOT")=0 Q "RTN","PSODRG",166,0) I $P($G(^PSDRUG(DRG,"CLOZ1")),"^")="PSOCLO1" D "RTN","PSODRG",167,0) .S (CNT,I)=0 F S I=$O(^PSDRUG(DRG,"CLOZ2",I)) Q:'I S CNT=$G(CNT)+1 "RTN","PSODRG",168,0) .I CNT'=2 S LAB("BAD TEST")=0 K CNT Q "RTN","PSODRG",169,0) .K CNT F I=0:0 S I=$O(^PSDRUG(DRG,"CLOZ2",I)) Q:'I D "RTN","PSODRG",170,0) ..S LABT=$S($P(^PSDRUG(DRG,"CLOZ2",I,0),"^",4)=1:"WBC",1:"ANC"),LAB(LABT)=$P(^PSDRUG(DRG,"CLOZ2",I,0),"^")_"^"_$P(^(0),"^",3)_"^"_$P(^(0),"^",4) "RTN","PSODRG",171,0) K LABT,I "RTN","PSODRG",172,0) Q "RTN","PSODRG",173,0) NOALRGY ; "RTN","PSODRG",174,0) D HD^PSODDPR2():(($Y+5)'>IOSL) "RTN","PSODRG",175,0) N DIR S DIR(0)="SA^1:YES;0:NO" "RTN","PSODRG",176,0) I $D(^TMP($J,"PSOINTERVENE",+PSODFN)) D Q "RTN","PSODRG",177,0) .S DIR("A")="No Allergy Assessment - Do you want to duplicate Intervention?: ",DIR("B")="Yes" "RTN","PSODRG",178,0) .D ^DIR "RTN","PSODRG",179,0) .I 'Y D Q "RTN","PSODRG",180,0) ..I Y=0 D ^PSORXI Q "RTN","PSODRG",181,0) ..S PSORX("DFLG")=1 "RTN","PSODRG",182,0) .D DUPINV^PSORXI "RTN","PSODRG",183,0) W $C(7),!,"There is no allergy assessment on file for this patient." "RTN","PSODRG",184,0) W !,"You will be prompted to intervene if you continue with this prescription" "RTN","PSODRG",185,0) S DIR("A")="Do you want to Continue?: ",DIR("B")="N" D ^DIR "RTN","PSODRG",186,0) I 'Y D Q "RTN","PSODRG",187,0) .I $D(PSONV) S PSZZQUIT=1 Q "RTN","PSODRG",188,0) .S PSORX("DFLG")=1 "RTN","PSODRG",189,0) I $D(PSONV) S PSORX("INTERVENE")=0 D EN1^PSORXI(PSONV) Q "RTN","PSODRG",190,0) D ^PSORXI "RTN","PSODRG",191,0) Q "RTN","PSOHLNEW") 0^14^B85696343^B83284791 "RTN","PSOHLNEW",1,0) PSOHLNEW ;BIR/RTR - CPRS orders ;11/30/06 11:49am "RTN","PSOHLNEW",2,0) ;;7.0;OUTPATIENT PHARMACY;**1,7,15,46,71,98,111,124,117,131,146,132,143,223,235,148,239,249,225,324,251,387**;DEC 1997;Build 13 "RTN","PSOHLNEW",3,0) ;40.8-728,50-221,SC-2675,100-2219,50.7-2223,EN^ORERR-2187 "RTN","PSOHLNEW",4,0) ;External reference to ^DG(40.8 supported by DBIA 728 "RTN","PSOHLNEW",5,0) ;External reference to ^OR(100 supported by DBIA 3582 "RTN","PSOHLNEW",6,0) ;External reference to ^SC( supported by DBIA 2675 "RTN","PSOHLNEW",7,0) ;External reference to ^PSDRUG( supported by DBIA 2675 "RTN","PSOHLNEW",8,0) EN(MSG) ; "RTN","PSOHLNEW",9,0) N PSODDRUG,ENTERED,LOCATION,PLACER,PSOOC,ROUTE,NATURE,PREV,ROUTING,OO,OR,STAT,ZZ,DFN,COMM,QCOUNT,OCOUNT,Q1I,QTARRAY,QTARRAY2,EE,PP,XOFLAG,PSODYSPL,PSOFILNM "RTN","PSOHLNEW",10,0) N ONEFLAG,SERV,WPCT,EFFECT,PROV,PENDING,RRX,PSOLQ1I,PSOLQ1II,PSOQWX,PSOLQ1IX,PSONVA,PSOICD,PSOSCP,EEE "RTN","PSOHLNEW",11,0) N OBXAR,AA,II,SIG1,FILLER,COMM,GG,FF,JJ,JJJ,CT,LIM,VAR,VAR1,QQQ,PSRNFLAG,PSRNQFLG,RCOMM,XOFLAGZ,NWFLAG,PFLAG,PSINPTR,INPTRX,PSOIBN,PSOIBY "RTN","PSOHLNEW",12,0) N DSIG,PSOCHFFL,PSOCVI,PSOMO,PSOXRP,NN,LL,LLL,WPARRAY,QTVAR,POVAR,POVAR1,ORCSEG,NNN,OOO,AAA,NNNN,POLIM,NNCK,PRIOR,IPPLACER,PLACERXX,EER,PSERRPID,PSERRPV1,PSERRORC,PSOEXFLG,PSOMSORR,PDFN,VAL "RTN","PSOHLNEW",13,0) S (SEND,PSOSND,OCOUNT)=0 K PSOPLC,PSOFFL,PSORSO,PSOSUSZ "RTN","PSOHLNEW",14,0) F OO=0:0 S OO=$O(MSG(OO)) Q:'OO!(SEND)!(PSOSND) D:$P(MSG(OO),"|")="PID" SPDFN I $P(MSG(OO),"|")="ORC",$P(MSG(OO),"|",2)'="NW",$P(MSG(OO),"|",2)'="XO" D "RTN","PSOHLNEW",15,0) .S OR("STAT")=$P(MSG(OO),"|",2),OR("PLACE")=+$P(MSG(OO),"|",3),PLACERXX=+$P($P(MSG(OO),"|",3),";",2),OR("COMM")=$P(MSG(OO),"|",17),OR("USER")=$P(MSG(OO),"|",11) I $P(MSG(OO),"|",2)'="DE",$P(MSG(OO),"|",2)'="NA" S SEND=1 D FILL Q "RTN","PSOHLNEW",16,0) .S PSOPLC=+$P(MSG(OO),"|",3),PSOFFL=+$P(MSG(OO),"|",4),PSOSND=1,PSOCHFFL=$P($P(MSG(OO),"|",4),"^") "RTN","PSOHLNEW",17,0) I $G(OR("COMM"))["^" S OR("COMM")=$P(OR("COMM"),"^",5) "RTN","PSOHLNEW",18,0) I PSOSND,$G(PSOCHFFL)["S",$G(OR("STAT"))="NA" D CHCS^PSOHLNE1 Q "RTN","PSOHLNEW",19,0) I PSOSND,'$D(^PSRX(+$G(PSOFFL),0)) S COMM="Order was not located by Pharmacy" D EN^ORERR(COMM,.MSG) D KL Q "RTN","PSOHLNEW",20,0) I PSOSND,$G(PDFN),PDFN'=+$P($G(^PSRX(+$G(PSOFFL),0)),"^",2) S COMM="Patient does not match" D EN^ORERR(COMM,.MSG) D KL Q "RTN","PSOHLNEW",21,0) I PSOSND,$G(OR("STAT"))'="DE" N PSONAS S PSONAS=$S($P($G(^PSRX(PSOFFL,"OR1")),"^",2)="":1,1:0) S $P(^PSRX(PSOFFL,"OR1"),"^",2)=PSOPLC,^PSRX("APL",PSOPLC,PSOFFL)="" D:PSONAS EN^PSOHDR("PRES",PSOFFL) D KL Q "RTN","PSOHLNEW",22,0) D KL "RTN","PSOHLNEW",23,0) I SEND,$G(OR("STAT"))="Z@" G PURGE^PSOHLNE2 "RTN","PSOHLNEW",24,0) I SEND,$G(OR("STAT"))="ZF" G REF^PSOHLNE2 "RTN","PSOHLNEW",25,0) I SEND,$G(OR("STAT"))'="CA",$G(OR("STAT"))'="DC",$G(OR("STAT"))'="HD",$G(OR("STAT"))'="RL",$G(OR("STAT"))'="SS" S RCOMM="Invalid Order Control Code" D EN^ORERR(RCOMM,.MSG) Q "RTN","PSOHLNEW",26,0) I SEND K SEND G:$G(OR("STAT"))="SS" ESTAT D EN^PSOORUTL(.OR) S PLACER=OR("PLACE"),STAT=OR("STAT"),COMM=OR("COMM") S PSOMSORR=1 D K PSOMSORR Q "RTN","PSOHLNEW",27,0) .I $G(OR("FILLER"))="" D D ERROR^PSOHLSN Q "RTN","PSOHLNEW",28,0) ..F EER=0:0 S EER=$O(MSG(EER)) Q:'EER S:$P(MSG(EER),"|")="PV1" PSERRPV1=MSG(EER) S:$P(MSG(EER),"|")="PID" PSERRPID=MSG(EER) S:$P(MSG(EER),"|")="ORC"&($G(PSERRORC)="") PSERRORC=MSG(EER) "RTN","PSOHLNEW",29,0) .I $P(OR("FILLER"),"^",2)="R" S FILLER=$P(OR("FILLER"),"^") D EN^PSOHLSN1(FILLER,STAT,$G(OR("PHARMST")),COMM) K:$G(PSOEXFLG) PSOMSORR,PLACERXX D:$G(PSOEXFLG) EN^PSOHLSN1(FILLER,"SC","ZE","") D:$G(PSOSUSZ) SUS^PSOORUT1 K PSOSUSZ Q "RTN","PSOHLNEW",30,0) .D EN^PSOHLSN(PLACER,STAT,COMM) Q "RTN","PSOHLNEW",31,0) D KL^PSOHLSIH S RRX=1 F ZZ=0:0 S ZZ=$O(MSG(ZZ)) Q:'ZZ S PSOSEG=$G(MSG(ZZ)),PSOTYPE=$P(PSOSEG,"|") S PSOSEG=$E(PSOSEG,5,$L(PSOSEG)) I PSOTYPE'="NTE" D @PSOTYPE "RTN","PSOHLNEW",32,0) I $G(PSRNFLAG) S PSOMO=0 D MISRN^PSOHLNE1 I $G(PSOMO) Q "RTN","PSOHLNEW",33,0) S PSRNQFLG=0 I $G(PSRNFLAG),$G(PREV) D I $G(PSRNQFLG) S RCOMM="Duplicate Renewal Request. Order rejected by Pharmacy." D EN^ORERR(RCOMM,.MSG) D RERROR^PSOHLSN D KL^PSOHLSIH Q "RTN","PSOHLNEW",34,0) .I $P($G(^PSRX(PREV,"OR1")),"^",4) S PSRNQFLG=1 Q "RTN","PSOHLNEW",35,0) .I $O(^PS(52.41,"AQ",PREV,0)) S PSRNQFLG=1 "RTN","PSOHLNEW",36,0) .I $G(XOFLAG),$G(DFN)'=$S($G(PFLAG):$P($G(^PS(52.41,+$G(PREV),0)),"^",2),1:$P($G(^PSRX(+$G(PREV),0)),"^",2)) S RCOMM="Patient mismatch on previous order." D EN^ORERR(RCOMM,.MSG) S XOFLAGZ=1 D RERROR^PSOHLSN D KL^PSOHLSIH Q "RTN","PSOHLNEW",37,0) I $G(PLACER) I $G(DFN)'=+$P($G(^OR(100,+PLACER,0)),"^",2) G MISX^PSOHLNE1 "RTN","PSOHLNEW",38,0) I $G(PLACER) D NFILE "RTN","PSOHLNEW",39,0) D KL^PSOHLSIH "RTN","PSOHLNEW",40,0) Q "RTN","PSOHLNEW",41,0) ESTAT ; "RTN","PSOHLNEW",42,0) D EXP^PSOHLNE1 "RTN","PSOHLNEW",43,0) Q "RTN","PSOHLNEW",44,0) MSH Q "RTN","PSOHLNEW",45,0) PID S DFN=+$P(PSOSEG,"|",3) "RTN","PSOHLNEW",46,0) Q "RTN","PSOHLNEW",47,0) PV1 S LOCATION=+$P(+$P(PSOSEG,"|",3),"^") "RTN","PSOHLNEW",48,0) S:'$D(^SC(LOCATION,0)) LOCATION="" "RTN","PSOHLNEW",49,0) S INPTRX=0 I $G(LOCATION) S PSINPTR=$P($G(^SC(LOCATION,0)),"^",4) I PSINPTR Q "RTN","PSOHLNEW",50,0) I $G(LOCATION) S INPTRX=$P($G(^SC(LOCATION,0)),"^",15) "RTN","PSOHLNEW",51,0) I '$G(INPTRX) S INPTRX=$O(^DG(40.8,0)) "RTN","PSOHLNEW",52,0) I '$G(DT) S DT=$$DT^XLFDT "RTN","PSOHLNEW",53,0) S PSINPTR=+$$SITE^VASITE(DT,INPTRX) "RTN","PSOHLNEW",54,0) Q "RTN","PSOHLNEW",55,0) OBR ;This segment is used to pass flagging information from CPRS. "RTN","PSOHLNEW",56,0) D OBR^PSOHLNE4 "RTN","PSOHLNEW",57,0) Q "RTN","PSOHLNEW",58,0) DG1 S $P(PSOICD($P(PSOSEG,"|",1)),"^")=$P($P(PSOSEG,"|",3),"^") "RTN","PSOHLNEW",59,0) Q "RTN","PSOHLNEW",60,0) ORC ; "RTN","PSOHLNEW",61,0) Q:$P(PSOSEG,"|")="DE" "RTN","PSOHLNEW",62,0) S:$P(PSOSEG,"|")="XO" XOFLAG=1 D ^PSOHLNE1 S:$G(PRIOR)="A" PRIOR="E" S:$G(PRIOR)="" PRIOR="R" "RTN","PSOHLNEW",63,0) Q "RTN","PSOHLNEW",64,0) ; "RTN","PSOHLNEW",65,0) RXO I $O(MSG(ZZ,0)) D ^PSOHLNE2 G RXOPS "RTN","PSOHLNEW",66,0) S PSORDITE=$P($P(PSOSEG,"|"),"^",4) "RTN","PSOHLNEW",67,0) S PSODDRUG=$P($P(PSOSEG,"|",10),"^",4) I $G(PSODDRUG) S:'$D(^PSDRUG(PSODDRUG,0)) PSODDRUG="" "RTN","PSOHLNEW",68,0) I '$P($P(PSOSEG,"|",10),"^",4) N PSI,PSDC S (PSDC,PSI)=0 D "RTN","PSOHLNEW",69,0) .F S PSI=$O(^PSDRUG("ASP",PSORDITE,PSI)) Q:'PSI I $S('$D(^PSDRUG(PSI,"I")):1,'^("I"):1,DT'>^("I"):1,1:0),$S($P($G(^PSDRUG(PSI,2)),"^",3)'["O":0,1:1) S PSDC=PSDC+1,PSDC(PSDC)=PSI "RTN","PSOHLNEW",70,0) .I PSDC=1 S PSODDRUG=PSDC(1) "RTN","PSOHLNEW",71,0) S PSOXQTY=$P(PSOSEG,"|",11) "RTN","PSOHLNEW",72,0) S PSOREFIL=$P(PSOSEG,"|",13) "RTN","PSOHLNEW",73,0) S PSODYSPL=$P(PSOSEG,"|",17) "RTN","PSOHLNEW",74,0) RXOPS S ONEFLAG=0,WPCT=1,LL=ZZ+1 "RTN","PSOHLNEW",75,0) I $P($G(MSG(LL)),"|")="NTE" D "RTN","PSOHLNEW",76,0) .S ONEFLAG=1,WORDP=$S($P(MSG(LL),"|",2):$P(MSG(LL),"|",2),1:$P(MSG(LL),"|",3)) S:$P(MSG(LL),"|",4)'="" WPARRAY(WORDP,WPCT)=$P(MSG(LL),"|",4) S:$P(MSG(LL),"|",4)'="" WPCT=WPCT+1 F LLL=0:0 S LLL=$O(MSG(LL,LLL)) Q:'LLL D "RTN","PSOHLNEW",77,0) ..I $G(MSG(LL,LLL))'="" S WPARRAY(WORDP,WPCT)=$G(MSG(LL,LLL)),WPCT=WPCT+1 "RTN","PSOHLNEW",78,0) I ONEFLAG S LL=LL+1 I $P($G(MSG(LL)),"|")="NTE" D NTE^PSOHLNE1 "RTN","PSOHLNEW",79,0) K WORDP "RTN","PSOHLNEW",80,0) Q "RTN","PSOHLNEW",81,0) RXR I $P($P(PSOSEG,"|"),"^",4) S ROUTE(RRX)=$P($P(PSOSEG,"|"),"^",4) S RRX=RRX+1 "RTN","PSOHLNEW",82,0) Q "RTN","PSOHLNEW",83,0) OBX I $O(MSG(ZZ,0)) D OBXX^PSOHLNE2 G OBXNTE "RTN","PSOHLNEW",84,0) S OCOUNT=OCOUNT+1 "RTN","PSOHLNEW",85,0) S OBXAR(OCOUNT,1)=$P(PSOSEG,"|",5) "RTN","PSOHLNEW",86,0) OBXNTE ; "RTN","PSOHLNEW",87,0) D OBXNTE^PSOHLNE3 "RTN","PSOHLNEW",88,0) Q "RTN","PSOHLNEW",89,0) ZRN S PSODSC=1_"^"_$P(PSOSEG,"|",2) "RTN","PSOHLNEW",90,0) I $O(MSG(ZZ,0)) F T=0:0 S T=$O(MSG(ZZ,T)) Q:'T S PSODSC(T)=MSG(ZZ,T) "RTN","PSOHLNEW",91,0) K T "RTN","PSOHLNEW",92,0) Q "RTN","PSOHLNEW",93,0) ; "RTN","PSOHLNEW",94,0) ZRX D ZRX^PSOHLNE1 "RTN","PSOHLNEW",95,0) Q "RTN","PSOHLNEW",96,0) ; "RTN","PSOHLNEW",97,0) ZCL D ZCL^PSOHLNE1 "RTN","PSOHLNEW",98,0) Q "RTN","PSOHLNEW",99,0) ZSC D CP^PSOHLNE1 "RTN","PSOHLNEW",100,0) Q "RTN","PSOHLNEW",101,0) NFILE ; "RTN","PSOHLNEW",102,0) I $G(PSODSC) D ^PSONVNEW Q ;adds non-va med to #55 "RTN","PSOHLNEW",103,0) ; "RTN","PSOHLNEW",104,0) K DD,DO,DIC S DLAYGO="52.41",DIC="^PS(52.41,",DIC(0)="L",X=PLACER,DIC("DR")="1////"_DFN_";2////"_PSOOC_";6////"_$G(EFFECT)_";12////"_$G(PSOXQTY)_";25////"_$G(PRIOR) "RTN","PSOHLNEW",105,0) S DIC("DR")=DIC("DR")_";22////"_$G(PSORSO)_";22.1////"_$G(PREV)_";19////"_$G(ROUTING)_";17////"_$$UNESC^ORHLESC($G(SERV))_";7////"_$G(NATURE)_";13////"_$G(PSOREFIL)_";1.1////"_$G(LOCATION)_";117////"_$G(DSIG) "RTN","PSOHLNEW",106,0) D FILE^DICN K DIC,DR I Y<0 Q "RTN","PSOHLNEW",107,0) S PENDING=+Y "RTN","PSOHLNEW",108,0) S $P(^PS(52.41,PENDING,0),"^",4)=$S($G(ENTERED):+$G(ENTERED),1:""),$P(^(0),"^",5)=$S($G(PROV):+$G(PROV),1:""),$P(^(0),"^",8)=$S($G(PSORDITE):+$G(PSORDITE),1:""),$P(^(0),"^",9)=$S($G(PSODDRUG):+$G(PSODDRUG),1:""),$P(^(0),"^",15)=$G(ROUTE) "RTN","PSOHLNEW",109,0) S ^PS(52.41,PENDING,"IBQ")=$G(PSOIBY) "RTN","PSOHLNEW",110,0) I $G(PSODYSPL)'="",$E(PSODYSPL)?1A S PSODYSPL=$E(PSODYSPL,2,$L(PSODYSPL)) "RTN","PSOHLNEW",111,0) S $P(^PS(52.41,PENDING,"INI"),"^")=$G(PSINPTR),$P(^(0),"^",12)=$G(PSOLOG),$P(^(0),"^",22)=$G(PSODYSPL) "RTN","PSOHLNEW",112,0) I $G(QCOUNT) S ^PS(52.41,PENDING,1,0)="^52.413^"_QCOUNT_"^"_QCOUNT "RTN","PSOHLNEW",113,0) S PSOQWX=$G(PSODDRUG) D:'$G(PSOQWX) OID^PSOHLNE1 "RTN","PSOHLNEW",114,0) F PP=0:0 S PP=$O(Q1I(PP)) Q:'PP S VAL=$S($G(PSOQWX)&($G(PSOLQ1II(PP))):Q1I(PP),$G(PSOQWX)&($G(PSOLQ1IX(PP))'="")&('$G(PSOLQ1II(PP))):PSOLQ1IX(PP),1:PSOLQ1I(PP)) S ^PS(52.41,PENDING,1,PP,0)=$$UNESC^ORHLESC(VAL) "RTN","PSOHLNEW",115,0) F EE=0:0 S EE=$O(QTARRAY(EE)) Q:'EE S ^PS(52.41,PENDING,1,EE,1)=$$UNESC^ORHLESC(QTARRAY(EE)) S VAL=$S($G(PSOQWX)&($G(PSOLQ1II(EE))):$G(QTARRAY2(EE)),$G(PSOQWX)&($G(PSOLQ1IX(EE))'="")&('$G(PSOLQ1II(EE))):PSOLQ1IX(EE),1:$G(PSOLQ1I(EE))) D "RTN","PSOHLNEW",116,0) .S ^PS(52.41,PENDING,1,EE,2)=$$UNESC^ORHLESC(VAL) S $P(^PS(52.41,PENDING,1,EE,1),"^",8)=+$G(ROUTE(EE)) "RTN","PSOHLNEW",117,0) S:$P($G(^PS(52.41,PENDING,1,1,1)),"^",3) $P(^PS(52.41,PENDING,0),"^",18)=$E($P($G(^PS(52.41,PENDING,1,1,1)),"^",3),1,7) "RTN","PSOHLNEW",118,0) D STUFF^PSOHLNE2 "RTN","PSOHLNEW",119,0) D ^PSOHLPII "RTN","PSOHLNEW",120,0) S LL=0 I $O(WPARRAY(6,0)) F LLL=0:0 S LLL=$O(WPARRAY(6,LLL)) Q:'LLL S LL=LL+1 S ^PS(52.41,PENDING,3,LL,0)=$$UNESC^ORHLESC($G(WPARRAY(6,LLL))) "RTN","PSOHLNEW",121,0) I LL S ^PS(52.41,PENDING,3,0)="^52.42^"_LL_"^"_LL "RTN","PSOHLNEW",122,0) S LL=0 I $O(WPARRAY(7,0)) F LLL=0:0 S LLL=$O(WPARRAY(7,LLL)) Q:'LLL S LL=LL+1 S ^PS(52.41,PENDING,"INS1",LL,0)=$$UNESC^ORHLESC($G(WPARRAY(7,LLL))) "RTN","PSOHLNEW",123,0) I LL S ^PS(52.41,PENDING,"INS1",0)="^^"_LL_"^"_LL_"^"_$G(DT)_"^" "RTN","PSOHLNEW",124,0) I $P($G(^PS(50.7,+$G(PSORDITE),"INS")),"^")'="" S $P(^PS(52.41,PENDING,"INS"),"^",2)=$S($O(^PS(52.41,PENDING,"INS1",0)):1,1:0) "RTN","PSOHLNEW",125,0) I $G(OCOUNT) S ^PS(52.41,PENDING,"OBX",0)="^52.4118A^"_OCOUNT_"^"_OCOUNT F OCOUNT=1:1:OCOUNT D "RTN","PSOHLNEW",126,0) .S ^PS(52.41,PENDING,"OBX",OCOUNT,0)=$$UNESC^ORHLESC($G(OBXAR(OCOUNT,1))) "RTN","PSOHLNEW",127,0) .D USER^PSOORFI2(+$G(PROV)) S ^PS(52.41,PENDING,"OBX",OCOUNT,1)=$$UNESC^ORHLESC(USER1) K USER1 "RTN","PSOHLNEW",128,0) .S PSOBCT=1 F LLL=2:1 Q:'$D(OBXAR(OCOUNT,LLL)) S ^PS(52.41,PENDING,"OBX",OCOUNT,2,PSOBCT,0)=$$UNESC^ORHLESC(OBXAR(OCOUNT,LLL)),^PS(52.41,PENDING,"OBX",OCOUNT,2,0)="^^"_PSOBCT_"^"_PSOBCT_"^"_$G(DT)_"^" "RTN","PSOHLNEW",129,0) D ^PSOHLPIS "RTN","PSOHLNEW",130,0) K DIK S DIK="^PS(52.41,",DA=PENDING D IX^DIK "RTN","PSOHLNEW",131,0) I $G(PSOOC)="RNW",$G(PREV),$D(^PSRX(+$G(PREV),0)) D EN^PSOHLSN1(PREV,"SC","ZZ","") "RTN","PSOHLNEW",132,0) S PSOMSORR=1,IPPLACER=$P($G(^PS(52.41,PENDING,0)),"^") I IPPLACER D "RTN","PSOHLNEW",133,0) .I '$G(XOFLAG) D EN^PSOHLSN(IPPLACER,"OK","IP") Q "RTN","PSOHLNEW",134,0) .D EN^PSOHLSN(IPPLACER,"XR","IP") I $G(PFLAG) D DCP^PSOHLSN Q "RTN","PSOHLNEW",135,0) .K PSOMSORR I $D(^PSRX(+$G(PREV),0)) D D EN^PSOHLSN1(PREV,"RP","","","A") "RTN","PSOHLNEW",136,0) ..S $P(^PSRX(PREV,"STA"),"^")=15,$P(^(3),"^",5)=DT,$P(^(3),"^",10)=$P(^(3),"^"),$P(^(7),"^")=2 "RTN","PSOHLNEW",137,0) ..D CHKCMOP^PSOUTL(PREV) "RTN","PSOHLNEW",138,0) ..D REVERSE^PSOBPSU1(PREV,,"DC",7),CAN^PSOTPCAN(PREV),CAN^PSOUTL(PREV) "RTN","PSOHLNEW",139,0) ..D CNT^PSOHLNE1 "RTN","PSOHLNEW",140,0) ..D:$G(^PS(52.41,PENDING,1,1,0))=""&($P($G(^PS(52.41,PENDING,1,1,1)),"^")="")&($G(^PS(52.41,PENDING,"SIG",1,0))="") "RTN","PSOHLNEW",141,0) ...N FSIG,BSIG "RTN","PSOHLNEW",142,0) ...I '$P($G(^PSRX(PREV,"SIG")),"^",2),$P($G(^("SIG")),"^")'="" D "RTN","PSOHLNEW",143,0) ....D EN3^PSOUTLA1(PREV,70) "RTN","PSOHLNEW",144,0) ....I $G(BSIG(1))'="" S ^PS(52.41,PENDING,"SIG",1,0)=$$UNESC^ORHLESC($G(BSIG(1))) I $O(BSIG(1)) F EE=1:0 S EE=$O(BSIG(EE)) Q:'EE S ^PS(52.41,PENDING,"SIG",EE,0)=$$UNESC^ORHLESC($G(BSIG(EE))) "RTN","PSOHLNEW",145,0) ...I $P($G(^PSRX(PREV,"SIG")),"^",2),$G(^PSRX(PREV,"SIG1",1,0))'="" D "RTN","PSOHLNEW",146,0) ....D FSIG^PSOUTLA("R",PREV,70) "RTN","PSOHLNEW",147,0) ....I $G(FSIG(1))'="" S ^PS(52.41,PENDING,"SIG",1,0)=$$UNESC^ORHLESC($G(FSIG(1))) I $O(FSIG(1)) F EE=1:0 S EE=$O(FSIG(EE)) Q:'EE S ^PS(52.41,PENDING,"SIG",EE,0)=$$UNESC^ORHLESC($G(FSIG(EE))) "RTN","PSOHLNEW",148,0) ...F EE=0:0 S EE=$O(^PS(52.41,PENDING,"SIG",EE)) Q:'EE S ^PS(52.41,PENDING,"SIG",0)="^52.4124A^"_EE_"^"_EE "RTN","PSOHLNEW",149,0) D CSET^PSODIAG "RTN","PSOHLNEW",150,0) Q "RTN","PSOHLNEW",151,0) SPDFN S PDFN=$P($G(MSG(OO)),"|",4) Q "RTN","PSOHLNEW",152,0) KL K PSOPLC,PSOFFL,PSOSND "RTN","PSOHLNEW",153,0) Q "RTN","PSOHLNEW",154,0) FILL ; "RTN","PSOHLNEW",155,0) S (PSOFILNM,OR("PSOFILNM"))=$P($P(MSG(OO),"|",4),"^") "RTN","PSOHLNEW",156,0) Q "RTN","PSOLBL") 0^15^B74655660^B65338340 "RTN","PSOLBL",1,0) PSOLBL ;BIR/SAB/RTR - BOTTLE LABEL ;11/20/08 12:14pm "RTN","PSOLBL",2,0) ;;7.0;OUTPATIENT PHARMACY;**8,19,30,36,47,71,92,120,157,244,206,225,303,266,326,251,387**;DEC 1997;Build 13 "RTN","PSOLBL",3,0) ;DBIAs PSDRUG-221, PS(55-2228, IBARX-125, PSXSRP-2201, %ZIS-3435, DPT-3097 "RTN","PSOLBL",4,0) ;External reference to $$DS^PSSDSAPI supported by DBIA 5425 "RTN","PSOLBL",5,0) ;External reference to ^DIC(5 supported by DBIA 4293 "RTN","PSOLBL",6,0) ;External reference to ^SC( supported by DBIA 2675 "RTN","PSOLBL",7,0) ;External reference to XTYPE^IBARX supported by DBIA 125 "RTN","PSOLBL",8,0) ;External reference to %ZIS(2 supported by DBIA 812 "RTN","PSOLBL",9,0) ; "RTN","PSOLBL",10,0) ;*244 rem test for part fill when testing status > 11 "RTN","PSOLBL",11,0) ; "RTN","PSOLBL",12,0) DQ I $D(PSOIOS),PSOIOS]"" D DEVBAR^PSOBMST "RTN","PSOLBL",13,0) I $G(PSOBAR0)]"",$G(PSOBAR1)]"",$D(^PS(59,PSOSITE,1)) S PSOBARS=1 "RTN","PSOLBL",14,0) DQ1 D ^PSOLBL4 "RTN","PSOLBL",15,0) I $G(IOST(0)),$D(^%ZIS(2,IOST(0),55,"B","LL")) G ^PSOLLLI "RTN","PSOLBL",16,0) G:'$D(PPL) HLEX G:($P($G(PSOPAR),"^",30)=2)&('$G(PSOEXREP)) HLEX K RXFLX S PSOCKHN=","_$G(PPL) S PSRESOLV=+PPL D CHECK F PI=1:1 D S RX=$P(PPL,",",PI) D C Q:$G(PSOLAPPL) D:$G(PSDFNFLG) TRAIL^PSOLBL2 K RXP,REPRINT "RTN","PSOLBL",17,0) .S (PSDFNFLG,PSOLAPPL)=0 S NEXTRX=$P(PPL,",",(PI+1)) I NEXTRX=""!(NEXTRX=",") S PSOLAPPL=1 Q "RTN","PSOLBL",18,0) .I PSOPDFN'=$P(^PSRX(NEXTRX,0),"^",2) S PSDFNFLG=1,PSOPDFN=$P(^PSRX(NEXTRX,0),"^",2) Q "RTN","PSOLBL",19,0) I $P(^PS(59,PSOSITE,1),"^",28) D ^PSOLBLN2 "RTN","PSOLBL",20,0) D:'$P(^PS(59,PSOSITE,1),"^",28) ^PSOLBLS "RTN","PSOLBL",21,0) DQ5 I $D(^TMP($J,"PSOCP",DFN)),'$P(^PS(59,PSOSITE,1),"^",28) D INV^PSOCPE "RTN","PSOLBL",22,0) HLEX K RXPI,PSORX,RXP,PSOIOS,PSOLAPPL,XXX,COPAYVAR,TECH,PHYS,MFG,NURSE,STATE,SIDE,COPIES,EXDT,ISD,PSOINST,RXN,RXY,VADT,DEA,WARN,FDT,QTY,PATST,PDA,PS,PS1,PS2,PSL,PSNP,INRX,RR,XTYPE,SSNP,SSNPN,PNM,ADDR,PSODBQ,PSOLASTF,PSRESOLV,PSOEXREP,PSOSXQ "RTN","PSOLBL",23,0) K ^TMP($J,"PSOCP",+$G(PSOCPN)),REF,PSOCPN,PSOLBLDR,PSOLBLPS,PSOLBLCP,RXPR,RXRP,RXRS,PSOCKHN,RXFLX,PSOLAPPL,PSOPDFN,PSDFNFLG,PSOZERO,NEXTRX,PSOBLALL,STA S:'$G(PSOSUREP)&('$G(PSOSUSPR)) ZTREQ="@" Q "RTN","PSOLBL",24,0) C I $G(IOST(0)),$D(^%ZIS(2,IOST(0),55,"B","LL")) G C^PSOLLLI "RTN","PSOLBL",25,0) U IO S X=$S('$P(^PS(59,PSOSITE,1),"^",28):132,1:158) X ^%ZOSF("RM") Q:'$D(^PSRX(RX,0)) "RTN","PSOLBL",26,0) S:$G(PSOBLALL) PSOBLRX=RX "RTN","PSOLBL",27,0) S:$D(RXRP(RX)) REPRINT=1 S:$D(RXPR(RX)) RXP=RXPR(RX) "RTN","PSOLBL",28,0) I $G(PSOSUREP)!($G(PSOEXREP)) S REPRINT=1 S:'$G(RXRP(RX)) RXRP(RX)=1 "RTN","PSOLBL",29,0) S RXY=^PSRX(RX,0),RXSTA=$P(^PSRX(RX,"STA"),"^") I RXSTA>11 D AL("QT") K RXY,RXP,REPRINT Q ;*244 "RTN","PSOLBL",30,0) I RXSTA=3 D AL("QT") K RXY,RXP,REPRINT Q "RTN","PSOLBL",31,0) I $G(RXPR(RX)),'$D(^PSRX(RX,"P",RXP,0)) K RXY,RXP,REPRINT Q "RTN","PSOLBL",32,0) I $P($G(RXFL(RX)),"^"),'$D(^PSRX(RX,1,$P($G(RXFL(RX)),"^"),0)) K RXY,RXP,REPRINT Q "RTN","PSOLBL",33,0) I $G(PSODBQ)!($G(RXRS(RX))) S RR=$O(^PS(52.5,"B",RX,0)) Q:'RR I $G(^PS(52.5,RR,"P"))=1 K RXY,RXP,REPRINT Q "RTN","PSOLBL",34,0) I $G(RXRS(RX))!($G(PSOPULL)) S PSOSXQ=0 N DR,DA,DIE D I $G(PSOSXQ) K RXY,RXP,REPRINT Q "RTN","PSOLBL",35,0) .S DA=$O(^PS(52.5,"B",RX,0)) Q:'DA S A=$P($G(^PS(52.5,DA,0)),"^",7) Q:A="" "RTN","PSOLBL",36,0) .I A="Q" S DIE="^PS(52.5,",DR="3////P" D ^DIE Q "RTN","PSOLBL",37,0) .K RXRS(RX) S PSOSXQ=1 "RTN","PSOLBL",38,0) I $G(PSRESOLV)=RX D ENLBL^PSOBSET K PSRESOLV "RTN","PSOLBL",39,0) I RXSTA'=4 D:$G(PSOSUSPR) AREC^PSOSUTL D:$G(PSOPULL)!($G(RXRS(RX))) AREC1^PSOSUTL D:$G(PSOSUREP) AREC^PSOSUSRP D:$G(PSXREP) AREC^PSXSRP "RTN","PSOLBL",40,0) K ^UTILITY("DIQ1",$J) S DA=$P($$SITE^VASITE(),"^") I $G(DA) S DIC=4,DIQ(0)="I",DR="99" D EN^DIQ1 S PSOINST=$G(^UTILITY("DIQ1",$J,4,DA,99,"I")) K ^UTILITY("DIQ1",$J),DA,DR,DIC "RTN","PSOLBL",41,0) S RXN=$P(RXY,"^"),ISD=$P(RXY,"^",13),RXF=0,DFN=+$P(RXY,"^",2),SIG=$P($G(^PSRX(RX,"SIG")),"^"),ISD=$E(ISD,4,5)_"/"_$E(ISD,6,7)_"/"_($E(ISD,1,3)+1700),ZY=0,$P(LINE,"_",28)="_" "RTN","PSOLBL",42,0) S PSOLBLPS=+$P(RXY,"^",3),PSOLBLDR=+$P(RXY,"^",6) "RTN","PSOLBL",43,0) S NURSE=$S($P($G(^DPT(DFN,"NHC")),"^")="Y":1,$P($G(^PS(55,DFN,40)),"^"):1,1:0) S FDT=$P(^PSRX(RX,2),"^",2),PS=$S($D(^PS(59,PSOSITE,0)):^(0),1:""),PS1=$S($D(^(1)):^(1),1:""),PSOSITE7=$P(^("IB"),"^") "RTN","PSOLBL",44,0) S PS2=$P(PS,"^")_"^"_$P(PS,"^",6) "RTN","PSOLBL",45,0) S (EXPDT,EXDT)=$P(^PSRX(RX,2),"^",6),EXDT=$S('EXDT:"",1:$E(EXDT,4,5)_"/"_$E(EXDT,6,7)_"/"_($E(EXDT,1,3)+1700)) "RTN","PSOLBL",46,0) S COPIES=$S($P($G(RXRP(RX)),"^",2):$P($G(RXRP(RX)),"^",2),$P(RXY,"^",18)]"":$P(RXY,"^",18),1:1) "RTN","PSOLBL",47,0) K PSOCKHNX S PSOCKHL=$L(RX),PSOCKHN=$E($G(PSOCKHN),(PSOCKHL+2),999) D K PSOCKHNX,PSOCKHL,PSOCKHA "RTN","PSOLBL",48,0) .S PSOCKHA=","_RX_"," "RTN","PSOLBL",49,0) .I PSOCKHN'[PSOCKHA Q "RTN","PSOLBL",50,0) .S PSOCKHA=$E(PSOCKHA,1,($L(PSOCKHA)-1)) "RTN","PSOLBL",51,0) .S PSOCKHNX=$L(PSOCKHN,PSOCKHA)-1 "RTN","PSOLBL",52,0) .I +$G(PSOCKHNX)>0 D DOUB "RTN","PSOLBL",53,0) I $O(^PSRX(RX,1,0)),$G(RXFL(RX))'=0 S $P(^PSRX(RX,3),"^",6)="" K ^PSRX(RX,"DAI"),^PSRX(RX,"DRI") "RTN","PSOLBL",54,0) I '$G(RXP),'$O(^PSRX(RX,1,0)) S RXFL(RX)=0 "RTN","PSOLBL",55,0) I '$G(RXP) D OSET I '$O(^PSRX(RX,1,0))!($G(RXFL(RX))=0) G ORIG "RTN","PSOLBL",56,0) I $O(^PSRX(RX,1,0)),'$G(RXP),'$G(RXFL(RX)) S XTYPE=1 D REF G STA "RTN","PSOLBL",57,0) I $O(^PSRX(RX,1,0)),'$G(RXP),$G(RXFL(RX)) G STA "RTN","PSOLBL",58,0) I $G(RXP) S XTYPE="P" D REF G STA "RTN","PSOLBL",59,0) ORIG S TECH=$P($G(^VA(200,+$P(^PSRX(RX,0),"^",16),0)),"^"),QTY=$P(^PSRX(RX,0),"^",7),PHYS=$S($D(^VA(200,+$P(^PSRX(RX,0),"^",4),0)):$P(^(0),"^"),1:"UKN") D 6^VADPT,PID^VADPT S SSNPN="" "RTN","PSOLBL",60,0) S DAYS=$P(^PSRX(RX,0),"^",8),MFG="________",LOT="________" "RTN","PSOLBL",61,0) STA S STATE=$S($D(^DIC(5,+$P(PS,"^",8),0)):$P(^(0),"^",2),1:"UKN") "RTN","PSOLBL",62,0) S DRUG=$$ZZ^PSOSUTL(RX),DEA=$P($G(^PSDRUG(+$P(RXY,"^",6),0)),"^",3),WARN=$P($G(^(0)),"^",8) "RTN","PSOLBL",63,0) S SIDE=$S($P($G(RXRP(RX)),"^",3):1,1:0) "RTN","PSOLBL",64,0) I $G(^PSRX(RX,"P",+$G(RXP),0))]"" S RXPI=RXP D "RTN","PSOLBL",65,0) .S RXP=^PSRX(RX,"P",RXP,0) "RTN","PSOLBL",66,0) .S RXY=$P(RXP,"^")_"^"_$P(RXY,"^",2,6)_"^"_$P(RXP,"^",4)_"^"_$P(RXP,"^",10)_"^"_$P(RXY,"^",9)_"^"_$P($G(^PSRX(RX,"SIG")),"^",2)_"^"_$P(RXP,"^",2)_"^"_$P(RXY,"^",12,14)_"^"_$P(^PSRX(RX,"STA"),"^")_"^"_$P(RXP,"^",7)_"^"_$P(RXY,"^",17,99) "RTN","PSOLBL",67,0) .S FDT=$P(RXP,"^") "RTN","PSOLBL",68,0) S MW=$P(RXY,"^",11) I $G(RXFL(RX))'=0 D:$G(RXFL(RX)) I '$G(RXFL(RX)) F I=0:0 S I=$O(^PSRX(RX,1,I)) Q:'I S RXF=RXF+1 S:'$G(RXP) MW=$P(^PSRX(RX,1,I,0),"^",2) I +^PSRX(RX,1,I,0)'30) "RTN","PSOLBL",74,0) .K PSMP(PSI) "RTN","PSOLBL",75,0) S X=$S($D(^PS(55,DFN,0)):^(0),1:""),PSCAP=$P(X,"^",2),PS55=$P($G(X),"^",3),PS55X=$P($G(X),"^",5) "RTN","PSOLBL",76,0) I (($G(PS55X)]"")&(PS55>1)&(PS55X0,$P(^("STA"),"^")'=2,'$G(PSODBQ) D SNO G LBL "RTN","PSOLBL",89,0) I $G(PSOLBLCP)="" D IBCP "RTN","PSOLBL",90,0) N PSOQI S PSOQI=$G(^PSRX(RX,"IBQ")) I $G(PSOLBLCP)=0 D SNO G LBL "RTN","PSOLBL",91,0) I $G(PSOLBLCP)=1 I $P(PSOQI,"^",2)!($P(PSOQI,"^",3))!($P(PSOQI,"^",4))!($P(PSOQI,"^",5))!($P(PSOQI,"^",6))!($P(PSOQI,"^",7))!($P(PSOQI,"^",8)) D SNO G LBL "RTN","PSOLBL",92,0) I $G(PSOLBLCP)=2 I $P(PSOQI,"^")!($P(PSOQI,"^",2))!($P(PSOQI,"^",3))!($P(PSOQI,"^",4))!($P(PSOQI,"^",5))!($P(PSOQI,"^",6))!($P(PSOQI,"^",7))!($P(PSOQI,"^",8)) D SNO G LBL "RTN","PSOLBL",93,0) I $G(PSOLBLCP)=2,'$P($G(^PSRX(RX,"IB")),"^") D SNO G LBL "RTN","PSOLBL",94,0) S PSOCPN=$P(^PSRX(RX,0),"^",2),INRX=$P(^(0),"^") I $G(^TMP($J,"PSOCP",PSOCPN))="" S ^(PSOCPN)=PSOCPN "RTN","PSOLBL",95,0) S ^TMP($J,"PSOCP",PSOCPN,INRX)=INRX_"^"_$$ZZ^PSOSUTL(RX)_"^"_+$G(DAYS) S COPAYVAR="COPAY" K ZDRUG "RTN","PSOLBL",96,0) LBL ; "RTN","PSOLBL",97,0) G ^PSOLBLD:$P(^PSRX(RX,"STA"),"^")=4!($$DS^PSSDSAPI&'$G(RXF)&'$G(RXP)&$G(^PS(52.4,RX,1))) ;critical drug interaction status or dose warning and not a refill or partial - print warning label "RTN","PSOLBL",98,0) D ^PSOLBLD:$D(^PSRX(RX,"DRI"))&('$G(RXF))&('$G(RXP)) ;print warning label for critical and significant interactions "RTN","PSOLBL",99,0) D:$P($G(^PSRX(RX,3)),"^",6)&('$G(RXF))&('$G(RXP)) ^PSOLBLD1 "RTN","PSOLBL",100,0) G ^PSOLBL1:'$P(^PS(59,PSOSITE,1),"^",28) "RTN","PSOLBL",101,0) I $$DS^PSSDSAPI,'$G(RXF),'$G(RXP) Q:$D(^PS(52.4,RX,1)) ;already printed warning label above, quit if dose warning and don't print bottle label "RTN","PSOLBL",102,0) Q:(($P(^PSRX(RX,"STA"),"^")=4!($P($G(^PSRX(RX,"DRI")),"^",1)[1))&('$G(RXF))&('$G(RXP))) ;if signficant warning (DRI node piece 1 contains only 2's) continue to print bottle label "RTN","PSOLBL",103,0) S:'$G(COPIES) COPIES=1 G ^PSOLBLN "RTN","PSOLBL",104,0) REF F XXX=0:0 S XXX=$O(^PSRX(RX,XTYPE,XXX)) Q:+XXX'>0 D "RTN","PSOLBL",105,0) .S TECH=$S($D(^VA(200,+$P(^PSRX(RX,XTYPE,XXX,0),"^",7),0)):$P(^(0),"^"),1:"UNKNOWN") "RTN","PSOLBL",106,0) .S QTY=$P(^PSRX(RX,XTYPE,XXX,0),"^",4),PHYS=$S($D(^VA(200,+$P(^PSRX(RX,XTYPE,XXX,0),"^",17),0)):$P(^(0),"^"),$D(^VA(200,+$P(^PSRX(RX,0),"^",4),0)):$P(^(0),"^"),1:"UNKNOWN") D 6^VADPT,PID^VADPT S SSNPN="" "RTN","PSOLBL",107,0) .S DAYS=$P(^PSRX(RX,XTYPE,XXX,0),"^",10),LOT="________",MFG="________" "RTN","PSOLBL",108,0) Q "RTN","PSOLBL",109,0) CHECK S PSDFNFLG=0,PSOZERO=$P(PPL,","),PSOPDFN=$P(^PSRX(PSOZERO,0),"^",2) "RTN","PSOLBL",110,0) Q "RTN","PSOLBL",111,0) OSET D OSET^PSOLBL1 "RTN","PSOLBL",112,0) Q "RTN","PSOLBL",113,0) DOUB Q:'$D(RXFL(RX)) I +$G(RXFL(RX))-PSOCKHNX<0 Q "RTN","PSOLBL",114,0) S RXFLX(RX)=$G(RXFL(RX)),RXFL(RX)=$G(RXFL(RX))-PSOCKHNX "RTN","PSOLBL",115,0) Q "RTN","PSOLBL",116,0) AL(T) N I,IR,RF,USR,TY,DES S USR="" "RTN","PSOLBL",117,0) I T="UT" D "RTN","PSOLBL",118,0) .N J,RX S USR=$G(DUZ),TY="B",DES="Label never queued to print by User" "RTN","PSOLBL",119,0) .F J=1:1 S RX=+$P(PPL,",",J) Q:'RX D AL1 "RTN","PSOLBL",120,0) I T="QT" D "RTN","PSOLBL",121,0) .S I=+$P(^PSRX(RX,"STA"),"^"),TY=$S((I=3)!(I=16):"H",I=13:"D",1:"C") "RTN","PSOLBL",122,0) .S DES=I_" "_$S((I=3)!(I=16):"HOLD"_$S(I=16:"(PROVIDER)",1:""),(I=12)!(I=14)!(I=15):"DISCONTINUED"_$S(I=14:"(PROVIDER)",I=15:"(EDIT)",1:""),I=13:"DELETED",1:"") "RTN","PSOLBL",123,0) .S DES="Queued label terminated - "_DES D AL1 "RTN","PSOLBL",124,0) K %,%H,%I Q "RTN","PSOLBL",125,0) AL1 S (IR,I,RF)=0 F S I=$O(^PSRX(RX,1,I)) Q:'I S RF=I S:I>5 RF=I+1 "RTN","PSOLBL",126,0) S I=0 F S I=$O(^PSRX(RX,"A",I)) Q:'I S IR=I "RTN","PSOLBL",127,0) S IR=IR+1,^PSRX(RX,"A",0)="^52.3DA^"_IR_"^"_IR "RTN","PSOLBL",128,0) D NOW^%DTC S ^PSRX(RX,"A",IR,0)=%_"^"_TY_"^"_USR_"^"_$S($G(RXPR(RX)):6,1:RF)_"^"_DES "RTN","PSOLBL",129,0) Q "RTN","PSOLBL",130,0) IBCP N X,Y,PSOJJ,PSOLL "RTN","PSOLBL",131,0) S PSOLBLCP="",X=$P($G(^PS(59,+$G(PSOSITE),"IB")),"^")_"^"_$G(DFN) D XTYPE^IBARX "RTN","PSOLBL",132,0) S PSOJJ="" F S PSOJJ=$O(Y(PSOJJ)) Q:'PSOJJ S PSOLL="" F S PSOLL=$O(Y(PSOJJ,PSOLL)) Q:PSOLL="" S:PSOLL>0 PSOLBLCP=PSOLL "RTN","PSOLBL",133,0) I '$G(PSOLBLCP) S PSOLBLCP=0 "RTN","PSOLBL",134,0) Q "RTN","PSOLBL",135,0) SNO S COPAYVAR="NO COPAY" Q "RTN","PSOLBL4") 0^21^B49656838^B49493976 "RTN","PSOLBL4",1,0) PSOLBL4 ;BIR/RTR - Set up routine for HL7 interface ;10/9/08 11:37am "RTN","PSOLBL4",2,0) ;;7.0;OUTPATIENT PHARMACY;**26,70,156,244,233,246,319,387**;DEC 1997;Build 13 "RTN","PSOLBL4",3,0) ;External reference to ^PSDRUG supported by DBIA 221 "RTN","PSOLBL4",4,0) ; "RTN","PSOLBL4",5,0) ;*244 - ignore RX's with a status > 11 "RTN","PSOLBL4",6,0) ;*246 - send marked drugs & print label (option 4) now working "RTN","PSOLBL4",7,0) ; "RTN","PSOLBL4",8,0) N DIC,AP,X,Y,DPRT,QPRT "RTN","PSOLBL4",9,0) I $G(ZTIO)]"" D "RTN","PSOLBL4",10,0) .Q:'$O(^PS(59,PSOSITE,"P",0)) "RTN","PSOLBL4",11,0) .S DIC=3.5,DIC(0)="",X=ZTIO D ^DIC K DIC,X Q:Y=-1 "RTN","PSOLBL4",12,0) .S DPRT=+Y "RTN","PSOLBL4",13,0) .F AP=0:0 S AP=$O(^PS(59,PSOSITE,"P",AP)) Q:'AP I +$P(^PS(59,PSOSITE,"P",AP,0),"^")=DPRT S QPRT=1 "RTN","PSOLBL4",14,0) .I '$G(QPRT) S $P(PSOPAR,"^",30)=0 "RTN","PSOLBL4",15,0) Q:'$P($G(PSOPAR),"^",30) ;HL7 interface turned off "RTN","PSOLBL4",16,0) Q:$G(PSOEXREP) "RTN","PSOLBL4",17,0) HL N PSODTM,HHHH,PSOQUE,HLFLAG,HLFOUR,HLINGF,HLINRX,HLINRX0,II,HLNEXT,HLRR,HLRX,HLRXY,LL,PPLHL,PSHALP,HDFN,HLDFN,HNEWDFN,HLDAI,HLOSITE,HLJUST,HLRXYZ,PSOLLN,PSOLLL,PSFLG,HDFN1,NOTMD "RTN","PSOLBL4",18,0) S HLOSITE=$P($G(PSOPAR),"^",30) "RTN","PSOLBL4",19,0) K ^UTILITY($J,"PSOHL"),^UTILITY($J,"PSOHLL"),HLRXY "RTN","PSOLBL4",20,0) S PPLHL=PPL "RTN","PSOLBL4",21,0) S HLFLAG=0 F II=1:1 S HLRX=$P(PPLHL,",",II) D Q:$G(HLFLAG) "RTN","PSOLBL4",22,0) .S HLNEXT=$P(PPLHL,",",(II+1)) I HLNEXT=""!(HLNEXT=",") S HLFLAG=1 "RTN","PSOLBL4",23,0) .Q:'$G(HLRX) "RTN","PSOLBL4",24,0) .Q:'$D(^PSRX(HLRX,0)) "RTN","PSOLBL4",25,0) .I $P($G(^PSRX(HLRX,"STA")),"^")=4!($P($G(^PSRX(HLRX,"STA")),"^")=1) Q "RTN","PSOLBL4",26,0) .Q:$G(RXRP(HLRX,"RP")) "RTN","PSOLBL4",27,0) .I $P($G(^PSRX(HLRX,"STA")),"^")>11!('$P(^PSRX(HLRX,0),"^",2)) Q "RTN","PSOLBL4",28,0) .I $G(PSODBQ) S HLRR=$O(^PS(52.5,"B",HLRX,0)) Q:'HLRR I $G(^PS(52.5,+HLRR,"P"))=1 Q "RTN","PSOLBL4",29,0) .; marked drug options 3 & 4 "RTN","PSOLBL4",30,0) .I (HLOSITE=3)!(HLOSITE=4) S NOTMD=0 D Q:NOTMD ;quit, not marked "RTN","PSOLBL4",31,0) ..S HLJUST=+$P($G(^PSRX(HLRX,0)),"^",6) "RTN","PSOLBL4",32,0) ..S:'$P($G(^PSDRUG(HLJUST,6)),"^") NOTMD=1 "RTN","PSOLBL4",33,0) .S HLRXY(II,HLRX)="" ;Valid Rx for HL7 "RTN","PSOLBL4",34,0) .S:HLOSITE=3 HLRXYZ(HLRX)="" "RTN","PSOLBL4",35,0) ; "RTN","PSOLBL4",36,0) I $G(HLOSITE)=3,$D(HLRXY) D ;rebuild PPL print string "RTN","PSOLBL4",37,0) .K PPL F II=1:1 S HLRX=$P(PPLHL,",",II) Q:'HLRX D "RTN","PSOLBL4",38,0) ..Q:$D(HLRXYZ(HLRX)) "RTN","PSOLBL4",39,0) ..S PPL=$G(PPL)_HLRX_"," "RTN","PSOLBL4",40,0) ; "RTN","PSOLBL4",41,0) SOMDQ S (II,PSOQUE)=0 F S II=$O(HLRXY(II)) Q:'II S ^UTILITY($J,"PSOHLL",II)=$O(HLRXY(II,0)),PSOQUE=II "RTN","PSOLBL4",42,0) I PSOQUE=0 G ENDHL ;Nothing set, bypass Call to Queue "RTN","PSOLBL4",43,0) F II=0:0 S II=$O(^UTILITY($J,"PSOHLL",II)) Q:'II S HLINRX=^(II),HLINRX0=$G(^PSRX(HLINRX,0)) D "RTN","PSOLBL4",44,0) .S ^UTILITY($J,"PSOHLL",II)=HLINRX_"^"_+$P(HLINRX0,"^",6)_"^"_$S($G(RXPR(HLINRX)):"P",1:"F") "RTN","PSOLBL4",45,0) .I '$G(RXPR(HLINRX)) S HLFOUR=0 F HHHH=0:0 S HHHH=$O(^PSRX(HLINRX,1,HHHH)) Q:'HHHH I +^(HHHH,0) S HLFOUR=HHHH "RTN","PSOLBL4",46,0) .I '$G(RXPR(HLINRX)),$G(RXFL(HLINRX))'="" S HLFOUR=$S($G(RXFL(HLINRX))=0:0,$D(^PSRX(HLINRX,1,+$G(RXFL(HLINRX)),0)):+$G(RXFL(HLINRX)),1:$G(HLFOUR)) "RTN","PSOLBL4",47,0) .S ^UTILITY($J,"PSOHLL",II)=^UTILITY($J,"PSOHLL",II)_"^"_$S($G(RXPR(HLINRX)):RXPR(HLINRX),1:HLFOUR)_"^"_$S($P($G(^PSRX(HLINRX,3)),"^",6)&('$G(RXPR(HLINRX)))&('$G(RXFL(HLINRX))):1,1:0) D ACLOG "RTN","PSOLBL4",48,0) .S HLINGF=0 I $P(^UTILITY($J,"PSOHLL",II),"^",5),$O(^PSRX(HLINRX,"DAI",0)) S HLINGF=1 D "RTN","PSOLBL4",49,0) ..F LL=0:0 S LL=$O(^PSRX(HLINRX,"DAI",LL)) Q:'LL S ^UTILITY($J,"PSOHLL",II,HLINGF)=$G(^PSRX(HLINRX,"DAI",LL,0)),HLINGF=HLINGF+1 "RTN","PSOLBL4",50,0) .S $P(^UTILITY($J,"PSOHLL",II),"^",6)=$S($G(HLINGF):1,1:0) "RTN","PSOLBL4",51,0) .I $D(^PSRX(HLINRX,"DRI")),'$G(RXPR(HLINRX)),'$G(RXFL(HLINRX)) S ^UTILITY($J,"PSOHLL",II,"DRI")=^PSRX(HLINRX,"DRI"),$P(^UTILITY($J,"PSOHLL",II),"^",7)=1 "RTN","PSOLBL4",52,0) .E S $P(^UTILITY($J,"PSOHLL",II),"^",7)=0 "RTN","PSOLBL4",53,0) .S $P(^UTILITY($J,"PSOHLL",II),"^",8)=0 D RPT Q:'$G(^PSRX(HLINRX,"IB")) "RTN","PSOLBL4",54,0) .I $P(^PSRX(HLINRX,"STA"),"^")>0,$P(^("STA"),"^")'=2,'$G(PSODBQ) Q "RTN","PSOLBL4",55,0) .S $P(^UTILITY($J,"PSOHLL",II),"^",8)=1 "RTN","PSOLBL4",56,0) ; "RTN","PSOLBL4",57,0) AAA D STRT^PSOHLSG5 "RTN","PSOLBL4",58,0) S (HDFN,HDFN1)=$O(^UTILITY($J,"PSOHLL",0)),HDFN=$P(^PSRX($P(^(HDFN),"^"),0),"^",2),PSOLLL=$P(^UTILITY($J,"PSOHLL",HDFN1),"^",12) "RTN","PSOLBL4",59,0) F HLDFN=0:0 S HLDFN=$O(^UTILITY($J,"PSOHLL",HLDFN)) Q:'HLDFN D S ^UTILITY($J,"PSOHL",HLDFN)=^UTILITY($J,"PSOHLL",HLDFN) D OTHER "RTN","PSOLBL4",60,0) .S PSFLG=0,PSOLLN=$P(^UTILITY($J,"PSOHLL",HLDFN),"^",12),HNEWDFN=$P(^PSRX($P(^UTILITY($J,"PSOHLL",HLDFN),"^"),0),"^",2) D "RTN","PSOLBL4",61,0) ..I HDFN'=HNEWDFN S HDFN=HNEWDFN,PSFLG=1 "RTN","PSOLBL4",62,0) ..I PSOLLL'=PSOLLN S PSOLLL=PSOLLN,PSFLG=1 "RTN","PSOLBL4",63,0) ..I PSFLG=1 D SETZ "RTN","PSOLBL4",64,0) I '$D(^UTILITY($J,"PSOHL")) G ENDHL "RTN","PSOLBL4",65,0) CALL D SETZ "RTN","PSOLBL4",66,0) ENDHL K ^UTILITY($J,"PSOHL"),^UTILITY($J,"PSOHLL"),HLRXY "RTN","PSOLBL4",67,0) Q "RTN","PSOLBL4",68,0) OTHER I $G(^UTILITY($J,"PSOHLL",HLDFN,"DRI"))'="" S ^UTILITY($J,"PSOHL",HLDFN,"DRI")=^UTILITY($J,"PSOHLL",HLDFN,"DRI") "RTN","PSOLBL4",69,0) F HLDAI=0:0 S HLDAI=$O(^UTILITY($J,"PSOHLL",HLDFN,HLDAI)) Q:'HLDAI S ^UTILITY($J,"PSOHL",HLDFN,HLDAI)=^UTILITY($J,"PSOHLL",HLDFN,HLDAI) "RTN","PSOLBL4",70,0) Q "RTN","PSOLBL4",71,0) ACLOG ;Activity log (sending to Hl7 interface) "RTN","PSOLBL4",72,0) N DTTM,HCOM,HCNT,HJJ "RTN","PSOLBL4",73,0) D NOW^%DTC S DTTM=%,HCOM="Prescription"_$S($G(RXPR(HLINRX)):" (Partial)",1:"")_$S($G(PSOSUREP)!($G(RXRP(HLINRX))):" (Reprint)",1:"")_" sent to external interface." "RTN","PSOLBL4",74,0) S HCNT=0 F HJJ=0:0 S HJJ=$O(^PSRX(HLINRX,"A",HJJ)) Q:'HJJ S HCNT=HJJ "RTN","PSOLBL4",75,0) S HCNT=HCNT+1,^PSRX(HLINRX,"A",0)="^52.3DA^"_HCNT_"^"_HCNT S ^PSRX(HLINRX,"A",HCNT,0)=DTTM_"^X^"_$G(PDUZ)_"^"_$S($G(RXPR(HLINRX)):6,$G(HLFOUR)<6:$G(HLFOUR),1:(HLFOUR+1))_"^"_HCOM "RTN","PSOLBL4",76,0) Q "RTN","PSOLBL4",77,0) SUS(HSREX,HSFL,HSFILL,HSRP) ; "RTN","PSOLBL4",78,0) N DA,DIK,DTTM,HSCOM,HSCNT,HSJJ,HSLDUZ,PSHLCPRS "RTN","PSOLBL4",79,0) I $P($G(^PSRX(HSREX,"STA")),"^")=5 S $P(^PSRX(HSREX,"STA"),"^")=0 S PSHLCPRS="Removed from Suspense, External Interface." D EN^PSOHLSN1(HSREX,"SC","ZU",PSHLCPRS) "RTN","PSOLBL4",80,0) S DA=$O(^PS(52.5,"B",HSREX,0)) I DA K DIK S DIK="^PS(52.5," D ^DIK "RTN","PSOLBL4",81,0) I $G(HSFL)="P" S HSLDUZ=+$P($G(^PSRX(HSREX,"P",HSFILL,0)),"^",7) "RTN","PSOLBL4",82,0) E S HSLDUZ=$S('HSFILL:+$P($G(^PSRX(HSREX,0)),"^",16),1:+$P($G(^PSRX(HSREX,1,HSFILL,0)),"^",7)) "RTN","PSOLBL4",83,0) D NOW^%DTC S DTTM=%,HSCOM="Removed from Suspense"_$S($G(HSFL)="P":" (Partial)",1:"")_$S($G(HSRP):" (Reprint)",1:"")_" (External Interface)" "RTN","PSOLBL4",84,0) S HSCNT=0 F HSJJ=0:0 S HSJJ=$O(^PSRX(HSREX,"A",HSJJ)) Q:'HSJJ S HSCNT=HSJJ "RTN","PSOLBL4",85,0) S HSCNT=HSCNT+1,^PSRX(HSREX,"A",0)="^52.3DA^"_HSCNT_"^"_HSCNT S ^PSRX(HSREX,"A",HSCNT,0)=DTTM_"^X^"_$G(HSLDUZ)_"^"_$S($G(HSFL)="P":6,$G(HSFILL)<6:$G(HSFILL),1:(HSFILL+1))_"^"_$G(HSCOM) "RTN","PSOLBL4",86,0) Q "RTN","PSOLBL4",87,0) LAB(HLREX,HLFL,HLFILL,HLREPT) ; "RTN","PSOLBL4",88,0) N HLDUZ,NOW,DA,HCT,HFF "RTN","PSOLBL4",89,0) D NOW^%DTC S NOW=% S HCT=0 F HFF=0:0 S HFF=$O(^PSRX(HLREX,"L",HFF)) Q:'HFF S HCT=HFF "RTN","PSOLBL4",90,0) I HLFL="F" S HLDUZ=$S('HLFILL:+$P($G(^PSRX(HLREX,0)),"^",16),1:+$P($G(^PSRX(HLREX,1,HLFILL,0)),"^",7)) "RTN","PSOLBL4",91,0) I HLFL="P" S HLDUZ=+$P($G(^PSRX(HLREX,"P",HLFILL,0)),"^",7) "RTN","PSOLBL4",92,0) S HCT=HCT+1,^PSRX(HLREX,"L",0)="^52.032DA^"_HCT_"^"_HCT "RTN","PSOLBL4",93,0) S ^PSRX(HLREX,"L",HCT,0)=NOW_"^"_$S($G(HLFL)="F":HLFILL,1:(99-HLFILL))_"^"_"From Rx number "_$P(^PSRX(HLREX,0),"^")_$S($G(HLFL)="P":" (Partial)",1:"")_$S($G(HLREPT):" (Reprint)",1:"")_" (External Interface)"_"^"_$G(HLDUZ) "RTN","PSOLBL4",94,0) N PSOBADR,PSOTEMP "RTN","PSOLBL4",95,0) S PSOBADR=$$CHKRX^PSOBAI(HLREX) "RTN","PSOLBL4",96,0) I $G(PSOBADR) S PSOTEMP=$P(PSOBADR,"^",2),PSOBADR=$P(PSOBADR,"^") "RTN","PSOLBL4",97,0) I $G(PSOBADR),'$G(PSOTEMP) D "RTN","PSOLBL4",98,0) .S HCT=HCT+1,^PSRX(HLREX,"L",0)="^52.032DA^"_HCT_"^"_HCT "RTN","PSOLBL4",99,0) .S ^PSRX(HLREX,"L",HCT,0)=NOW_"^"_$S($G(HLFL)="F":HLFILL,1:(99-HLFILL))_"^"_"ROUTING="_$G(MW)_" (BAD ADDRESS)"_"^"_$G(HLDUZ) "RTN","PSOLBL4",100,0) Q "RTN","PSOLBL4",101,0) RPT ; "RTN","PSOLBL4",102,0) S $P(^UTILITY($J,"PSOHLL",II),"^",9)=$S($G(PSOSUREP)!($G(RXRP(HLINRX))):1,1:0) "RTN","PSOLBL4",103,0) S $P(^UTILITY($J,"PSOHLL",II),"^",10)=+$G(PDUZ) "RTN","PSOLBL4",104,0) Q "RTN","PSOLBL4",105,0) SETZ ; "RTN","PSOLBL4",106,0) D NOW^%DTC S PSODTM=% "RTN","PSOLBL4",107,0) S ZTRTN=$S($$GET1^DIQ(59,PSOSITE_",",105,"I")=2.4:"INIT^PSOHLDS",1:"INIT^PSOHLSG") "RTN","PSOLBL4",108,0) S ZTIO="",ZTDTH=$H,ZTSAVE("^UTILITY($J,""PSOHL"",")="",ZTSAVE("PSOPAR")="",ZTSAVE("PSOSITE")="",ZTSAVE("PSODTM")="",ZTSAVE("PSOLAP")="" "RTN","PSOLBL4",109,0) S ZTSAVE("RXRP(")="",ZTSAVE("RXPR(")="",ZTSAVE("RXFL(")="",ZTSAVE("RXRS(")="" "RTN","PSOLBL4",110,0) S ZTDESC=$S($$GET1^DIQ(59,PSOSITE_",",105,"I")=2.4:"Outpatient Automation External Interface",1:"GENERIC INTERFACE LABEL INFORMATION") "RTN","PSOLBL4",111,0) D ^%ZTLOAD "RTN","PSOLBL4",112,0) K ^UTILITY($J,"PSOHL") "RTN","PSOLBL4",113,0) Q "RTN","PSOLBLD") 0^17^B30177309^B32921586 "RTN","PSOLBLD",1,0) PSOLBLD ;BHAM ISC/RTR - PRINTS LABEL ;4/14/93 "RTN","PSOLBLD",2,0) ;;7.0;OUTPATIENT PHARMACY;**117,251,387**;DEC 1997;Build 13 "RTN","PSOLBLD",3,0) ;External reference to ^PSDRUG supported by DBIA 221 "RTN","PSOLBLD",4,0) ;External reference to $$DS^PSSDSAPI supported by DBIA 5425 "RTN","PSOLBLD",5,0) S HOLDCOPY=COPIES "RTN","PSOLBLD",6,0) N PSODOSEW,PSODRGI,PSOLINFD S (PSODOSEW,PSODRGI,PSOLINFD)=0 "RTN","PSOLBLD",7,0) START ; "RTN","PSOLBLD",8,0) K PSOSERV "RTN","PSOLBLD",9,0) S COPIES=COPIES-1,Y=$P(^PSRX(RX,2),"^",6) X ^DD("DD") S EXPDT=Y,Y=$P(^PSRX(RX,0),"^",13) X ^DD("DD") S ISD=Y "RTN","PSOLBLD",10,0) S Y=DATE X ^DD("DD") S DATE1=Y D NOW^%DTC S Y=% X ^DD("DD") S NOW=Y "RTN","PSOLBLD",11,0) S:'$P($G(^PS(59,+$G(PSOSITE),1)),"^",28) TB1=38,TB2=50,TB3=83 S:$P($G(^PS(59,+$G(PSOSITE),1)),"^",28) TB1=54,TB2=66,TB3=102 "RTN","PSOLBLD",12,0) I '$D(^PS(52.4,RX,0)),$P(^PSRX(RX,"STA"),"^")=4 D UNKNOWN D Q "RTN","PSOLBLD",13,0) .I $P(PSOPAR,"^",31),$P($G(^PSRX(RX,"STA")),"^")=4 D BLANK W @IOF "RTN","PSOLBLD",14,0) L1 W !?TB3 W:$G(RXRP(RX)) "(REPRINT)" I '$G(RXRP(RX)) W $P(PS2,"^",2)," ","("_$P(RXY,"^",16)_"/"_$S(+$G(VRPH):VRPH,1:" ")_")"_" ",$P(NOW,":",1,2) "RTN","PSOLBLD",15,0) L2 W ! I ($P(^PSRX(RX,"STA"),"^")=4)!($D(^PSRX(RX,"DRI"))&('$G(RXF))&('$G(RXP))) W ?TB1,"PRESCRIPTION # "_RXN_" HAS" "RTN","PSOLBLD",16,0) W ?TB3,RXN," ",DATE1," Fill ",RXF+1," of ",1+$P(RXY,"^",9) "RTN","PSOLBLD",17,0) I ($P(^PSRX(RX,"STA"),"^")=4)!($D(^PSRX(RX,"DRI"))&('$G(RXF))&('$G(RXP))) W !?TB1,"CAUSED A DRUG-DRUG INTERACTION" S PSOLINFD=1 "RTN","PSOLBLD",18,0) W:'$G(PSOLINFD) ! S PSOLINFD=0 W ?TB3,PNM," ",SSNP S PSODRGI=1 "RTN","PSOLBLD",19,0) I ($P(^PSRX(RX,"STA"),"^")=4)!($D(^PSRX(RX,"DRI"))&('$G(RXF))&('$G(RXP))) W !?TB1,"WITH THE FOLLOWING PRESCRIPTION(S):" S PSOLINFD=1 "RTN","PSOLBLD",20,0) W:'$G(PSOLINFD) ! S PSOLINFD=0 W ?TB3,$S($G(OSGY(1))]"":OSGY(1),1:$G(SGY(1))) "RTN","PSOLBLD",21,0) L5 W !,?TB3,$S($G(OSGY(2))]"":OSGY(2),1:$G(SGY(2))) "RTN","PSOLBLD",22,0) I $G(SGY(3))'="" F SSG=3:1 Q:$G(SGY(SSG))="" W !,?TB3,$S($G(OSGY(SSG))]"":OSGY(SSG),1:$G(SGY(SSG))) "RTN","PSOLBLD",23,0) L6 I $D(^PS(52.4,RX,0)) S SCRIPT=$P(^PS(52.4,RX,0),"^",10),SEV=$P(^PS(52.4,RX,0),"^",9) F X=1:1 S RXX(X)=$P(SCRIPT,",",X),SEV(X)=$P(SEV,",",X) Q:RXX(X)="" D "RTN","PSOLBLD",24,0) .S SER=SEV(X) S:$G(SER)=1 PSOSERV=1 W !?TB1,$P($G(^PSRX(RXX(X),0)),"^"),?TB2,$S(SER=1:"CRITICAL",SER=2:"SIGNIFICANT",1:"UNKNOWN")," INTERACTION",!?TB1," ",$P(^PSDRUG($P(^PSRX(RXX(X),0),"^",6),0),"^") S:SER=1 PSODRGI=1 "RTN","PSOLBLD",25,0) I '$D(^PS(52.4,RX,0)),$D(^PSRX(RX,"DRI")) S SCRIPT=$P(^PSRX(RX,"DRI"),"^",2),SEV=$P(^PSRX(RX,"DRI"),"^") F X=1:1 S RXX(X)=$P(SCRIPT,",",X),SEV(X)=$P(SEV,",",X) Q:RXX(X)="" D "RTN","PSOLBLD",26,0) .S SER=SEV(X) W !,?TB1,$P($G(^PSRX(RXX(X),0)),"^"),?TB2,$S(SER=1:"CRITICAL",SER=2:"SIGNIFICANT",1:"UNKNOWN")," INTERACTION",!?TB1," ",$P(^PSDRUG($P(^PSRX(RXX(X),0),"^",6),0),"^") S:SER=1 PSODRGI=1 "RTN","PSOLBLD",27,0) I $$DS^PSSDSAPI,($D(^PS(52.4,RX,1))) S T="",T=$P(^PS(52.4,RX,1),"^") D "RTN","PSOLBLD",28,0) .S T="DOSAGE OUTSIDE OF MAX SINGLE DOSE" W !!?TB1,T,!?TB1,"AND/OR DAILY DOSE RANGE" S:T>0 PSODOSEW=1 "RTN","PSOLBLD",29,0) L7 W ! "RTN","PSOLBLD",30,0) L8 W !,?TB1,"THIS PRESCRIPTION WAS ENTERED BY: ",?TB3,"Qty: "_$G(QTY)," ",$G(PHYS) "RTN","PSOLBLD",31,0) L9 W !,?TB1,TECH,?TB3,"Tech__________RPh__________" "RTN","PSOLBLD",32,0) L10 W !,?TB1,"THIS PRESCRIPTION ",$S('$G(PSOSERV):"MAY REQUIRE",1:"REQUIRES"),?TB3,DRUG "RTN","PSOLBLD",33,0) L11 W !,?TB1,$S('$G(PSOSERV):"REVIEWING BY A PHARMACIST",1:"INTERVENTION BY A PHARMACIST"),?TB3,"Routing: "_$S("W"[$E(MW):MW,1:MW_" MAIL") "RTN","PSOLBLD",34,0) L12 W !,?TB3,"Days supply: ",$G(DAYS)," Cap: "_$S(PSCAP:"**NON-SFTY**",1:"SAFETY") "RTN","PSOLBLD",35,0) L13 W !,?TB3,"Isd: ",ISD," Exp: ",EXPDT "RTN","PSOLBLD",36,0) L14 W !,?TB3,"Last Fill: ",$G(PSOLASTF) "RTN","PSOLBLD",37,0) L15 W !,?TB3,"Pat. Stat ",PATST," Clinic: ",PSCLN "RTN","PSOLBLD",38,0) L16 W !,@IOF "RTN","PSOLBLD",39,0) I COPIES>0 G START "RTN","PSOLBLD",40,0) S COPIES=HOLDCOPY K HOLDCOPY "RTN","PSOLBLD",41,0) STORE ;LABEL PRINT NODE "RTN","PSOLBLD",42,0) D NOW^%DTC S NOW=% K %,%H,%I I $G(RXF)="" S RXF=0 F I=0:0 S I=$O(^PSRX(RX,1,I)) Q:'I S RXF=I "RTN","PSOLBLD",43,0) F IR=0 F FDA=0:0 S FDA=$O(^PSRX(RX,"L",FDA)) Q:'FDA S IR=FDA "RTN","PSOLBLD",44,0) S IR=IR+1,^PSRX(RX,"L",0)="^52.032DA^"_IR_"^"_IR,PSRXSET="" "RTN","PSOLBLD",45,0) S PSRXSET=NOW_"^"_RXF_"^"_$S($G(PCOMX)]"":$G(PCOMX),1:"From RX number "_$P(^PSRX(RX,0),"^")) "RTN","PSOLBLD",46,0) S PSRXSET=PSRXSET_$S(PSODRGI&(PSODOSEW)&$$DS^PSSDSAPI:" Drug-Drug interaction/dose warning",PSODRGI:" Drug-Drug interaction",PSODOSEW&$$DS^PSSDSAPI:" Dose Warning",1:"")_$S($G(RXRP(RX)):" (Reprint)",1:"")_"^"_PDUZ_"^1" "RTN","PSOLBLD",47,0) S ^PSRX(RX,"L",IR,0)=PSRXSET K PSRXSET "RTN","PSOLBLD",48,0) K:$D(^PS(52.4,RX,0)) RXF,IR,FDA,NOW,I "RTN","PSOLBLD",49,0) I '$D(PSSPND),$P(PSOPAR,"^",18),$D(^PS(52.4,RX,0)) D CHCK2^PSOTRLBL "RTN","PSOLBLD",50,0) I $P(PSOPAR,"^",31),$P($G(^PSRX(RX,"STA")),"^")=4 D BLANK W @IOF "RTN","PSOLBLD",51,0) END K:$D(^PS(52.4,RX,0)) PSCLN,DATE1,DRUG,RFLMSG,COPIES,DRUG,LMI,LINE,PS,PS1,PS2,INT,ISD,I1,MW,STATE,SIDE,SGY,PATST,PRTFL,PHYS,SGC,VRPH,NLWS,X1,X2,X,Y,TECH,EXPDT,NURSE,SEV,SCRIPT,RXX,SGY,SER,SSG,RXY,SIGPH,PS55,PS55X K TB1,TB2,TB3,PSOSERV "RTN","PSOLBLD",52,0) Q "RTN","PSOLBLD",53,0) UNKNOWN W !!!,?TB1,"PRESCRIPTION # ",$P(^PSRX(RX,0),"^") "RTN","PSOLBLD",54,0) W !,?TB1," ",$P(^PSDRUG($P(^PSRX(RX,0),"^",6),0),"^"),?TB3,$P(PS2,"^",2)_" ("_$P(RXY,"^",16)_"/"_$S(+$G(VRPH):VRPH,1:" ")_")"_" ",$P($P(NOW,":",1,2),"@") "RTN","PSOLBLD",55,0) W !,?TB3,RXN," ",DATE1," Fill ",RXF+1," of ",1+$P(RXY,"^",9) "RTN","PSOLBLD",56,0) W !,?TB1,"The above prescription has a status",?TB3,PNM," ",SSNP "RTN","PSOLBLD",57,0) W !,?TB1,"of PENDING due to a DRUG-DRUG INTERACTION.",?TB3,$S($G(OSGY(1))]"":OSGY(1),1:$G(SGY(1))) "RTN","PSOLBLD",58,0) I $G(SGY(2))'="" F SSG=2:1 Q:$G(SGY(SSG))="" W !,?TB3,$S($G(OSGY(SSG))]"":OSGY(SSG),1:$G(SGY(SSG))) "RTN","PSOLBLD",59,0) W !,?TB1,"Please review printouts of all labels" "RTN","PSOLBLD",60,0) W !,?TB1,"for this patient that follow." D STORE "RTN","PSOLBLD",61,0) W @IOF K PSCLN,DATE1,DRUG,RFLMSG,COPIES,DRUG,LMI,LINE,PS,PS1,PS2,INT,ISD,I1,MW,STATE,SIDE,SIGPH,SGY,PATST,PRTFL,PHYS,SGC,VRPH,NLWS,X1,X2,X,Y,TECH,EXPDT,NURSE,SEV,SCRIPT,RXX,SGY,SER,SSG,RXY,TB1,TB2,TB3,PSOSERV Q "RTN","PSOLBLD",62,0) ; "RTN","PSOLBLD",63,0) BLANK ;label between patients "RTN","PSOLBLD",64,0) F ZBLANK=1:1:10 W ! "RTN","PSOLBLD",65,0) W !,"**********************NEXT PATIENT*************",?54,"*********NEXT PATIENT***********NEXT PATIENT***" "RTN","PSOLBLD",66,0) K ZBLANK Q "RTN","PSOLBLN") 0^16^B61102291^B58195867 "RTN","PSOLBLN",1,0) PSOLBLN ;BIR/RTR - NEW PRINTS LABEL ;11/18/92 "RTN","PSOLBLN",2,0) ;;7.0;OUTPATIENT PHARMACY;**16,36,71,107,110,117,135,233,251,387**;DEC 1997;Build 13 "RTN","PSOLBLN",3,0) ;External reference to ^PSDRUG supported by DBIA 221 "RTN","PSOLBLN",4,0) ;External reference to ^PS(55 supported by DBIA 2228 "RTN","PSOLBLN",5,0) ;External reference to ^VA(200 supported by DBIA 224 "RTN","PSOLBLN",6,0) ;External reference to ^SC( supported by DBIA 254 "RTN","PSOLBLN",7,0) K PSOSTLK,ZTKDRUG I $L($T(PSOSTALK^PSOTALK1)) D PSOSTALK^PSOTALK1 S PSOSTLK=1 ; PRINT SCRIPTALK LABEL IF APPLICABLE "RTN","PSOLBLN",8,0) I $G(IOS),$G(PSOBARS) I $G(PSOBAR0)=""!($G(PSOBAR1)="") S PSOIOS=IOS D DEVBAR^PSOBMST "RTN","PSOLBLN",9,0) I $G(DFN) D ADD^VADPT "RTN","PSOLBLN",10,0) I '$G(COPIES) S COPIES="" "RTN","PSOLBLN",11,0) S ADDR(33)=$G(VAPA(4))_", "_$P($G(VAPA(5)),"^",2)_" "_$S($G(VAPA(11))]"":$P($G(VAPA(11)),"^",2),1:$G(VAPA(6))),ADDR(22)="" "RTN","PSOLBLN",12,0) S:$G(VAPA(2))]"" ADDR(22)=$G(VAPA(2))_" "_$G(VAPA(3)),ADDR(22)=$E(ADDR(22),1,46) S:ADDR(22)="" ADDR(22)=ADDR(33),ADDR(33)="" "RTN","PSOLBLN",13,0) S ADDR(4)=$S(ADDR(33)="":ADDR(22),1:ADDR(33)) I $G(VAPA(2))="",$G(VAPA(3))="" S ADDR(2)=ADDR(4),ADDR(3)="",ADDR(4)="" G ST "RTN","PSOLBLN",14,0) I $G(VAPA(2))'="",$G(VAPA(3))="" S ADDR(2)=VAPA(2),ADDR(3)=ADDR(4),ADDR(4)="" G ST "RTN","PSOLBLN",15,0) I $G(VAPA(2))="",$G(VAPA(3))'="" S ADDR(2)=VAPA(3),ADDR(3)=ADDR(4),ADDR(4)="" G ST "RTN","PSOLBLN",16,0) S ADDR(2)=$G(VAPA(2)),ADDR(3)=$G(VAPA(3)) "RTN","PSOLBLN",17,0) ST I $P($G(^PSRX(RX,3)),"^",3) S PSOPROV=+$P(^(0),"^",4) S PSOPROV=$S($G(RXP):+$P($G(RXP),"^",17),$G(RXF):+$P($G(^PSRX(RX,1,RXF,0)),"^",17),1:PSOPROV) S:'$G(PSOPROV) PSOPROV=+$P(^PSRX(RX,0),"^",4) D "RTN","PSOLBLN",18,0) .I +$P($G(^VA(200,PSOPROV,"PS")),"^",7) S:'$P($G(PHYS),"/",2) PHYS=$G(PHYS)_"/"_+$P($G(^PSRX(RX,3)),"^",3) "RTN","PSOLBLN",19,0) ; "RTN","PSOLBLN",20,0) S:$G(PSOBLALL) PSOBLRX=RX "RTN","PSOLBLN",21,0) S:$D(RXRP(RX)) REPRINT=1 S:$D(RXPR(RX)) RXP=RXPR(RX) "RTN","PSOLBLN",22,0) I $G(PSOSUREP)!($G(PSOEXREP)) S REPRINT=1 S:'$G(RXRP(RX)) RXRP(RX)=1 "RTN","PSOLBLN",23,0) S RXY=^PSRX(RX,0),RXSTA=$P(^PSRX(RX,"STA"),"^") "RTN","PSOLBLN",24,0) S RXN=$P(RXY,"^"),ISD=$P(RXY,"^",13),RXF=0,DFN=+$P(RXY,"^",2),SIG=$P($G(^PSRX(RX,"SIG")),"^"),ISD=$E(ISD,4,5)_"/"_$E(ISD,6,7)_"/"_($E(ISD,1,3)+1700),ZY=0,$P(LINE,"_",28)="_" "RTN","PSOLBLN",25,0) S PSOLBLPS=+$P(RXY,"^",3),PSOLBLDR=+$P(RXY,"^",6) "RTN","PSOLBLN",26,0) S NURSE=$S($P($G(^DPT(DFN,"NHC")),"^")="Y":1,$P($G(^PS(55,DFN,40)),"^"):1,1:0) S FDT=$P(^PSRX(RX,2),"^",2),PS=$S($D(^PS(59,PSOSITE,0)):^(0),1:""),PS1=$S($D(^(1)):^(1),1:""),PSOSITE7=$P(^("IB"),"^") "RTN","PSOLBLN",27,0) S PS2=$P(PS,"^")_"^"_$P(PS,"^",6) "RTN","PSOLBLN",28,0) S (EXPDT,EXDT)=$P(^PSRX(RX,2),"^",6),EXDT=$S('EXDT:"",1:$E(EXDT,4,5)_"/"_$E(EXDT,6,7)_"/"_($E(EXDT,1,3)+1700)) "RTN","PSOLBLN",29,0) S COPIES=$S($P($G(RXRP(RX)),"^",2):$P($G(RXRP(RX)),"^",2),$P(RXY,"^",18)]"":$P(RXY,"^",18),1:1) "RTN","PSOLBLN",30,0) S STATE=$S($D(^DIC(5,+$P(PS,"^",8),0)):$P(^(0),"^",2),1:"UKN") "RTN","PSOLBLN",31,0) S DRUG=$$ZZ^PSOSUTL(RX),DEA=$P($G(^PSDRUG(+$P(RXY,"^",6),0)),"^",3),WARN=$P($G(^(0)),"^",8) "RTN","PSOLBLN",32,0) I $G(^PSRX(RX,"P",+$G(RXP),0))]"" S RXPI=RXP D "RTN","PSOLBLN",33,0) .S RXP=^PSRX(RX,"P",RXP,0) "RTN","PSOLBLN",34,0) .S RXY=$P(RXP,"^")_"^"_$P(RXY,"^",2,6)_"^"_$P(RXP,"^",4)_"^"_$P(RXP,"^",10)_"^"_$P(RXY,"^",9)_"^"_$P($G(^PSRX(RX,"SIG")),"^",2)_"^"_$P(RXP,"^",2)_"^"_$P(RXY,"^",12,14)_"^"_$P(^PSRX(RX,"STA"),"^")_"^"_$P(RXP,"^",7)_"^"_$P(RXY,"^",17,99) "RTN","PSOLBLN",35,0) .S FDT=$P(RXP,"^") "RTN","PSOLBLN",36,0) S MW=$P(RXY,"^",11) I $G(RXFL(RX))'=0 D:$G(RXFL(RX)) I '$G(RXFL(RX)) F I=0:0 S I=$O(^PSRX(RX,1,I)) Q:'I S RXF=RXF+1 S:'$G(RXP) MW=$P(^PSRX(RX,1,I,0),"^",2) I +^PSRX(RX,1,I,0)'30) "RTN","PSOLBLN",42,0) .K PSMP(PSI) "RTN","PSOLBLN",43,0) S X=$S($D(^PS(55,DFN,0)):^(0),1:""),PSCAP=$P(X,"^",2),PS55=$P($G(X),"^",3),PS55X=$P($G(X),"^",5) "RTN","PSOLBLN",44,0) I (($G(PS55X)]"")&(PS55>1)&(PS55X4 S KK=$S(DR=5!(DR=8)!(DR=11):2,(DR=6)!(DR=9)!(DR=12):1,1:0) I KK F HH=1:1:KK W ! "RTN","PSOLBLN",65,0) I DR=2 W !! "RTN","PSOLBLN",66,0) I DR=3 W ! "RTN","PSOLBLN",67,0) W !,$G(PHYS),?54,$G(PHYS),?102,$G(PHYS) "RTN","PSOLBLN",68,0) S PSMF=$S($G(NURSE):"Mfg______Exp______",1:""),PSDU=$P($G(^PSDRUG($P($G(^PSRX(RX,0)),"^",6),660)),"^",8),PSDU=$S(PSDU="":" "_PSMF,1:PSDU_" "_PSMF) "RTN","PSOLBLN",69,0) W !,"Qty: "_$G(QTY)," ",$G(PSDU),?54,"Qty: "_$G(QTY)," ",$G(PSDU),?102,"Qty: "_$G(QTY)," ",$G(PSDU) "RTN","PSOLBLN",70,0) S ZTKDRUG="XXXXXX SCRIPTALK RX XXXXXX" "RTN","PSOLBLN",71,0) I '$G(PSOSTLK) K PSDU,PSMF W !,DRUG,?54,DRUG,?102,DRUG "RTN","PSOLBLN",72,0) I $G(PSOSTLK) K PSDU,PSMF W !,$S($G(PSOSTALK):ZTKDRUG,1:DRUG),?54,DRUG,?102,DRUG "RTN","PSOLBLN",73,0) I $P(RXY,"^",9)-RXF'>0 D ^PSOLBLN1 G L13 "RTN","PSOLBLN",74,0) G:DIFF<30 L11 "RTN","PSOLBLN",75,0) W !?54,$P(RXY,"^",9)-RXF," Refills remain prior to ",EXPDT,?102,"Mfg "_$G(MFG)_" Lot# "_$G(LOT) G L12 "RTN","PSOLBLN",76,0) L11 W !?54,"Last fill prior to ",$G(EXPDT),?102,"Mfg "_$G(MFG)_" Lot# "_$G(LOT) "RTN","PSOLBLN",77,0) L12 W !,$P(PS,"^",2),?54,$S($L($G(COPAYVAR)):$G(COPAYVAR)_" ",1:""),"Days Supply: ",$G(DAYS),?102,"Tech__________RPh_________",!,$P(PS,"^",7),", ",STATE," ",$G(PSOHZIP) "RTN","PSOLBLN",78,0) ;send a CR for OPTIFIL (P-MT661BC) "RTN","PSOLBLN",79,0) I $G(PSOBARS),$P(PSOPAR,"^",19)'=1 S X="S",X2=PSOINST_"-"_RX S X1=$X W ?54,@PSOBAR1,X2,@PSOBAR0,$C(13) S $X=0 W:IOST["P-MT661BC" ! "RTN","PSOLBLN",80,0) E W !!! "RTN","PSOLBLN",81,0) W !,"FORWARDING SERVICE REQUESTED" W:"C"[$E(MW) !,?21,"CERTIFIED MAIL" W !?54,$G(VAPA(1)) "RTN","PSOLBLN",82,0) W !,$S($G(PS55)=2:"***DO NOT MAIL***",1:"***CRITICAL MEDICAL SHIPMENT***"),?54,$G(ADDR(2)),?102,"Routing: "_$S("W"[$E(MW):MW,1:MW_" MAIL") "RTN","PSOLBLN",83,0) W !?54,$G(ADDR(3)),?102,"Days supply: ",$G(DAYS)," Cap: ",$S(PSCAP:"**NON-SFTY**",1:"SAFETY") "RTN","PSOLBLN",84,0) W !?54,$G(ADDR(4)),?102,"Isd: ",ISD," Exp: ",EXPDT "RTN","PSOLBLN",85,0) W !,PNM,?54,"*Indicate address change on back of this form",?102,"Last Fill: ",$G(PSOLASTF) "RTN","PSOLBLN",86,0) W !,$S($D(PSMP(1)):PSMP(1),1:$G(VAPA(1))),?54,"[ ] Permanent",?102,"Pat. Stat ",PATST," Clinic: ",PSCLN "RTN","PSOLBLN",87,0) W !,$S($D(PSMP(2)):PSMP(2),$D(PSMP(1)):"",1:$G(ADDR(2))),?54,"[ ] Temporary until ",$S($P($G(VAPA(10)),"^",2)]"":$P($G(VAPA(10)),"^",2),1:"__/__/__"),?102,$S($G(WARN)'="":"DRUG WARNING "_$G(WARN),1:"") "RTN","PSOLBLN",88,0) W !,$S($D(PSMP(3)):PSMP(3),$D(PSMP(1)):"",1:$G(ADDR(3))),!,$S($D(PSMP(4)):PSMP(4),$D(PSMP(1)):"",1:$G(ADDR(4))),?54,"Signature",ULN "RTN","PSOLBLN",89,0) I $G(PSOBARS) S X="S",X2=PSOINST_"-"_RX S X1=$X W ?102,@PSOBAR1,X2,@PSOBAR0,$C(13) S $X=0 "RTN","PSOLBLN",90,0) L13 I $G(WARN)'="",'$G(PSOBLALL) I '$G(PSDFNFLG),'$G(PSOLAPPL) D WARN^PSOLBL2 "RTN","PSOLBLN",91,0) W @IOF "RTN","PSOLBLN",92,0) REP I COPIES>0 S SIDE=1 G ST "RTN","PSOLBLN",93,0) D NOW^%DTC S NOW=% K %,%H,%I I $G(RXF)="" S RXF=0 F I=0:0 S I=$O(^PSRX(RX,1,I)) Q:'I S RXF=I "RTN","PSOLBLN",94,0) S IR=0 F FDA=0:0 S FDA=$O(^PSRX(RX,"L",FDA)) Q:'FDA S IR=FDA "RTN","PSOLBLN",95,0) S IR=IR+1,^PSRX(RX,"L",0)="^52.032DA^"_IR_"^"_IR "RTN","PSOLBLN",96,0) S ^PSRX(RX,"L",IR,0)=NOW_"^"_$S($G(RXP):99-RXPI,1:RXF)_"^"_$S($G(PCOMX)]"":$G(PCOMX),$G(PCOMH(RX))]"":PCOMH(RX),1:"From RX number "_$P(^PSRX(RX,0),"^"))_$S($G(RXP):" (Partial)",1:"")_$S($D(REPRINT):" (Reprint)",1:"")_"^"_PDUZ "RTN","PSOLBLN",97,0) N PSOBADR,PSOTEMP "RTN","PSOLBLN",98,0) S PSOBADR=$$CHKRX^PSOBAI(RX) "RTN","PSOLBLN",99,0) I $G(PSOBADR) S PSOTEMP=$P(PSOBADR,"^",2),PSOBADR=$P(PSOBADR,"^") "RTN","PSOLBLN",100,0) I $G(PSOBADR),'$G(PSOTEMP) D "RTN","PSOLBLN",101,0) .S IR=IR+1,^PSRX(RX,"L",0)="^52.032DA^"_IR_"^"_IR "RTN","PSOLBLN",102,0) .S ^PSRX(RX,"L",IR,0)=NOW_"^"_$S($G(RXP):99-RXPI,1:RXF)_"^"_"ROUTING="_$G(MW)_" (BAD ADDRESS)"_"^"_PDUZ "RTN","PSOLBLN",103,0) S ^PSRX(RX,"TYPE")=0 K RXF,IR,FDA,NOW,I,PCOMH(RX) "RTN","PSOLBLN",104,0) I $G(WARN)'="" I $G(PSDFNFLG)!($G(PSOLAPPL)) D ALLWARN^PSOLBLN1 "RTN","PSOLBLN",105,0) I $G(WARN)="" I $G(PSDFNFLG)!($G(PSOLAPPL)) D ALL^PSOLBLS "RTN","PSOLBLN",106,0) I $G(PSOBLALL) D:$G(WARN)="" ALL^PSOLBLS D:$G(WARN)'="" ALLWARN^PSOLBLN1 "RTN","PSOLBLN",107,0) I '$D(PSSPND),$P(PSOPAR,"^",18) I $G(PSDFNFLG)!($G(PSOLAPPL))!($G(PSOBLALL)) D CHCK2^PSOTRLBL "RTN","PSOLBLN",108,0) D:$G(PSOBLALL) TRAIL^PSOLBL2 "RTN","PSOLBLN",109,0) END ; "RTN","PSOLBLN",110,0) I $D(RXFLX(RX)) S RXFL(RX)=$G(RXFLX(RX)) K RXFLX "RTN","PSOLBLN",111,0) D KILL^PSOLBL2 Q "RTN","PSOLLL8") 0^28^B28083638^B27800299 "RTN","PSOLLL8",1,0) PSOLLL8 ;BIR/JLC - LASER LABEL - CRITICAL INTERACTION ;12/13/02 "RTN","PSOLLL8",2,0) ;;7.0;OUTPATIENT PHARMACY;**120,251,387**;DEC 1997;Build 13 "RTN","PSOLLL8",3,0) ;Reference to PS(56 supported by DBIA 2229 "RTN","PSOLLL8",4,0) ;Reference to PSDRUG supported by DBIA 221 "RTN","PSOLLL8",5,0) ;External reference to $$DS^PSSDSAPI supported by DBIA 5424 "RTN","PSOLLL8",6,0) ; "RTN","PSOLLL8",7,0) S HOLDCOPY=COPIES "RTN","PSOLLL8",8,0) START ; "RTN","PSOLLL8",9,0) ; "RTN","PSOLLL8",10,0) I $G(PSOIO("CDII"))]"" X PSOIO("CDII") "RTN","PSOLLL8",11,0) I $G(PSOIO(PSOFONT))]"" X PSOIO(PSOFONT) "RTN","PSOLLL8",12,0) K PSOSERV N PSODOSEW,PSODRGI,PSRXSET S (PSODOSEW,PSODRGI)=0 "RTN","PSOLLL8",13,0) S COPIES=COPIES-1,Y=$P(^PSRX(RX,2),"^",6) X ^DD("DD") S EXPDT=Y,Y=$P(^PSRX(RX,0),"^",13) X ^DD("DD") S ISD=Y "RTN","PSOLLL8",14,0) S Y=DATE X ^DD("DD") S DATE1=Y D NOW^%DTC S Y=% X ^DD("DD") S NOW=Y "RTN","PSOLLL8",15,0) I '$D(^PS(52.4,RX,0)),$P(^PSRX(RX,"STA"),"^")=4 D UNKNOWN Q "RTN","PSOLLL8",16,0) I '$G(RXRP(RX)) S T=$P(PS2,"^",2)_" "_"("_$P(RXY,"^",16)_"/"_$S(+$G(VRPH):VRPH,1:" ")_")"_" "_$P(NOW,":",1,2) D PRINT(T) "RTN","PSOLLL8",17,0) 2 ; "RTN","PSOLLL8",18,0) I $D(^PSRX(RX,"DRI")) D M1 S SCRIPT=$P(^PSRX(RX,"DRI"),"^",2),SEV=$P(^PSRX(RX,"DRI"),"^") F X=1:1 S RXX(X)=$P(SCRIPT,",",X),SEV(X)=$P(SEV,",",X) Q:RXX(X)="" D "RTN","PSOLLL8",19,0) .S:SEV(X)=1 PSOSERV=1 "RTN","PSOLLL8",20,0) .S T=$P($G(^PSRX(RXX(X),0)),"^")_" "_$S(SEV(X)=1:"CRITICAL",SEV(X)=2:"SIGNIFICANT",1:"UNKNOWN")_" INTERACTION "_$P(^PSDRUG($P(^PSRX(RXX(X),0),"^",6),0),"^") S:SEV(X)=1 PSODRGI=1 D PRINT(T) "RTN","PSOLLL8",21,0) I '$D(^PSRX(RX,"DRI")),$D(^PS(52.4,RX,0)) S SCRIPT=$P(^PS(52.4,RX,0),"^",10),SEV=$P(^PS(52.4,RX,0),"^",9) D M2:SCRIPT="" I SCRIPT'="" D M1 F X=1:1 S RXX(X)=$P(SCRIPT,",",X),SEV(X)=$P(SEV,",",X) Q:RXX(X)="" D "RTN","PSOLLL8",22,0) .S:SEV(X)=1 PSOSERV=1 "RTN","PSOLLL8",23,0) .S T=$P($G(^PSRX(RXX(X),0)),"^")_" "_$S(SEV(X)=1:"CRITICAL",SEV(X)=2:"SIGNIFICANT",1:"UNKNOWN")_" INTERACTION "_$P(^PSDRUG($P(^PSRX(RXX(X),0),"^",6),0),"^") S:SEV(X)=1 PSODRGI=1 D PRINT(T) "RTN","PSOLLL8",24,0) I $$DS^PSSDSAPI,($D(^PS(52.4,RX,1))) S T="",T=$P(^PS(52.4,RX,1),"^") D D:T'="" PRINT(T) "RTN","PSOLLL8",25,0) . S T=$S(T=3:"MAX SINGLE DOSE & DAILY DOSE RANGE",T=2:"MAX SINGLE DOSE",T=1:"DAILY DOSE RANGE",1:""),PSODOSEW=1 "RTN","PSOLLL8",26,0) S T="This prescription was entered by: "_TECH_"." D PRINT(T) "RTN","PSOLLL8",27,0) S T="This prescription "_$S('$G(PSOSERV):"may require",1:"requires")_" "_$S('$G(PSOSERV):"reviewing",1:"intervention")_" by a pharmacist." D PRINT(T) "RTN","PSOLLL8",28,0) S T=DATE1_" Fill "_(RXF+1)_" of "_(1+$P(RXY,"^",9)) D PRINT(T) "RTN","PSOLLL8",29,0) S T=PNM_" "_SSNP D PRINT(T) "RTN","PSOLLL8",30,0) F SSG=1:1 Q:$G(SGY(SSG))="" S T=SGY(SSG) D PRINT(T) "RTN","PSOLLL8",31,0) S T="Qty: "_$G(QTY)_" "_$G(PHYS) D PRINT(T) "RTN","PSOLLL8",32,0) S T="Tech__________RPh__________" D PRINT(T) "RTN","PSOLLL8",33,0) S T=DRUG D PRINT(T) "RTN","PSOLLL8",34,0) S T="Routing: "_$S("W"[$E(MW):MW,1:MW_" MAIL") D PRINT(T) "RTN","PSOLLL8",35,0) S T="Days supply: "_$G(DAYS)_" Cap: "_$S(PSCAP:"**NON-SFTY**",1:"SAFETY") D PRINT(T) "RTN","PSOLLL8",36,0) S T="Isd: "_ISD_" Exp: "_EXPDT D PRINT(T) "RTN","PSOLLL8",37,0) S T="Last Fill: "_$G(PSOFLAST) D PRINT(T) "RTN","PSOLLL8",38,0) S T="Pat. Stat "_PATST_" Clinic: "_PSCLN D PRINT(T) "RTN","PSOLLL8",39,0) W @IOF "RTN","PSOLLL8",40,0) I COPIES>0 G START "RTN","PSOLLL8",41,0) S COPIES=HOLDCOPY K HOLDCOPY "RTN","PSOLLL8",42,0) STORE ;LABEL PRINT NODE "RTN","PSOLLL8",43,0) D NOW^%DTC S NOW=% K %,%H,%I I $G(RXF)="" S RXF=0 F I=0:0 S I=$O(^PSRX(RX,1,I)) Q:'I S RXF=I "RTN","PSOLLL8",44,0) F IR=0 F FDA=0:0 S FDA=$O(^PSRX(RX,"L",FDA)) Q:'FDA S IR=FDA "RTN","PSOLLL8",45,0) ;S IR=IR+1,^PSRX(RX,"L",0)="^52.032DA^"_IR_"^"_IR,^PSRX(RX,"L",IR,0)=NOW_"^"_RXF_"^"_$S($G(PCOMX)]"":$G(PCOMX),1:"From RX number "_$P(^PSRX(RX,0),"^"))_" Drug-Drug interaction"_$S($G(RXRP(RX)):" (Reprint)",1:"")_"^"_PDUZ_"^1" "RTN","PSOLLL8",46,0) S IR=IR+1,PSRXSET="^52.032DA^"_IR_"^"_IR "RTN","PSOLLL8",47,0) S PSRXSET=NOW_"^"_RXF_"^"_$S($G(PCOMX)]"":$G(PCOMX),1:"From RX number "_$P(^PSRX(RX,0),"^")) "RTN","PSOLLL8",48,0) S PSRXSET=PSRXSET_$S(PSODRGI&(PSODOSEW)&$$DS^PSSDSAPI:" Drug-Drug interaction/dose warning",PSODRGI:" Drug-Drug interaction",PSODOSEW&$$DS^PSSDSAPI:" Dose Warning",1:"")_$S($G(RXRP(RX)):" (Reprint)",1:"")_"^"_PDUZ_"^1" "RTN","PSOLLL8",49,0) S ^PSRX(RX,"L",IR,0)=PSRXSET "RTN","PSOLLL8",50,0) K:$D(^PS(52.4,RX,0)) RXF,IR,FDA,NOW,I "RTN","PSOLLL8",51,0) END K:$D(^PS(52.4,RX,0)) PSCLN,DATE1,DRUG,RFLMSG,COPIES,DRUG,LMI,LINE,PS,PS1,PS2,INT,ISD,I1,MW,STATE,SIDE,SGY,PATST,PRTFL,PHYS,SGC,VRPH,NLWS,X1,X2,X,Y,TECH,EXPDT,NURSE,SEV,SCRIPT,RXX,SGY,SER,SSG,RXY,SIGPH,PS55,PS55X K PSOSERV "RTN","PSOLLL8",52,0) Q "RTN","PSOLLL8",53,0) UNKNOWN S PSOY=PSOY+(3*PSOYI),T="",$P(T,"*",100)="" D PRINT(T) "RTN","PSOLLL8",54,0) S T="THIS PRESCRIPTION HAS CAUSED A DRUG-DRUG INTERACTION " D PRINT(T) "RTN","PSOLLL8",55,0) S T="",$P(T,"*",100)="" D PRINT(T) "RTN","PSOLLL8",56,0) S T="PRESCRIPTION # "_$P(^PSRX(RX,0),"^")_" "_$P(^PSDRUG($P(^PSRX(RX,0),"^",6),0),"^") D PRINT(T) "RTN","PSOLLL8",57,0) S T="The above prescription has a status of PENDING due to a DRUG-DRUG INTERACTION." D PRINT(T) "RTN","PSOLLL8",58,0) S T=PNM_" "_SSNP D PRINT(T) "RTN","PSOLLL8",59,0) S T=$P(PS2,"^",2)_" ("_$P(RXY,"^",16)_"/"_$S(+$G(VRPH):VRPH,1:" ")_")"_" "_$P($P(NOW,":",1,2),"@") D PRINT(T) "RTN","PSOLLL8",60,0) S T=RXN_" "_DATE1_" Fill "_(RXF+1)_" of "_(1+$P(RXY,"^",9)) D PRINT(T) "RTN","PSOLLL8",61,0) F SSG=1:1 Q:$G(SGY(SSG))="" S T=SGY(SSG) D PRINT(T) "RTN","PSOLLL8",62,0) S PSOY=PSOY+PSOYI,T="Please review printouts of all labels for this patient that follow." D PRINT(T),STORE "RTN","PSOLLL8",63,0) W @IOF K PSCLN,DATE1,DRUG,RFLMSG,COPIES,DRUG,LMI,LINE,PS,PS1,PS2,INT,ISD,I1,MW,STATE,SIDE,SIGPH,SGY,PATST,PRTFL,PHYS,SGC,VRPH,NLWS,X1,X2,X,Y,TECH,EXPDT,NURSE,SEV,SCRIPT,RXX,SGY,SER,SSG,RXY,PSOSERV Q "RTN","PSOLLL8",64,0) ; "RTN","PSOLLL8",65,0) PRINT(T) ; "RTN","PSOLLL8",66,0) I $G(PSOIO("ST"))]"" X PSOIO("ST") "RTN","PSOLLL8",67,0) W T,! "RTN","PSOLLL8",68,0) I $G(PSOIO("ET"))]"" X PSOIO("ET") "RTN","PSOLLL8",69,0) Q "RTN","PSOLLL8",70,0) ; "RTN","PSOLLL8",71,0) M1 ; "RTN","PSOLLL8",72,0) S PSOY=PSOY+PSOYI,T="Rx# "_RXN_" has caused a DRUG-DRUG INTERACTION with the following prescription(s):" D PRINT(T) "RTN","PSOLLL8",73,0) Q "RTN","PSOLLL8",74,0) M2 ; "RTN","PSOLLL8",75,0) S PSOY=PSOY+PSOYI,T="",T="Rx# "_RXN D PRINT(T) "RTN","PSOLLL8",76,0) Q "RTN","PSOLLLI") 0^12^B82644773^B67875911 "RTN","PSOLLLI",1,0) PSOLLLI ;BIR/JLC - LASER LABELS INITIALIZATION ;11/20/08 12:17pm "RTN","PSOLLLI",2,0) ;;7.0;OUTPATIENT PHARMACY;**120,157,189,161,244,200,206,225,303,266,326,251,387**;DEC 1997;Build 13 "RTN","PSOLLLI",3,0) ;DBIAs PSDRUG-221, PS(55-2228, SC-10040, IBARX-125, PSXSRP-2201, %ZIS-3435, DPT-3097, ^TMP($J,"PSNPPIO"-3794 "RTN","PSOLLLI",4,0) ;External reference to DRUG^PSSWRNA supported by DBIA 4449 "RTN","PSOLLLI",5,0) ;External reference to $$DS^PSSDSAPI supported by DBIA 5425 "RTN","PSOLLLI",6,0) ;External reference to ^DIC(5 supported by DBIA 4293 "RTN","PSOLLLI",7,0) ;External reference to ^SC( supported by DBIA 2675 "RTN","PSOLLLI",8,0) ;External reference to $$DS^PSSDSAPI supported by DBIA 5425 "RTN","PSOLLLI",9,0) ; "RTN","PSOLLLI",10,0) ;*244 remove test for partial fill when testing status > 11 "RTN","PSOLLLI",11,0) ; "RTN","PSOLLLI",12,0) DQ N PSOBIO S (I,PSOIO)=0 F S I=$O(^%ZIS(2,IOST(0),55,I)) Q:'I S X0=$G(^(I,0)) I X0]"" S PSOIO($P(X0,"^"))=^(1),PSOIO=1 "RTN","PSOLLLI",13,0) DQ1 I '$D(PPL) G HLEX "RTN","PSOLLLI",14,0) I $P($G(PSOPAR),"^",30)=2,'$G(PSOEXREP) G HLEX "RTN","PSOLLLI",15,0) K RXFLX S PSOCKHN=","_$G(PPL),PSRESOLV=+PPL D CHECK "RTN","PSOLLLI",16,0) S PSOINT=1 F PI=1:1 S RX=$P(PPL,",",PI) Q:RX="" D "RTN","PSOLLLI",17,0) . S RXY=$G(^PSRX(RX,0)) Q:RXY="" I PSOPDFN'=$P(RXY,"^",2),'PSOINT D TRAIL^PSOLLL1 S PSOPDFN=$P(RXY,"^",2) "RTN","PSOLLLI",18,0) . K RXP,REPRINT D C "RTN","PSOLLLI",19,0) I 'PSOINT D TRAIL^PSOLLL1 "RTN","PSOLLLI",20,0) HLEX K RXPI,PSORX,RXP,PSOIOS,PSOLAPPL,XXX,COPAYVAR,TECH,PHYS,MFG,NURSE,STATE,SIDE,COPIES,EXDT,ISD,PSOINST,RXN,RXY,VADT,DEA,WARN,FDT,QTY,PATST,PDA,PS,PS1,RXP,REPRINT "RTN","PSOLLLI",21,0) K SGY,OSGY,PS2,PSL,PSNP,INRX,RR,XTYPE,SSNP,SSNPN,PNM,ADDR,PSODBQ,PSOLASTF,PSRESOLV,PSOEXREP,PSOSXQ "RTN","PSOLLLI",22,0) K DATE,DR,DRUG,LINE,MW,PRTFL,VRPH,EXPDT,X2,DIFF,DAYS,PSZIP,PSOHZIP,PS55,PS55X,REF "RTN","PSOLLLI",23,0) K ^TMP($J,"PSNPMI"),^TMP($J,"PSOCP",+$G(PSOCPN)),PSOCPN,PSOLBLDR,PSOLBLPS,PSOLBLCP,RXPR,RXRP,RXRS,PSOCKHN,RXFLX,PSOLAPPL,PSOPDFN,PSDFNFLG,PSOZERO,NEXTRX,PSOBLALL,STA "RTN","PSOLLLI",24,0) I '$G(PSOSUREP),'$G(PSOSUSPR) S ZTREQ="@" "RTN","PSOLLLI",25,0) Q "RTN","PSOLLLI",26,0) C N PSOBIO S (I,PSOIO)=0 F S I=$O(^%ZIS(2,IOST(0),55,I)) Q:'I S X0=$G(^(I,0)) I X0]"" S PSOIO($P(X0,"^"))=^(1),PSOIO=1 "RTN","PSOLLLI",27,0) U IO Q:'$D(^PSRX(RX,0)) S RXY=^(0),RX2=^(2),RXSTA=^("STA") K SGY,OSGY "RTN","PSOLLLI",28,0) S (SIGM,PFM,PMIM,L2,L3,L4,L5,FILLCONT,BOTTLBL)=0 "RTN","PSOLLLI",29,0) K SIGF,PFF,PMIF S (SIGF,PFF,PMIF)=0 F I="DR","T" S (SIGF(I),PFF(I))=1 "RTN","PSOLLLI",30,0) F I="A","B","I" S PMIF(I)=1 "RTN","PSOLLLI",31,0) D NOW^%DTC S Y=$P(%,"."),PSOFNOW=% X ^DD("DD") S PSONOW=Y,Y=PSOFNOW X ^DD("DD") S PSONOWT=Y "RTN","PSOLLLI",32,0) S:$G(PSOBLALL) PSOBLRX=RX S:$D(RXRP(RX)) REPRINT=1 S:$D(RXPR(RX)) RXP=RXPR(RX) "RTN","PSOLLLI",33,0) I $G(PSOSUREP)!($G(PSOEXREP)) S REPRINT=1 I '$G(RXRP(RX)) S RXRP(RX)=1 "RTN","PSOLLLI",34,0) S A=$P(RXSTA,"^") I A>11 D AL^PSOLBL("QT") K RXP,REPRINT Q ;*244 "RTN","PSOLLLI",35,0) I A=3 D AL^PSOLBL("QT") K RXP,REPRINT Q "RTN","PSOLLLI",36,0) I $G(RXPR(RX)),'$D(^PSRX(RX,"P",RXP,0)) K RXP,REPRINT Q "RTN","PSOLLLI",37,0) I $P($G(RXFL(RX)),"^"),'$D(^PSRX(RX,1,$P($G(RXFL(RX)),"^"),0)) K RXP,REPRINT Q "RTN","PSOLLLI",38,0) I $G(PSODBQ)!($G(RXRS(RX))) S RR=$O(^PS(52.5,"B",RX,0)) Q:'RR I $G(^PS(52.5,RR,"P"))=1 K RXP,REPRINT Q "RTN","PSOLLLI",39,0) I $G(RXRS(RX))!($G(PSOPULL)) S PSOSXQ=0 N DR,DA,DIE D I $G(PSOSXQ) K RXP,REPRINT Q "RTN","PSOLLLI",40,0) . S DA=$O(^PS(52.5,"B",RX,0)) Q:'DA "RTN","PSOLLLI",41,0) . S A=$P($G(^PS(52.5,DA,0)),"^",7) I A="" Q "RTN","PSOLLLI",42,0) . I A="Q" S DIE="^PS(52.5,",DR="3////P" D ^DIE Q "RTN","PSOLLLI",43,0) . K RXRS(RX) S PSOSXQ=1 "RTN","PSOLLLI",44,0) I $G(PSRESOLV)=RX D ENLBL^PSOBSET K PSRESOLV "RTN","PSOLLLI",45,0) I $P(RXSTA,"^")'=4 D "RTN","PSOLLLI",46,0) . I $G(PSOSUSPR) D AREC^PSOSUTL "RTN","PSOLLLI",47,0) . I $G(PSOPULL)!($G(RXRS(RX))) D AREC1^PSOSUTL "RTN","PSOLLLI",48,0) . I $G(PSOSUREP) D AREC^PSOSUSRP "RTN","PSOLLLI",49,0) . I $G(PSXREP) D AREC^PSXSRP "RTN","PSOLLLI",50,0) S RXY=^PSRX(RX,0),RX2=^(2),RXSTA=^("STA") "RTN","PSOLLLI",51,0) K ^UTILITY("DIQ1",$J) S DA=$P($$SITE^VASITE(),"^") "RTN","PSOLLLI",52,0) I $G(DA) S DIC=4,DIQ(0)="I",DR="99" D EN^DIQ1 S PSOINST=$G(^UTILITY("DIQ1",$J,4,DA,99,"I")) K ^UTILITY("DIQ1",$J),DA,DR,DIC "RTN","PSOLLLI",53,0) S RXN=$P(RXY,"^"),DFN=+$P(RXY,"^",2),PSOLBLPS=+$P(RXY,"^",3),PSOLBLDR=+$P(RXY,"^",6) "RTN","PSOLLLI",54,0) S ISD=$P(RXY,"^",13),RXF=0,SIG=$P($G(^PSRX(RX,"SIG")),"^"),ISD=$E(ISD,4,5)_"/"_$E(ISD,6,7)_"/"_($E(ISD,1,3)+1700),ZY=0,$P(LINE,"_",28)="_" "RTN","PSOLLLI",55,0) S NURSE=$S($P($G(^DPT(DFN,"NHC")),"^")="Y":1,$P($G(^PS(55,DFN,40)),"^"):1,1:0) "RTN","PSOLLLI",56,0) S FDT=$P(RX2,"^",2),PS=$S($D(^PS(59,PSOSITE,0)):^(0),1:""),PS1=$S($D(^(1)):^(1),1:""),PSOSITE7=$P(^("IB"),"^") "RTN","PSOLLLI",57,0) S PS2=$P(PS,"^")_"^"_$P(PS,"^",6) "RTN","PSOLLLI",58,0) S EXPDT=$P(RX2,"^",6),EXDT=$S('EXPDT:"",1:$E(EXPDT,4,5)_"/"_$E(EXPDT,6,7)_"/"_($E(EXPDT,1,3)+1700)) "RTN","PSOLLLI",59,0) S COPIES=$S($P($G(RXRP(RX)),"^",2):$P($G(RXRP(RX)),"^",2),$P(RXY,"^",18)]"":$P(RXY,"^",18),1:1) "RTN","PSOLLLI",60,0) K PSOCKHNX S PSOCKHL=$L(RX),PSOCKHN=$E($G(PSOCKHN),(PSOCKHL+2),999) D K PSOCKHNX,PSOCKHL,PSOCKHA "RTN","PSOLLLI",61,0) .S PSOCKHA=","_RX_"," "RTN","PSOLLLI",62,0) .I PSOCKHN'[PSOCKHA Q "RTN","PSOLLLI",63,0) .S PSOCKHA=$E(PSOCKHA,1,($L(PSOCKHA)-1)) "RTN","PSOLLLI",64,0) .S PSOCKHNX=$L(PSOCKHN,PSOCKHA)-1 "RTN","PSOLLLI",65,0) .I +$G(PSOCKHNX)>0 D DOUB "RTN","PSOLLLI",66,0) I $O(^PSRX(RX,1,0)),$G(RXFL(RX))'=0 S $P(^PSRX(RX,3),"^",6)="" K ^PSRX(RX,"DAI"),^PSRX(RX,"DRI") "RTN","PSOLLLI",67,0) I '$G(RXP),'$O(^PSRX(RX,1,0)) S RXFL(RX)=0 "RTN","PSOLLLI",68,0) I '$G(RXP) D OSET I '$O(^PSRX(RX,1,0))!($G(RXFL(RX))=0) G ORIG "RTN","PSOLLLI",69,0) I $O(^PSRX(RX,1,0)),'$G(RXP) D G STA "RTN","PSOLLLI",70,0) . I '$G(RXFL(RX)) S XTYPE=1 D REF "RTN","PSOLLLI",71,0) I $G(RXP) S XTYPE="P" D REF G STA "RTN","PSOLLLI",72,0) ORIG S TECH=$P($G(^VA(200,+$P(RXY,"^",16),0)),"^"),PHYS=$S($D(^VA(200,+$P(RXY,"^",4),0)):$P(^(0),"^"),1:"UKN") "RTN","PSOLLLI",73,0) S DAYS=$P(RXY,"^",8),QTY=$P(RXY,"^",7) "RTN","PSOLLLI",74,0) D 6^VADPT,PID^VADPT6 S SSNPN="" "RTN","PSOLLLI",75,0) STA ; "RTN","PSOLLLI",76,0) S STATE=$S($D(^DIC(5,+$P(PS,"^",8),0)):$P(^(0),"^",2),1:"UKN") "RTN","PSOLLLI",77,0) S DRUG=$$ZZ^PSOSUTL(RX),DEA=$P($G(^PSDRUG(+$P(RXY,"^",6),0)),"^",3),WARN=$P($G(^(0)),"^",8) "RTN","PSOLLLI",78,0) S WARN=$$DRUG^PSSWRNA(+$P(RXY,"^",6),+$P(RXY,"^",2)) "RTN","PSOLLLI",79,0) S SIDE=$S($P($G(RXRP(RX)),"^",3):1,1:0) "RTN","PSOLLLI",80,0) I $G(^PSRX(RX,"P",+$G(RXP),0))]"" S RXPI=RXP D "RTN","PSOLLLI",81,0) .S RXP=^PSRX(RX,"P",RXP,0) "RTN","PSOLLLI",82,0) .S RXY=$P(RXP,"^")_"^"_$P(RXY,"^",2,6)_"^"_$P(RXP,"^",4)_"^"_$P(RXP,"^",10)_"^"_$P(RXY,"^",9)_"^"_$P($G(^PSRX(RX,"SIG")),"^",2)_"^"_$P(RXP,"^",2)_"^"_$P(RXY,"^",12,14)_"^"_$P(^PSRX(RX,"STA"),"^")_"^"_$P(RXP,"^",7)_"^"_$P(RXY,"^",17,99) "RTN","PSOLLLI",83,0) .S FDT=$P(RXP,"^") "RTN","PSOLLLI",84,0) S MW=$P(RXY,"^",11) I $G(RXFL(RX))'=0 D:$G(RXFL(RX)) I '$G(RXFL(RX)) F I=0:0 S I=$O(^PSRX(RX,1,I)) Q:'I S RXF=RXF+1 S:'$G(RXP) MW=$P(^PSRX(RX,1,I,0),"^",2) I +^PSRX(RX,1,I,0)'30) "RTN","PSOLLLI",90,0) .K PSMP(PSI) "RTN","PSOLLLI",91,0) ;New mail codes for CMOP "RTN","PSOLLLI",92,0) S MAILCOM="" "RTN","PSOLLLI",93,0) S X=$G(^PS(55,DFN,0)),PSCAP=$P(X,"^",2),PS55=$P(X,"^",3),PS55X=$P(X,"^",5) "RTN","PSOLLLI",94,0) I PS55X]"",PS55>1,PS55X
0,$P(^("STA"),"^")'=2,'$G(PSODBQ) D SNO G LBL "RTN","PSOLLLI",109,0) I $G(PSOLBLCP)="" D IBCP "RTN","PSOLLLI",110,0) N PSOQI S PSOQI=$G(^PSRX(RX,"IBQ")) "RTN","PSOLLLI",111,0) I $G(PSOLBLCP)=0 D SNO G LBL "RTN","PSOLLLI",112,0) I $G(PSOLBLCP)=1 I $P(PSOQI,"^",2)!($P(PSOQI,"^",3))!($P(PSOQI,"^",4))!($P(PSOQI,"^",5))!($P(PSOQI,"^",6))!($P(PSOQI,"^",7))!($P(PSOQI,"^",8)) D SNO G LBL "RTN","PSOLLLI",113,0) I $G(PSOLBLCP)=2 I $P(PSOQI,"^")!($P(PSOQI,"^",2))!($P(PSOQI,"^",3))!($P(PSOQI,"^",4))!($P(PSOQI,"^",5))!($P(PSOQI,"^",6))!($P(PSOQI,"^",7))!($P(PSOQI,"^",8)) D SNO G LBL "RTN","PSOLLLI",114,0) I $G(PSOLBLCP)=2,'$P($G(^PSRX(RX,"IB")),"^") D SNO G LBL "RTN","PSOLLLI",115,0) S PSOCPN=$P(RXY,"^",2),INRX=$P(RXY,"^") "RTN","PSOLLLI",116,0) I $G(^TMP($J,"PSOCP",PSOCPN))="" S ^(PSOCPN)=PSOCPN "RTN","PSOLLLI",117,0) S ^TMP($J,"PSOCP",PSOCPN,INRX)=INRX_"^"_$$ZZ^PSOSUTL(RX)_"^"_+$G(DAYS),COPAYVAR="COPAY" K ZDRUG "RTN","PSOLLLI",118,0) LBL I $G(PSOIO("LLI"))]"" X PSOIO("LLI") "RTN","PSOLLLI",119,0) ; "RTN","PSOLLLI",120,0) N PSODDFLG,PSODWARN,PSOSIGNIF S PSODWARN=0 D "RTN","PSOLLLI",121,0) .I $D(^PSRX(RX,"DRI")),$P(^PSRX(RX,"DRI"),"^")[1 S PSODWARN=1 ;must have a critical drug interaction to print tech warning label "RTN","PSOLLLI",122,0) .I '$D(^PSRX(RX,"DRI")),$D(^PS(52.4,RX,0)),$P(^PS(52.4,RX,0),"^",9)[1 S PSODWARN=1 ;must have a critical drug interaction to print tech warning label "RTN","PSOLLLI",123,0) .I $D(^PS(52.4,RX,0)),$P(^PS(52.4,RX,0),"^",9)'[1,$P(^PS(52.4,RX,0),"^",9)[2 S PSOSIGNIF=1 "RTN","PSOLLLI",124,0) .I $$DS^PSSDSAPI,($D(^PS(52.4,RX,1))) S PSODWARN=1 ;dose warnings should print a tech warning label "RTN","PSOLLLI",125,0) ; "RTN","PSOLLLI",126,0) G ^PSOLLL8:($P(RXSTA,"^")=4!$G(PSODWARN))&'$G(RXF)&'$G(RXP) ;print warning label for critical interaction and dose warnings "RTN","PSOLLLI",127,0) I '$G(PSODGETA) D ^PSOLLL8:$D(^PSRX(RX,"DRI"))&('$G(RXF))&('$G(RXP)) ;print warning label for significant interactions "RTN","PSOLLLI",128,0) I '$G(PSODGETA),$G(PSOSIGNIF),$D(^PSRX(RX,"DRI"))&('$G(RXF))&('$G(RXP)) S PSODGETA=1 D C "RTN","PSOLLLI",129,0) K PSODGETA "RTN","PSOLLLI",130,0) I $$DS^PSSDSAPI,'$G(RXF),'$G(RXP) Q:$D(^PS(52.4,RX,1)) ;already printed warning label above, quit if dose warning and don't print bottle label "RTN","PSOLLLI",131,0) Q:(($P(^PSRX(RX,"STA"),"^")=4!($P($G(^PSRX(RX,"DRI")),"^",1)[1))&('$G(RXF))&('$G(RXP))) "RTN","PSOLLLI",132,0) ; "RTN","PSOLLLI",133,0) LBL2 ; "RTN","PSOLLLI",134,0) I $P($G(^PSRX(RX,3)),"^",6),'$G(RXF),'$G(RXP) D ^PSOLLL9 "RTN","PSOLLLI",135,0) S PSOINT=0 G ^PSOLLL1 "RTN","PSOLLLI",136,0) REF F XXX=0:0 S XXX=$O(^PSRX(RX,XTYPE,XXX)) Q:+XXX'>0 D "RTN","PSOLLLI",137,0) .S TECH=$S($D(^VA(200,+$P(^PSRX(RX,XTYPE,XXX,0),"^",7),0)):$P(^(0),"^"),1:"UNKNOWN") "RTN","PSOLLLI",138,0) .S QTY=$P(^PSRX(RX,XTYPE,XXX,0),"^",4),PHYS=$S($D(^VA(200,+$P(^PSRX(RX,XTYPE,XXX,0),"^",17),0)):$P(^(0),"^"),$D(^VA(200,+$P(^PSRX(RX,0),"^",4),0)):$P(^(0),"^"),1:"UNKNOWN") D 6^VADPT,PID^VADPT6 S SSNPN="" "RTN","PSOLLLI",139,0) .S DAYS=$P(^PSRX(RX,XTYPE,XXX,0),"^",10) "RTN","PSOLLLI",140,0) Q "RTN","PSOLLLI",141,0) CHECK S PSDFNFLG=0,PSOZERO=$P(PPL,","),PSOPDFN=$P(^PSRX(PSOZERO,0),"^",2) "RTN","PSOLLLI",142,0) Q "RTN","PSOLLLI",143,0) OSET ; "RTN","PSOLLLI",144,0) N A "RTN","PSOLLLI",145,0) I $G(RXFL(RX))']""!($G(RXFL(RX))=0) D Q "RTN","PSOLLLI",146,0) .S A=^PSRX(RX,0) "RTN","PSOLLLI",147,0) .S TECH=$P($G(^VA(200,+$P(A,"^",16),0)),"^"),QTY=$P(A,"^",7),PHYS=$S($D(^VA(200,+$P(A,"^",4),0)):$P(^(0),"^"),1:"UKN") D 6^VADPT,PID^VADPT6 S SSNPN="" "RTN","PSOLLLI",148,0) .S DAYS=$P(A,"^",8) "RTN","PSOLLLI",149,0) I '$D(^PSRX(RX,1,RXFL(RX),0)) K RXFL(RX) Q "RTN","PSOLLLI",150,0) S A=^PSRX(RX,1,RXFL(RX),0) "RTN","PSOLLLI",151,0) S TECH=$S($D(^VA(200,+$P(A,"^",7),0)):$P(^(0),"^"),1:"UNKNOWN") "RTN","PSOLLLI",152,0) S QTY=$P(A,"^",4),PHYS=$S($D(^VA(200,+$P(A,"^",17),0)):$P(^(0),"^"),$D(^VA(200,+$P(^PSRX(RX,0),"^",4),0)):$P(^(0),"^"),1:"UNKNOWN") D 6^VADPT,PID^VADPT6 S SSNPN="" "RTN","PSOLLLI",153,0) S DAYS=$P(A,"^",10) "RTN","PSOLLLI",154,0) Q "RTN","PSOLLLI",155,0) DOUB ; "RTN","PSOLLLI",156,0) Q:'$D(RXFL(RX)) "RTN","PSOLLLI",157,0) I +$G(RXFL(RX))-PSOCKHNX<0 Q "RTN","PSOLLLI",158,0) S RXFLX(RX)=$G(RXFL(RX)) "RTN","PSOLLLI",159,0) S RXFL(RX)=$G(RXFL(RX))-PSOCKHNX "RTN","PSOLLLI",160,0) Q "RTN","PSOLLLI",161,0) IBCP ; "RTN","PSOLLLI",162,0) N X,Y,PSOJJ,PSOLL "RTN","PSOLLLI",163,0) S PSOLBLCP="" "RTN","PSOLLLI",164,0) S X=$P($G(^PS(59,+$G(PSOSITE),"IB")),"^")_"^"_$G(DFN) D XTYPE^IBARX "RTN","PSOLLLI",165,0) S PSOJJ="" F S PSOJJ=$O(Y(PSOJJ)) Q:'PSOJJ S PSOLL="" F S PSOLL=$O(Y(PSOJJ,PSOLL)) Q:PSOLL="" S:PSOLL>0 PSOLBLCP=PSOLL "RTN","PSOLLLI",166,0) I '$G(PSOLBLCP) S PSOLBLCP=0 "RTN","PSOLLLI",167,0) Q "RTN","PSOLLLI",168,0) SNO ; "RTN","PSOLLLI",169,0) S COPAYVAR="NO COPAY" "RTN","PSOLLLI",170,0) Q "RTN","PSOLMAO") 0^18^B1859588^B1822420 "RTN","PSOLMAO",1,0) PSOLMAO ;BHAM ISC/LC - ACTIVE ORDERS ;14-MAR-1995 "RTN","PSOLMAO",2,0) ;;7.0;OUTPATIENT PHARMACY;**225,251,387**;DEC 1997;Build 13 "RTN","PSOLMAO",3,0) ;External reference to TERM^VALM0 supported by DBIA 2615 "RTN","PSOLMAO",4,0) EN ; -- main entry point for PSO LM ACTION ORDER "RTN","PSOLMAO",5,0) D EN^VALM("PSO LM ACTIVE ORDERS") "RTN","PSOLMAO",6,0) Q "RTN","PSOLMAO",7,0) ; "RTN","PSOLMAO",8,0) HDR ; -- header code "RTN","PSOLMAO",9,0) D HDR^PSOLMUTL "RTN","PSOLMAO",10,0) Q "RTN","PSOLMAO",11,0) ; "RTN","PSOLMAO",12,0) INIT ; -- init variables and list array "RTN","PSOLMAO",13,0) S VALMCNT=PSOPF D RV^PSOORFL "RTN","PSOLMAO",14,0) Q "RTN","PSOLMAO",15,0) ; "RTN","PSOLMAO",16,0) HELP ; -- help code "RTN","PSOLMAO",17,0) S X="?" D DISP^XQORM1 W !! "RTN","PSOLMAO",18,0) Q "RTN","PSOLMAO",19,0) ; "RTN","PSOLMAO",20,0) EXIT ; -- exit code "RTN","PSOLMAO",21,0) D KILL^VALM10() K PSODCREV S PSOQFLG=1 "RTN","PSOLMAO",22,0) Q "RTN","PSOLMAO",23,0) ; "RTN","PSOLMAO",24,0) EXPND ; -- expand code "RTN","PSOLMAO",25,0) Q "RTN","PSOLMAO",26,0) ; "RTN","PSOLMAO",27,0) PENTRY ; "RTN","PSOLMAO",28,0) D KILL^VALM10() "RTN","PSOLMAO",29,0) N PSORVIEN "RTN","PSOLMAO",30,0) I $O(PSODCREV(0)) F PSORVIEN=0:0 S PSORVIEN=$O(PSODCREV(PSORVIEN)) Q:'PSORVIEN D "RTN","PSOLMAO",31,0) .I '$D(IORVON),$D(IOST(0)) D ENS^%ZISS,TERM^VALM0 "RTN","PSOLMAO",32,0) .D CNTRL^VALM10(PSORVIEN,1,80,IORVON,IORVOFF,0) "RTN","PSOLMAO",33,0) K PSORVIEN "RTN","PSOLMAO",34,0) S VALMCNT=$G(PSOPF) "RTN","PSOLMAO",35,0) Q:'$G(VALMCNT) "RTN","PSOLMAO",36,0) N PSLIST S PSLIST=0 F PSLIST=1:1:VALMCNT I $D(^TMP("PSOPF",$J,PSLIST,"RV")) D "RTN","PSOLMAO",37,0) . D CNTRL^VALM10(PSLIST,1,3,IORVON,IORVOFF,0) "RTN","PSOLMAO",38,0) Q "RTN","PSON52") 0^24^B79042036^B70712029 "RTN","PSON52",1,0) PSON52 ;BIR/DSD - files new entries in prescription file ;08/09/93 "RTN","PSON52",2,0) ;;7.0;OUTPATIENT PHARMACY;**1,16,23,27,32,46,71,111,124,117,131,139,157,143,219,148,239,201,268,260,225,303,358,251,387**;DEC 1997;Build 13 "RTN","PSON52",3,0) ;External reference ^PS(55 supported by DBIA 2228 "RTN","PSON52",4,0) ;External reference to PSOUL^PSSLOCK supported by DBIA 2789 "RTN","PSON52",5,0) ;External reference to ^XUSEC supported by DBIA 10076 "RTN","PSON52",6,0) ;External reference SWSTAT^IBBAPI supported by DBIA 4663 "RTN","PSON52",7,0) ;External reference SAVNDC^PSSNDCUT supported by DBIA 4707 "RTN","PSON52",8,0) ;External reference to $$DS^PSSDSAPI supported by DBIA 5424 "RTN","PSON52",9,0) EN(PSOX) ;Entry Point "RTN","PSON52",10,0) START ; "RTN","PSON52",11,0) D:$D(XRTL) T0^%ZOSV ; Start RT Monitor "RTN","PSON52",12,0) D INIT G:PSON52("QFLG") END D NFILE Q:$G(PSONEW("DFLG")) "RTN","PSON52",13,0) D PS55,DIK "RTN","PSON52",14,0) S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV ; Stop RT Monitor "RTN","PSON52",15,0) D FINISH "RTN","PSON52",16,0) I $P(^PSRX(PSOX("IRXN"),0),"^",11)="W",$G(^("IB")) S ^PSRX("ACP",$P(^PSRX(PSOX("IRXN"),0),"^",2),$P(^(2),"^",2),0,PSOX("IRXN"))="" "RTN","PSON52",17,0) END D EOJ "RTN","PSON52",18,0) Q "RTN","PSON52",19,0) INIT ; "RTN","PSON52",20,0) K X,%DT S:$G(PSOID) PSOX("ISSUE DATE")=PSOID "RTN","PSON52",21,0) S PSOX("CS")=0 "RTN","PSON52",22,0) F DEA=1:1 Q:$E(PSODRUG("DEA"),DEA)="" I $E(+PSODRUG("DEA"),DEA)>1,$E(+PSODRUG("DEA"),DEA)<6 S $P(PSOX("CS"),"^")=1 S:$E(+PSODRUG("DEA"),DEA)=2 $P(PSOX("CS"),"^",2)=1 "RTN","PSON52",23,0) S PSON52("QFLG")=0,X1=PSOX("ISSUE DATE"),X2=PSOX("DAYS SUPPLY")*(PSOX("# OF REFILLS")+1)\1 "RTN","PSON52",24,0) I $D(CLOZPAT) S X2=$S(X2=14:14,X2=7:7,1:X2) G DT "RTN","PSON52",25,0) S X2=$S(PSOX("DAYS SUPPLY")=X2:X2,+$G(PSOX("CS")):184,+$G(DEA("CS")):184,1:366) "RTN","PSON52",26,0) I X2<30 D "RTN","PSON52",27,0) . N % S %=$P($G(PSORX("PATIENT STATUS")),"^"),X2=30 "RTN","PSON52",28,0) . S:%?.N %=$P($G(^PS(53,+%,0)),"^") I %["AUTH ABS" S X2=5 "RTN","PSON52",29,0) DT D C^%DTC S PSOX("STOP DATE")=$P(X,".") K X "RTN","PSON52",30,0) I PSOX("# OF REFILLS")>0 S X1=PSOX("FILL DATE"),X2=$S((PSOX("DAYS SUPPLY")-10\1)<1:1,1:PSOX("DAYS SUPPLY")-10\1) D C^%DTC S PSOX("NEXT POSSIBLE REFILL")=$P(X,".") K X "RTN","PSON52",31,0) S PSOX("TYPE OF RX")=0,PSOX("DISPENSED DATE")=PSOX("FILL DATE") D NOW^%DTC S PSOX("LOGIN DATE")=$S($P($G(OR0),"^",12):$P($G(OR0),"^",12),1:%) K %,X "RTN","PSON52",32,0) S PSOX("STATUS")=$S($G(PSOX("STATUS"))]"":PSOX("STATUS"),$D(PSORX("VERIFY")):1,1:0) "RTN","PSON52",33,0) S PSOX("COPIES")=$S($G(PSOX("COPIES"))]"":PSOX("COPIES"),1:1) "RTN","PSON52",34,0) I $G(PSORX("PHARM"))]"" S PSOX("PHARMACIST")=PSORX("PHARM") K PSORX("PHARM") "RTN","PSON52",35,0) INITX Q "RTN","PSON52",36,0) ; "RTN","PSON52",37,0) NFILE I $G(OR0) D Q:$G(PSONEW("DFLG")) "RTN","PSON52",38,0) .D NOOR^PSONEW Q:$G(PSONEW("DFLG")) "RTN","PSON52",39,0) .I $G(PSOSIGFL)!($G(PSODRUG("OI"))'=$P(OR0,"^",8)) S PSONEW("CLERK CODE")=DUZ,PSONEW("REMARKS")=$G(PSONEW("REMARKS"))_" CPRS Order #"_$P(OR0,"^")_" Edited." "RTN","PSON52",40,0) S DIC="^PSRX(",DLAYGO=52,DIC(0)="L",X=PSOX("RX #") K DD,DO D FILE^DICN S PSOX("IRXN")=+Y K DLAYGO,X,Y,DIC,DD,DO "RTN","PSON52",41,0) I '$D(^XUSEC("PSORPH",DUZ)),$$DS^PSSDSAPI&(+$G(^TMP("PSODOSF",$J,0))) S PSON52(PSOX("IRXN"),"STA")=1,PSOX("STATUS")=1 "RTN","PSON52",42,0) F PSOX1=0:1 S PSON52=$P($T(DD+PSOX1),";;",2,4) Q:PSON52="" K PSOY S PSOY=$P(PSON52,";;") I $G(@PSOY)]"" S $P(PSON52(PSOX("IRXN"),$P(PSON52,";;",2)),"^",$P(PSON52,";;",3))=@PSOY "RTN","PSON52",43,0) F I=1:1:PSOX("ENT") S ^PSRX(PSOX("IRXN"),6,I,0)=PSOX("DOSE",I)_"^"_$G(PSOX("DOSE ORDERED",I))_"^"_$G(PSOX("UNITS",I))_"^"_$G(PSOX("NOUN",I))_"^" D "RTN","PSON52",44,0) .S ^PSRX(PSOX("IRXN"),6,I,0)=^PSRX(PSOX("IRXN"),6,I,0)_$G(PSOX("DURATION",I))_"^"_$G(PSOX("CONJUNCTION",I))_"^"_$G(PSOX("ROUTE",I))_"^"_$G(PSOX("SCHEDULE",I))_"^"_$G(PSOX("VERB",I)) "RTN","PSON52",45,0) .I $G(PSOX("ODOSE",I))]"" S ^PSRX(PSOX("IRXN"),6,I,1)=PSOX("ODOSE",I) "RTN","PSON52",46,0) S ^PSRX(PSOX("IRXN"),6,0)="^52.0113^"_PSOX("ENT")_"^"_PSOX("ENT") "RTN","PSON52",47,0) K PSOX1,PSOY "RTN","PSON52",48,0) S PSOX1="" F S PSOX1=$O(PSON52(PSOX("IRXN"),PSOX1)) Q:PSOX1="" S ^PSRX(PSOX("IRXN"),PSOX1)=$G(PSON52(PSOX("IRXN"),PSOX1)) "RTN","PSON52",49,0) I $O(PSOX("SIG",0)) D "RTN","PSON52",50,0) .S D=0 F S D=$O(PSOX("SIG",D)) Q:'D S ^PSRX(PSOX("IRXN"),"INS1",D,0)=PSOX("SIG",D),TP=$G(TP)+1 "RTN","PSON52",51,0) .S ^PSRX(PSOX("IRXN"),"INS1",0)="^52.0115^"_TP_"^"_TP_"^"_DT_"^^" K TP,D "RTN","PSON52",52,0) I $G(PSOX("SINS"))]"" S ^PSRX(PSOX("IRXN"),"INSS")=PSOX("SINS") "RTN","PSON52",53,0) I $G(SIGOK) D "RTN","PSON52",54,0) .S $P(^PSRX(PSOX("IRXN"),"SIG"),"^",2)=1,^PSRX(PSOX("IRXN"),"SIG1",0)="^52.04A^^" "RTN","PSON52",55,0) .S D=0 F S D=$O(SIG(D)) Q:'D S ^PSRX(PSOX("IRXN"),"SIG1",D,0)=SIG(D),$P(^PSRX(PSOX("IRXN"),"SIG1",0),"^",3)=+$P(^PSRX(PSOX("IRXN"),"SIG1",0),"^",3)+1,$P(^(0),"^",4)=+$P(^(0),"^",4)+1 Q:'$O(SIG(D)) "RTN","PSON52",56,0) .K SIG "RTN","PSON52",57,0) I $D(PSOINSFL) S ^PSRX(PSOX("IRXN"),"A",0)="^52.3DA^1^1",^PSRX(PSOX("IRXN"),"A",1,0)=DT_"^G^^0^Patient Instructions "_$S(PSOINSFL=1:"",1:"Not ")_"Sent By Provider." "RTN","PSON52",58,0) I $G(OR0) S:$P(OR0,"^",24) ^PSRX(PSOX("IRXN"),"PKI")=1 "RTN","PSON52",59,0) K PSOX1,PSOFINFL,HLDSIG,D,PSOINSFL,D "RTN","PSON52",60,0) D:$G(^TMP("PSODAI",$J,0)) "RTN","PSON52",61,0) .S $P(^PSRX(PSOX("IRXN"),3),"^",6)=1 "RTN","PSON52",62,0) .I $O(^TMP("PSODAI",$J,0)) S DAI=0 F S DAI=$O(^TMP("PSODAI",$J,DAI)) Q:'DAI D "RTN","PSON52",63,0) ..S:'$D(^PSRX(PSOX("IRXN"),"DAI",0)) ^PSRX(PSOX("IRXN"),"DAI",0)="^52.03^^" S ^PSRX(PSOX("IRXN"),"DAI",DAI,0)=^TMP("PSODAI",$J,DAI,0) "RTN","PSON52",64,0) ..S $P(^PSRX(PSOX("IRXN"),"DAI",0),"^",3)=+$P(^PSRX(PSOX("IRXN"),"DAI",0),"^",3)+1,$P(^(0),"^",4)=+$P(^(0),"^",4)+1 "RTN","PSON52",65,0) .K ^TMP("PSODAI",$J),DAI "RTN","PSON52",66,0) I $G(PSOX("CHCS NUMBER"))'="" S $P(^PSRX(PSOX("IRXN"),"EXT"),"^")=$G(PSOX("CHCS NUMBER")) "RTN","PSON52",67,0) I $G(PSOX("EXTERNAL SYSTEM"))'="" S $P(^PSRX(PSOX("IRXN"),"EXT"),"^",2)=$G(PSOX("EXTERNAL SYSTEM")) "RTN","PSON52",68,0) I $G(PSOX("NEWCOPAY")) S ^PSRX(PSOX("IRXN"),"IB")=$G(PSOX("NEWCOPAY")) "RTN","PSON52",69,0) ;Next line, set SC question based on Copay status? "RTN","PSON52",70,0) IBQ ;I $G(PSOBILL)=2 S ^PSRX(PSOX("IRXN"),"IBQ")=$S($G(PSOX("NEWCOPAY")):0,1:1) "RTN","PSON52",71,0) N PSOSCFLD S PSOSCFLD=$S(PSOSCP'="":$G(PSOANSQ("SC")),1:"")_"^"_$G(PSOANSQ("MST"))_"^"_$G(PSOANSQ("VEH"))_"^"_$G(PSOANSQ("RAD"))_"^"_$G(PSOANSQ("PGW"))_"^"_$G(PSOANSQ("HNC"))_"^"_$G(PSOANSQ("CV"))_"^"_$G(PSOANSQ("SHAD")) "RTN","PSON52",72,0) I PSOSCP<50&($TR(PSOSCFLD,"^")'="")&($P($G(^PS(53,+$G(PSONEW("PATIENT STATUS")),0)),"^",7)'=1) D "RTN","PSON52",73,0) . S ^PSRX(PSOX("IRXN"),"IBQ")=PSOSCFLD K PSOSCFLD ;don't set if SC % is null or 0, just set it in ICD node "RTN","PSON52",74,0) D ICD^PSODIAG "RTN","PSON52",75,0) D:$$SWSTAT^IBBAPI() GACT^PSOPFSU0(PSOX("IRXN"),0) "RTN","PSON52",76,0) K PSOANSQ,PSOANSQD,PSOX("NEWCOPAY") "RTN","PSON52",77,0) L -^PSRX("B",PSOX("IRXN")) "RTN","PSON52",78,0) Q "RTN","PSON52",79,0) ; "RTN","PSON52",80,0) PS55 ; "RTN","PSON52",81,0) L +^PS(55,PSODFN,"P"):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) "RTN","PSON52",82,0) S:'$D(^PS(55,PSODFN,"P",0)) ^(0)="^55.03PA^^" "RTN","PSON52",83,0) F PSOX1=$P(^PS(55,PSODFN,"P",0),"^",3):1 Q:'$D(^PS(55,PSODFN,"P",PSOX1)) "RTN","PSON52",84,0) S PSOX("55 IEN")=PSOX1 "RTN","PSON52",85,0) S ^PS(55,PSODFN,"P",PSOX1,0)=PSOX("IRXN"),$P(^PS(55,PSODFN,"P",0),"^",3,4)=PSOX1_"^"_($P(^PS(55,PSODFN,"P",0),"^",4)+1) "RTN","PSON52",86,0) S ^PS(55,PSODFN,"P","A",PSONEW("STOP DATE"),PSOX("IRXN"))="" "RTN","PSON52",87,0) PS55X L -^PS(55,PSODFN,"P") "RTN","PSON52",88,0) K PSOX1 "RTN","PSON52",89,0) Q "RTN","PSON52",90,0) DIK ; "RTN","PSON52",91,0) I $D(^XUSEC("PSORPH",DUZ)) S DA=PSOX("IRXN"),DIE=52,DR="41////"_PSOCOU_";S:'X Y=""@1"";42////"_PSOCOUU_";@1" D ^DIE K DIE,DR "RTN","PSON52",92,0) K DIK,DA S DIK="^PSRX(",DA=PSOX("IRXN") D IX1^DIK K DIK "RTN","PSON52",93,0) S DA=PSOX("IRXN") D ORC^PSORN52C "RTN","PSON52",94,0) Q "RTN","PSON52",95,0) FINISH ; "RTN","PSON52",96,0) ANQ I $G(ANQDATA)]"" D NOW^%DTC G:$D(^PS(52.52,"B",%)) ANQ D "RTN","PSON52",97,0) .K DD,DO S DIC="^PS(52.52,",DIC(0)="L",DLAYGO=52.52,X=% D FILE^DICN K DIC,DLAYGO,DD,DO "RTN","PSON52",98,0) .S ^PS(52.52,+Y,0)=$P(Y,"^",2)_"^"_PSOX("IRXN")_"^"_ANQDATA,^PS(52.52,"A",PSOX("IRXN"),+Y)="" K ANQDATA,X,Y,%,ANQREM "RTN","PSON52",99,0) ; "RTN","PSON52",100,0) N PSODWARN,PSOSIGNIF S (PSODWARN,PSOSIGNIF)=0 S:$$DS^PSSDSAPI&(+$G(^TMP("PSODOSF",$J,0))) PSODWARN=1 "RTN","PSON52",101,0) I '$D(^XUSEC("PSORPH",DUZ)),$D(^TMP("PSOSER",$J,0)) N PSOINTSV S PSOINTSV="",PSOINTSV=$G(^TMP("PSOSER",$J,0)) S:PSOINTSV[1 PSODWARN=1 S:'$G(PSODWARN)&(PSOINTSV[2) PSOSIGNIF=1 "RTN","PSON52",102,0) I '$D(^XUSEC("PSORPH",DUZ)),$G(PSODWARN)!$G(PSOSIGNIF) D ;if a tech and regardless of verification parmameter, set 52.4 if there's a critical, significant or dose waring. "RTN","PSON52",103,0) .K DIC,DLAYGO,DINUM,DIADD,X,DD,DO S DIC="^PS(52.4,",DLAYGO=52.4,DINUM=PSOX("IRXN"),DIC(0)="ML",X=PSOX("IRXN") "RTN","PSON52",104,0) .D FILE^DICN K DD,DO,DIC,DLAYGO,DINUM S ^PS(52.4,PSOX("IRXN"),0)=PSOX("IRXN")_"^"_PSODFN_"^"_DUZ_"^"_"^"_$E(PSOX("LOGIN DATE"),1,7)_"^"_PSOX("IRXN")_"^"_PSOX("STOP DATE") "RTN","PSON52",105,0) .D TECH^PSODGDGP K DIK,DA S DIK="^PS(52.4,",DA=PSOX("IRXN") D IX^DIK K DIK,DA "RTN","PSON52",106,0) ; "RTN","PSON52",107,0) I ($P(PSOPAR,"^",2)&'$D(^XUSEC("PSORPH",DUZ))),'$G(PSODWARN),$G(PSOSIGNIF) G FINISHX "RTN","PSON52",108,0) G FINISHP:'$D(^XUSEC("PSORPH",DUZ))&(PSOX("STATUS")=4!$G(PSODWARN)) ;if a tech and regardless of verification parmameter, set label variables if there's a critical, signifcant or dose warning. "RTN","PSON52",109,0) G FINISHX:'$D(^XUSEC("PSORPH",DUZ))&($D(PSORX("VERIFY"))) "RTN","PSON52",110,0) ; "RTN","PSON52",111,0) I PSOX("FILL DATE")>DT,$P(PSOPAR,"^",6) S DA=PSOX("IRXN"),RXFL(PSOX("IRXN"))=0 D SUS^PSORXL K DA G FINISHX "RTN","PSON52",112,0) ; "RTN","PSON52",113,0) ; - Calling ECME for claims generation and transmission / REJECT handling "RTN","PSON52",114,0) N ACTION,PSOERX "RTN","PSON52",115,0) S PSOERX=PSOX("IRXN") "RTN","PSON52",116,0) I $$SUBMIT^PSOBPSUT(PSOERX,0) D I ACTION="Q"!(ACTION="^") Q "RTN","PSON52",117,0) . S ACTION="" D ECMESND^PSOBPSU1(PSOERX,0,PSOX("FILL DATE"),"OF") "RTN","PSON52",118,0) . ; Quit if there is an unresolved Tricare non-billable reject code, PSO*7*358 "RTN","PSON52",119,0) . I $$PSOET^PSOREJP3(PSOERX,0) S ACTION="Q" Q "RTN","PSON52",120,0) . I $$FIND^PSOREJUT(PSOERX,0) D "RTN","PSON52",121,0) . . S ACTION=$$HDLG^PSOREJU1(PSOERX,0,"79,88","OF","IOQ","Q") "RTN","PSON52",122,0) . I $$STATUS^PSOBPSUT(PSOERX,0)="E PAYABLE" D "RTN","PSON52",123,0) . . D SAVNDC^PSSNDCUT(+$$GET1^DIQ(52,PSOERX,6,"I"),$G(PSOSITE),$$GETNDC^PSONDCUT(PSOERX,0)) "RTN","PSON52",124,0) ; "RTN","PSON52",125,0) FINISHP ; "RTN","PSON52",126,0) I $G(PSORX("PSOL",1))']"" S PSORX("PSOL",1)=PSOX("IRXN")_",",RXFL(PSOX("IRXN"))=0 G FINISHX "RTN","PSON52",127,0) F PSOX1=0:0 S PSOX1=$O(PSORX("PSOL",PSOX1)) Q:'PSOX1 S PSOX2=PSOX1 "RTN","PSON52",128,0) I $L(PSORX("PSOL",PSOX2))+$L(PSOX("IRXN"))<220 S PSORX("PSOL",PSOX2)=PSORX("PSOL",PSOX2)_PSOX("IRXN")_"," "RTN","PSON52",129,0) E S PSORX("PSOL",PSOX2+1)=PSOX("IRXN")_"," "RTN","PSON52",130,0) S RXFL(PSOX("IRXN"))=0 "RTN","PSON52",131,0) FINISHX ;call to build Rx array for bingo board "RTN","PSON52",132,0) I $G(PSORX("MAIL/WINDOW"))["W" S BINGCRT=1,BINGRTE="W",BBFLG=1 D BBRX^PSORN52C "RTN","PSON52",133,0) K PSOX1,PSOX2 "RTN","PSON52",134,0) K ^TMP("PSODGI",$J),^TMP("PSOSER",$J),^TMP("PSOSERS",$J),^TMP("PSODGS",$J),^TMP("PSOTDD",$J),^TMP("PSODOSF",$J) "RTN","PSON52",135,0) Q "RTN","PSON52",136,0) EOJ ; "RTN","PSON52",137,0) ;B xref locked in routine PSONRXN "RTN","PSON52",138,0) L -^PSRX("B",PSOX("IRXN")) K OTHDOS,DA,PSON52,PSOPRC,RTE,SCH,PSOX("INS"),PSONEW("INS"),PSORXED("INS"),PSONEW("ENT"),PSORXED("ENT"),OLENT "RTN","PSON52",139,0) D PSOUL^PSSLOCK(PSOX("IRXN")) "RTN","PSON52",140,0) Q "RTN","PSON52",141,0) ; "RTN","PSON52",142,0) ;;PSOX("SIG");;SIG;;1 "RTN","PSON52",143,0) DD ;;PSOX("RX #");;0;;1 "RTN","PSON52",144,0) ;;PSOX("ISSUE DATE");;0;;13 "RTN","PSON52",145,0) ;;PSODFN;;0;;2 "RTN","PSON52",146,0) ;;PSOX("PATIENT STATUS");;0;;3 "RTN","PSON52",147,0) ;;PSOX("PROVIDER");;0;;4 "RTN","PSON52",148,0) ;;PSOX("CLINIC");;0;;5 "RTN","PSON52",149,0) ;;PSODRUG("IEN");;0;;6 "RTN","PSON52",150,0) ;;PSODRUG("TRADE NAME");;TN;;1 "RTN","PSON52",151,0) ;;PSOX("QTY");;0;;7 "RTN","PSON52",152,0) ;;PSOX("DAYS SUPPLY");;0;;8 "RTN","PSON52",153,0) ;;PSOX("# OF REFILLS");;0;;9 "RTN","PSON52",154,0) ;;PSOX("COPIES");;0;;18 "RTN","PSON52",155,0) ;;PSOX("MAIL/WINDOW");;0;;11 "RTN","PSON52",156,0) ;;PSOX("REMARKS");;3;;7 "RTN","PSON52",157,0) ;;PSOX("CLERK CODE");;0;;16 "RTN","PSON52",158,0) ;;PSODRUG("COST");;0;;17 "RTN","PSON52",159,0) ;;PSOSITE;;2;;9 "RTN","PSON52",160,0) ;;PSOX("LOGIN DATE");;2;;1 "RTN","PSON52",161,0) ;;PSOX("FILL DATE");;2;;2 "RTN","PSON52",162,0) ;;PSOX("PHARMACIST");;2;;3 "RTN","PSON52",163,0) ;;PSOX("LOT #");;2;;4 "RTN","PSON52",164,0) ;;PSOX("DISPENSED DATE");;2;;5 "RTN","PSON52",165,0) ;;PSOX("STOP DATE");;2;;6 "RTN","PSON52",166,0) ;;PSODRUG("NDC");;2;;7 "RTN","PSON52",167,0) ;;PSODRUG("DAW");;EPH;;1 "RTN","PSON52",168,0) ;;PSODRUG("MANUFACTURER");;2;;8 "RTN","PSON52",169,0) ;;PSOX("EXPIRATION DATE");;2;;11 "RTN","PSON52",170,0) ;;PSOX("GENERIC PROVIDER");;2;;12 "RTN","PSON52",171,0) ;;PSOX("RELEASED DATE/TIME");;2;;13 "RTN","PSON52",172,0) ;;PSOX("METHOD OF PICK-UP");;MP;;1 "RTN","PSON52",173,0) ;;PSOX("STATUS");;STA;;1 "RTN","PSON52",174,0) ;;PSOX("LAST DISPENSED DATE");;3;;1 "RTN","PSON52",175,0) ;;PSOX("NEXT POSSIBLE REFILL");;3;;2 "RTN","PSON52",176,0) ;;PSOX("COSIGNING PROVIDER");;3;;3 "RTN","PSON52",177,0) ;;PSOX("TYPE OF RX");;TYPE;;1 "RTN","PSON52",178,0) ;;PSOX("SAND");;SAND;;1 "RTN","PSON52",179,0) ;;PSOX("POE");;POE;;1 "RTN","PSON52",180,0) ;;PSOX("INS");;INS;;1 "RTN","PSOORRD2") 0^5^B24528466^B24528466 "RTN","PSOORRD2",1,0) PSOORRD2 ;BHAM-ISC/EJW - Remote Data Interoperability Order Checks - backdoor ;06/26/05 "RTN","PSOORRD2",2,0) ;;7.0;OUTPATIENT PHARMACY;**207,251,387**;DEC 1997;Build 13 "RTN","PSOORRD2",3,0) ; "RTN","PSOORRD2",4,0) DUP ;Remote order - duplicate drug "RTN","PSOORRD2",5,0) N PSOD0,PSOD1,PSOREMX,RDIINST,FSIG,PSOULN,PSOLF,PSORDI "RTN","PSOORRD2",6,0) S $P(PSOULN,"-",79)="",PSOT="DD" "RTN","PSOORRD2",7,0) S PSORDI=0 F S PSORDI=$O(^TMP($J,"DD",PSORDI)) Q:'PSORDI S PSOD0=^TMP($J,"DD",PSORDI,0),PSOD1=^(1),PSOREMX=$P($P(PSOD0,"^",4),";"),RDIINST=$P(PSOD0,"^",5),PSOLF=$P(PSOD1,"^",3) D "RTN","PSOORRD2",8,0) .W !,PSOULN,! "RTN","PSOORRD2",9,0) .W "Duplicate Drug in Remote Rx:",! "RTN","PSOORRD2",10,0) .W $J("Location Name: ",20)_RDIINST,! "RTN","PSOORRD2",11,0) .W $J("Rx #: ",20)_$E(PSOREMX,1,$L(PSOREMX)-1),! "RTN","PSOORRD2",12,0) .W $J("Drug: ",20)_$P(PSOD1,"^"),! "RTN","PSOORRD2",13,0) .D FSIG(.FSIG) "RTN","PSOORRD2",14,0) .W $J("SIG: ",20) F I=1:1 Q:'$D(FSIG(I)) W ?20,FSIG(I),! "RTN","PSOORRD2",15,0) .W $J("QTY: ",20)_$P(PSOD1,"^",5),?44,$J("Refills remaining: ",20)_$P(PSOD1,"^",6) "RTN","PSOORRD2",16,0) .W !,$J("Provider: ",20)_$P(PSOD1,"^",8),?44,$J("Issued: ",20)_$P(PSOD1,"^",9) "RTN","PSOORRD2",17,0) .W !,$J("Status: ",20)_$P(PSOD1,"^",2),?44,$J("Last filled on: ",20)_PSOLF "RTN","PSOORRD2",18,0) .W !?44,$J("Days Supply: ",20)_$P(PSOD1,"^",4) "RTN","PSOORRD2",19,0) .W !,PSOULN,! "RTN","PSOORRD2",20,0) .D PAUSE "RTN","PSOORRD2",21,0) .S ^TMP($J,"PSORMDD",PSORDI,0)=1 "RTN","PSOORRD2",22,0) K PSOT "RTN","PSOORRD2",23,0) Q "RTN","PSOORRD2",24,0) ; "RTN","PSOORRD2",25,0) CLS ;Remote order - duplicate drug class "RTN","PSOORRD2",26,0) N PSOD0,PSOD1,PSOREMX,RDIINST,FSIG,PSOULN,PSOLF,PSORDI "RTN","PSOORRD2",27,0) S $P(PSOULN,"-",79)="",PSOT="DC" "RTN","PSOORRD2",28,0) S PSORDI=0 F S PSORDI=$O(^TMP($J,"DC",PSORDI)) Q:'PSORDI S PSOD0=^TMP($J,"DC",PSORDI,0),PSOD1=^(1),PSOREMX=$P($P(PSOD0,"^",6),";"),RDIINST=$P(PSOD0,"^",7),PSOLF=$P(PSOD1,"^",3) D "RTN","PSOORRD2",29,0) .W !,PSOULN,! "RTN","PSOORRD2",30,0) .W " *** SAME CLASS *** OF DRUG IN REMOTE RX FOR ",$P(PSOD1,"^"),! "RTN","PSOORRD2",31,0) .W ">> ",RDIINST,! "RTN","PSOORRD2",32,0) .W "CLASS: ",$P(PSOD0,"^"),! "RTN","PSOORRD2",33,0) .W $J("Rx #: ",20)_$E(PSOREMX,1,$L(PSOREMX)-1),! "RTN","PSOORRD2",34,0) .W $J("Status: ",20),$P(PSOD1,"^",2) "RTN","PSOORRD2",35,0) .W ?44,$J("Issued: ",20),$P(PSOD1,"^",9) "RTN","PSOORRD2",36,0) .D FSIG(.FSIG) "RTN","PSOORRD2",37,0) .W !,$J("SIG: ",20) F I=1:1 Q:'$D(FSIG(I)) W ?20,FSIG(I),! "RTN","PSOORRD2",38,0) .W $J("QTY: ",20),$P(PSOD1,"^",5),! "RTN","PSOORRD2",39,0) .W $J("Provider: ",20),$P(PSOD1,"^",8) "RTN","PSOORRD2",40,0) .W ?44,$J("Refills remaining: ",20),$P(PSOD1,"^",6) "RTN","PSOORRD2",41,0) .W !?44,$J("Last filled on: ",20),PSOLF "RTN","PSOORRD2",42,0) .W !?44,$J("Days Supply: ",20),$P(PSOD1,"^",4) "RTN","PSOORRD2",43,0) .D PAUSE "RTN","PSOORRD2",44,0) K PSOT "RTN","PSOORRD2",45,0) Q "RTN","PSOORRD2",46,0) FSIG(FSIG) ;Format sig from remote site "RTN","PSOORRD2",47,0) ;returned in the FSIG array "RTN","PSOORRD2",48,0) N FFF,NNN,CNT,FVAR,FVAR1,FLIM,HSIG,II,I "RTN","PSOORRD2",49,0) F I=0:1 Q:'$D(^TMP($J,PSOT,PSORDI,1,I)) S HSIG(I+1)=^(I) "RTN","PSOORRD2",50,0) FSTART S (FVAR,FVAR1)="",II=1 "RTN","PSOORRD2",51,0) F FFF=0:0 S FFF=$O(HSIG(FFF)) Q:'FFF S CNT=0 F NNN=1:1:$L(HSIG(FFF)) I $E(HSIG(FFF),NNN)=" "!($L(HSIG(FFF))=NNN) S CNT=CNT+1 D I $L(FVAR)>52 S FSIG(II)=FLIM_" ",II=II+1,FVAR=FVAR1 "RTN","PSOORRD2",52,0) .S FVAR1=$P(HSIG(FFF)," ",(CNT)) "RTN","PSOORRD2",53,0) .S FLIM=FVAR "RTN","PSOORRD2",54,0) .S FVAR=$S(FVAR="":FVAR1,1:FVAR_" "_FVAR1) "RTN","PSOORRD2",55,0) I $G(FVAR)'="" S FSIG(II)=FVAR "RTN","PSOORRD2",56,0) I $G(FSIG(1))=""!($G(FSIG(1))=" ") S FSIG(1)=$G(FSIG(2)) K FSIG(2) "RTN","PSOORRD2",57,0) FQUIT Q "RTN","PSOORRD2",58,0) SIGNIF ; "RTN","PSOORRD2",59,0) S DIR(0)="SA^1:YES;0:NO",DIR("A")="Do you want to Intervene? ",DIR("B")="Y" W ! D ^DIR "RTN","PSOORRD2",60,0) I Y I '$D(PSORX("INTERVENE")) S PSORX("INTERVENE")=2 "RTN","PSOORRD2",61,0) I '$G(Y) K DIR,DTOUT,DIRUT,DIROUT,DUOUT,Y Q "RTN","PSOORRD2",62,0) Q "RTN","PSOORRD2",63,0) ; "RTN","PSOORRD2",64,0) PAUSE ; "RTN","PSOORRD2",65,0) K DIR W ! S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to continue..." D ^DIR W ! K DIR "RTN","PSOORRD2",66,0) Q "RTN","PSOORRD2",67,0) DRGINT ;DRUG-DRUG INTERACTION WITH ORDER FROM REMOTE SITE "RTN","PSOORRD2",68,0) N PSOD0,PSOD1,PSOREMX,RDIINST,FSIG,PSOULN,PSOLF,PSOINT,PSORDI "RTN","PSOORRD2",69,0) S $P(PSOULN,"-",79)="",PSOT="DI" "RTN","PSOORRD2",70,0) S PSORDI=0 F S PSORDI=$O(^TMP($J,"DI",PSORDI)) Q:'PSORDI Q:$G(PSORX("DFLG")) S PSOD0=^TMP($J,"DI",PSORDI,0),PSOD1=^(1),PSOREMX=$P($P(PSOD0,"^",8),";"),RDIINST=$P(PSOD0,"^",9),PSOLF=$P(PSOD1,"^",3) D "RTN","PSOORRD2",71,0) .S PSOINT=$P(PSOD0,"^",4) "RTN","PSOORRD2",72,0) .W !,PSOULN,! "RTN","PSOORRD2",73,0) .W ">> ",RDIINST,! "RTN","PSOORRD2",74,0) .W ?5,"** ",PSOINT," ** DRUG-DRUG interaction ",$P(PSOD0,"^",5)," & ",$P(PSOD0,"^",6),! "RTN","PSOORRD2",75,0) .W ?5,"Remote RX # ",$E(PSOREMX,1,$L(PSOREMX)-1)," Drug: ",$P(PSOD1,"^"),! "RTN","PSOORRD2",76,0) .W $J("Status: ",20),$P(PSOD1,"^",2) "RTN","PSOORRD2",77,0) .W ?44,$J("Issued: ",20),$P(PSOD1,"^",9) "RTN","PSOORRD2",78,0) .D FSIG(.FSIG) "RTN","PSOORRD2",79,0) .W !,$J("SIG: ",20) F I=1:1 Q:'$D(FSIG(I)) W ?20,FSIG(I),! "RTN","PSOORRD2",80,0) .W $J("QTY: ",20),$P(PSOD1,"^",5),! "RTN","PSOORRD2",81,0) .W $J("Provider: ",20),$P(PSOD1,"^",8) "RTN","PSOORRD2",82,0) .W !?44,$J("Refills remaining: ",20),$P(PSOD1,"^",6) "RTN","PSOORRD2",83,0) .W !?44,$J("Last filled on: ",20),PSOLF "RTN","PSOORRD2",84,0) .W !?44,$J("Days Supply: ",20),$P(PSOD1,"^",4) "RTN","PSOORRD2",85,0) .I '$D(^XUSEC("PSORPH",DUZ)) Q ; CLERK/TECH ENTRY "RTN","PSOORRD2",86,0) .I PSOINT'="CRITICAL" D SIGNIF "RTN","PSOORRD2",87,0) .I PSOINT="CRITICAL" D CRI "RTN","PSOORRD2",88,0) K PSOT,PSORDI "RTN","PSOORRD2",89,0) Q "RTN","PSOORRD2",90,0) ; "RTN","PSOORRD2",91,0) CRI ;process new drug interactions entered by pharmacist "RTN","PSOORRD2",92,0) K DIR S DIR("A",1)="",DIR("A",2)="Do you want to Process medication",DIR("A")=PSODRUG("NAME")_": ",DIR(0)="SA^1:PROCESS;0:ABORT ORDER ENTRY",DIR("B")="P" "RTN","PSOORRD2",93,0) S DIR("?",1)="Enter '1' or 'P' to Activate medication",DIR("?")=" '0' or 'A' to Abort Order Entry process" D ^DIR K X1,DIR I 'Y S PSORX("DFLG")=1,DGI="" K DTOUT,DIRUT,DIROUT,DUOUT,PSORX("INTERVENE") Q "RTN","PSOORRD2",94,0) D SIG^XUSESIG I X1="" K PSORX("INTERVENE") S PSORX("DFLG")=1 Q "RTN","PSOORRD2",95,0) S PSORX("INTERVENE")=1 "RTN","PSOORRD2",96,0) K DUOUT,DTOUT,DIRUT,DIROUT "RTN","PSOORRD2",97,0) Q "RTN","PSOORUT1") 0^23^B77945893^B78073421 "RTN","PSOORUT1",1,0) PSOORUT1 ;BIR/SAB - Utility routine for oerr interface ;02/22/95 "RTN","PSOORUT1",2,0) ;;7.0;OUTPATIENT PHARMACY;**1,14,30,46,132,148,233,274,225,305,289,251,387**;DEC 1997;Build 13 "RTN","PSOORUT1",3,0) ;External reference to ^PSDRUG supported by DBIA 221 "RTN","PSOORUT1",4,0) ;External reference to ^PSXOPUTL supported by DBIA 2203 "RTN","PSOORUT1",5,0) ;called from HD^PSOORUTL "RTN","PSOORUT1",6,0) REL ;removed order from hold "RTN","PSOORUT1",7,0) S ACT=1,ORS=0 "RTN","PSOORUT1",8,0) I POERR("PSOFILNM")["S" S DA=+POERR("PSOFILNM") D G EXIT^PSOORUTL "RTN","PSOORUT1",9,0) .Q:'$D(^PS(52.41,DA,0)) Q:$P(^PS(52.41,DA,0),"^",3)="RF" "RTN","PSOORUT1",10,0) .S $P(^PS(52.41,DA,0),"^",3)="NW",POERR("STAT")="OR",POERR("FILLER")=DA_"^P" "RTN","PSOORUT1",11,0) .S:$G(POERR("COMM"))']"" POERR("COMM")="Order RELEASED from HOLD by OE/RR before finished." S $P(^PS(52.41,DA,4),"^")=POERR("COMM"),ORS=1 "RTN","PSOORUT1",12,0) S DA=POERR("PSOFILNM") I $D(^PSRX(DA,0)) S ORS=1,PSDA=DA D G EXIT^PSOORUTL "RTN","PSOORUT1",13,0) .S POERR("FILLER")=DA_"^R",POERR("STAT")="OR" "RTN","PSOORUT1",14,0) .S:'$D(POERR("COMM")) POERR("COMM")="Prescription Released from HOLD by OE/RR" "RTN","PSOORUT1",15,0) .I DT>$P(^PSRX(DA,2),"^",6) D "RTN","PSOORUT1",16,0) ..S EXP=$P(^PSRX(DA,2),"^",6) S:$P(^PSRX(DA,"STA"),"^")<12 $P(^PSRX(DA,"STA"),"^")=11,PSOEXFLG=1 S POERR("STAT")="UR",POERR("COMM")="Medication Expired on "_$E(EXP,4,5)_"/"_$E(EXP,6,7)_"/"_$E(EXP,2,3)_".",POERR("PHARMST")="" D ECAN^PSOUTL(DA) Q "RTN","PSOORUT1",17,0) .I $P(^PSRX(DA,"STA"),"^")'=16 S POERR("STAT")="UR",POERR("COMM")="Unable to Release from Hold" Q "RTN","PSOORUT1",18,0) .S RXFL(DA)=0,FDT=$P(^PSRX(DA,2),"^",2) "RTN","PSOORUT1",19,0) .I $O(^PSRX(DA,1,0)) F I=0:0 S I=$O(^PSRX(DA,1,I)) Q:'I S FDT=$P(^PSRX(DA,1,I,0),"^"),RXFL(DA)=I "RTN","PSOORUT1",20,0) .I FDT>DT N PSOSITEZ,ZPSOPAR6 S PSOSITEZ=$S($P($G(^PSRX(DA,2)),"^",9):$P(^(2),"^",9),1:$O(^PS(59,0))),ZPSOPAR6=$P($G(^PS(59,PSOSITEZ,1)),"^",6) I ZPSOPAR6 D Q "RTN","PSOORUT1",21,0) ..S RXXDA=DA,DA=$O(^PS(52.5,"B",RXXDA,0)) I DA S DIK="^PS(52.5," D ^DIK K DIK "RTN","PSOORUT1",22,0) ..S DA=RXXDA "RTN","PSOORUT1",23,0) ..S DIC="^PS(52.5,",DIC(0)="L",DLAYGO=52.5,X=RXXDA,DIC("DR")=".02///"_FDT_";.03////"_$P(^PSRX(DA,0),"^",2)_";.04///M;.05///0;.06////"_PSOSITEZ_";2///0;9///"_RXFL(DA) K DD,DO D FILE^DICN K RXFL,DD,DO "RTN","PSOORUT1",24,0) ..S DA=RXXDA K RXXDA S $P(^PSRX(DA,"STA"),"^")=5,LFD=$E(FDT,4,5)_"-"_$E(FDT,6,7)_"-"_$E(FDT,2,3) D ACT1 "RTN","PSOORUT1",25,0) ..S PSOSUSZ=1 "RTN","PSOORUT1",26,0) .E S $P(^PSRX(DA,"STA"),"^")=0 "RTN","PSOORUT1",27,0) .S RXF=0 F I=0:0 S I=$O(^PSRX(DA,1,I)) Q:'I S RXF=I S:I>5 RXF=I+1 "RTN","PSOORUT1",28,0) .D ACT^PSOORUTL "RTN","PSOORUT1",29,0) .I $$SUBMIT^PSOBPSUT(DA) D ECMESND^PSOBPSU1(DA,,$$RXFLDT^PSOBPSUT(DA),$S('$O(^PSRX(DA,1,0)):"OF",1:"RF")) "RTN","PSOORUT1",30,0) G EXIT^PSOORUTL "RTN","PSOORUT1",31,0) ACT1 I '$D(RXF) S RXF=0 F I=0:0 S I=$O(^PSRX(DA,1,I)) Q:'I S RXF=I S:I>5 RXF=I+1 "RTN","PSOORUT1",32,0) S IR=0 F FDA=0:0 S FDA=$O(^PSRX(DA,"A",FDA)) Q:'FDA S IR=FDA "RTN","PSOORUT1",33,0) S IR=IR+1,^PSRX(DA,"A",0)="^52.3DA^"_IR_"^"_IR "RTN","PSOORUT1",34,0) D NOW^%DTC S ^PSRX(DA,"A",IR,0)=%_"^S^"_POERR("USER")_"^"_RXF_"^"_"RX Placed on Suspense until "_LFD "RTN","PSOORUT1",35,0) Q "RTN","PSOORUT1",36,0) SUS ; "RTN","PSOORUT1",37,0) I $P($G(^PSRX(+$G(FILLER),"STA")),"^")=5 N PSOMSORR,PLACERXX D EN^PSOHLSN1(+$G(FILLER),"SC","ZS","") "RTN","PSOORUT1",38,0) Q "RTN","PSOORUT1",39,0) BLD ;builds med profile for Listman "RTN","PSOORUT1",40,0) K PSODCREV,^TMP("PSOPF",$J),PSOLST S:$G(PSOOPT)'=3 PSOOPT=0 I '$G(PSOSD) S ^TMP("PSOPF",$J,1,0)="This patient has no prescriptions" S PSOCNT=0,PSOPF=1 Q "RTN","PSOORUT1",41,0) D EOJ,SHOW "RTN","PSOORUT1",42,0) EOJ ; "RTN","PSOORUT1",43,0) K PSOQFLG,PSODRG,PSODATA,PSOLF "RTN","PSOORUT1",44,0) Q "RTN","PSOORUT1",45,0) ;----------------------------------------------------------------- "RTN","PSOORUT1",46,0) SHOW ; "RTN","PSOORUT1",47,0) ; - ePharmacy modification to create a section for Rx with REJECTs "RTN","PSOORUT1",48,0) N PSOTMP,PSOSTS,PSODRNM,I,PSORX "RTN","PSOORUT1",49,0) S (PSOSTS,PSODRNM)="" "RTN","PSOORUT1",50,0) F S PSOSTS=$O(PSOSD(PSOSTS)) Q:PSOSTS="" D "RTN","PSOORUT1",51,0) . F S PSODRNM=$O(PSOSD(PSOSTS,PSODRNM)) Q:PSODRNM="" D "RTN","PSOORUT1",52,0) . . S PSORX=+$G(PSOSD(PSOSTS,PSODRNM)) "RTN","PSOORUT1",53,0) . . I PSOSTS="ACTIVE",$$FIND^PSOREJUT(PSORX,,,"79,88") D Q "RTN","PSOORUT1",54,0) . . . S PSOTMP(" REJECT",PSODRNM)=PSOSTS "RTN","PSOORUT1",55,0) . . S PSOTMP(PSOSTS,PSODRNM)=PSOSTS "RTN","PSOORUT1",56,0) ; "RTN","PSOORUT1",57,0) S (PSOSTS,PSODRG)="",(PSOCNT,PSOQFLG,IEN)=0 "RTN","PSOORUT1",58,0) K RN,DL S $P(RN," ",12)=" ",$P(DL," ",40)=" " "RTN","PSOORUT1",59,0) F PSCNT=0:0 S PSOSTS=$O(PSOTMP(PSOSTS)) Q:PSOSTS="" D "RTN","PSOORUT1",60,0) . D STA "RTN","PSOORUT1",61,0) . F PSOCT=0:0 S PSODRG=$O(PSOTMP(PSOSTS,PSODRG)) Q:PSODRG="" Q:PSOCNT>1000!PSOQFLG D "RTN","PSOORUT1",62,0) . . S PSOSTA=PSOTMP(PSOSTS,PSODRG) "RTN","PSOORUT1",63,0) . . S PSODATA=PSOSD(PSOSTA,PSODRG) I PSOSTA="ZNONVA" D NVA Q "RTN","PSOORUT1",64,0) . . S PSOCNT=PSOCNT+1 I PSOSTA="PENDING" D PEN Q "RTN","PSOORUT1",65,0) . . S:'$D(^PSRX(+PSODATA,0)) PSOCNT=PSOCNT-1 D:$D(^(0)) DISPL "RTN","PSOORUT1",66,0) S (VALMCNT,PSOPF)=IEN "RTN","PSOORUT1",67,0) SHOWX K DIRUT,DTOUT,DUOUT,DIROUT,PSODRG "RTN","PSOORUT1",68,0) Q "RTN","PSOORUT1",69,0) ; "RTN","PSOORUT1",70,0) DISPL S IEN=IEN+1 N PSOID,PSOCMOP,STATLTH,ECME "RTN","PSOORUT1",71,0) K PSOLNT,PSOQTL,PSOLSP S PSOLRX=$S($G(^PSRX(+PSODATA,"IB")):13,1:14)-$L($P(^PSRX(+PSODATA,0),"^")),$P(PSOLNT," ",PSOLRX)=" ",PSODQL=$L($P(PSODRG,"^"))+$L($P(^PSRX(+PSODATA,0),"^",7)) "RTN","PSOORUT1",72,0) I PSODQL<39 S $P(PSOQTL," ",(40-PSODQL))=" " "RTN","PSOORUT1",73,0) E S $P(PSOQTL," ",(52-$L($P(^PSRX(+PSODATA,0),"^",7))))=" ",$P(PSOLSP," ",(41-$L($P(PSODRG,"^"))))=" " "RTN","PSOORUT1",74,0) S ECME=$$ECME^PSOBPSUT(+PSODATA) I ECME'="" S PSOLNT=$E(PSOLNT,1,$L(PSOLNT)-1) "RTN","PSOORUT1",75,0) S ^TMP("PSOPF",$J,IEN,0)=$J(PSOCNT,2)_$S($L(PSOCNT)<3:" ",1:"")_$P(^PSRX(+PSODATA,0),"^")_$S($G(^PSRX(+PSODATA,"IB")):"$",1:"")_ECME_PSOLNT_$P(PSODRG,"^")_$S(PSODQL<39:PSOQTL_$P(^PSRX(+PSODATA,0),"^",7)_" ",1:$G(PSOLSP)) "RTN","PSOORUT1",76,0) S STA="A^N^R^H^N^S^^^^^^E^DC^^DP^DE^HP^P^" "RTN","PSOORUT1",77,0) S PSOCMOP="" "RTN","PSOORUT1",78,0) I $D(^PSDRUG("AQ",$P(^PSRX(+PSODATA,0),"^",6))) S PSOCMOP=">" "RTN","PSOORUT1",79,0) N X S X="PSXOPUTL" X ^%ZOSF("TEST") K X I $T D "RTN","PSOORUT1",80,0) .N DA S DA=+PSODATA D ^PSXOPUTL K DA "RTN","PSOORUT1",81,0) .I $G(PSXZ(PSXZ("L")))=0!($G(PSXZ(PSXZ("L")))=2) S PSOCMOP="T" "RTN","PSOORUT1",82,0) .K PSXZ "RTN","PSOORUT1",83,0) N PSOBADR "RTN","PSOORUT1",84,0) S PSOBADR=$O(^PSRX(+PSODATA,"L",9999),-1) "RTN","PSOORUT1",85,0) I PSOBADR'="" S PSOBADR=$G(^PSRX(+PSODATA,"L",PSOBADR,0)) I PSOBADR["(BAD ADDRESS)" S PSOBADR="B" "RTN","PSOORUT1",86,0) I PSOBADR'="B" S PSOBADR="" "RTN","PSOORUT1",87,0) S (STA,STATLTH)=$P(STA,"^",$P(PSODATA,"^",2)+1) D "RTN","PSOORUT1",88,0) .I $G(^PSRX(+PSODATA,"DDSTA"))]"" S (STATLTH,STA)="DD" Q "RTN","PSOORUT1",89,0) .S (STATLTH,STA)=$S($P($G(^PSRX(+PSODATA,7)),"^")=1:"DA",$P($G(^PSRX(+PSODATA,7)),"^")=2:"DF",1:STA) "RTN","PSOORUT1",90,0) S STAPRT=STA_PSOCMOP_PSOBADR,STATLTH=$L(STAPRT) "RTN","PSOORUT1",91,0) S ^TMP("PSOPF",$J,IEN,0)=^TMP("PSOPF",$J,IEN,0)_STAPRT_$S(STATLTH=0:" ",STATLTH=1:" ",STATLTH=2:" ",1:"") "RTN","PSOORUT1",92,0) S PSOID=$P(^PSRX(+PSODATA,0),"^",13),PSOLF=+$G(^(3)),^TMP("PSOPF",$J,IEN,0)=^TMP("PSOPF",$J,IEN,0)_$E(PSOID,4,5)_"-"_$E(PSOID,6,7)_" " "RTN","PSOORUT1",93,0) N RFLZRO,PSOLRD S PSOLRD=$P($G(^PSRX(+PSODATA,2)),"^",13) "RTN","PSOORUT1",94,0) F PSOX=0:0 S PSOX=$O(^PSRX(+PSODATA,1,PSOX)) Q:'PSOX D "RTN","PSOORUT1",95,0) . S RFLZRO=$G(^PSRX(+PSODATA,1,PSOX,0)) "RTN","PSOORUT1",96,0) . I +RFLZRO=PSOLF,$P(RFLZRO,"^",16) S PSOLF=PSOLF_"^R" "RTN","PSOORUT1",97,0) . S:$P(RFLZRO,"^",18)'="" PSOLRD=$P(RFLZRO,"^",18) I $P(RFLZRO,"^",16) S PSOLRD=PSOLRD_"^R" "RTN","PSOORUT1",98,0) K PSOX "RTN","PSOORUT1",99,0) I '$O(^PSRX(+PSODATA,1,0)),$P(^PSRX(+PSODATA,2),"^",15) S PSOLF=PSOLF_"^R",PSOLRD=PSOLRD_"^R" "RTN","PSOORUT1",100,0) S PSOLF=$S($G(PSOLF):$E(PSOLF,4,5),1:" ")_"-"_$S($G(PSOLF):$E(PSOLF,6,7),1:" ")_$S($P(PSOLF,"^",2)="R":"R ",1:" ") "RTN","PSOORUT1",101,0) S PSOLRD=$S($G(PSOLRD):$E(PSOLRD,4,5),1:" ")_"-"_$S($G(PSOLRD):$E(PSOLRD,6,7),1:" ")_$S($P(PSOLRD,"^",2)="R":"R ",1:" ") "RTN","PSOORUT1",102,0) S ^TMP("PSOPF",$J,IEN,0)=^TMP("PSOPF",$J,IEN,0)_$S($G(PSORFG):PSOLRD,1:PSOLF) "RTN","PSOORUT1",103,0) S ^TMP("PSOPF",$J,IEN,0)=^TMP("PSOPF",$J,IEN,0)_$J($P(PSODATA,"^",6),2)_" "_$J($P(PSODATA,"^",8),3) "RTN","PSOORUT1",104,0) ;recently dc'd rxs "RTN","PSOORUT1",105,0) I $P($G(^PSRX(+PSODATA,3)),"^",5) D K X "RTN","PSOORUT1",106,0) .S X2=$S($P(PSOPAR,"^",33):$P(PSOPAR,"^",33),1:7),X1=$P(^PSRX(+PSODATA,3),"^",5) D C^%DTC "RTN","PSOORUT1",107,0) .I DT38 S IEN=IEN+1 S ^TMP("PSOPF",$J,IEN,0)=PSOQTL_"Qty: "_$P(^PSRX(+PSODATA,0),"^",7) "RTN","PSOORUT1",114,0) K PSOLNT,PSOQTL,PSOLSP,PSOLRX,PSODQL "RTN","PSOORUT1",115,0) S PSOLST(PSOCNT)="52^"_+PSODATA_"^"_PSOSTA "RTN","PSOORUT1",116,0) K PSODATA,PSOLF S PSOPF=IEN "RTN","PSOORUT1",117,0) Q "RTN","PSOORUT1",118,0) ; "RTN","PSOORUT1",119,0) STA N LABEL,LINE,POS "RTN","PSOORUT1",120,0) S LABEL=PSOSTS,IEN=IEN+1 "RTN","PSOORUT1",121,0) I PSOSTS="ZNONVA" S LABEL="Non-VA MEDS (Not dispensed by VA)" "RTN","PSOORUT1",122,0) I PSOSTS=" REJECT" S LABEL="REFILL TOO SOON/DUR REJECTS (Third Party)" "RTN","PSOORUT1",123,0) S POS=80-$L(LABEL)/2,$P(LINE,"-",81)="",$E(LINE,POS+1,POS+$L(LABEL))=LABEL "RTN","PSOORUT1",124,0) S ^TMP("PSOPF",$J,IEN,0)=LINE "RTN","PSOORUT1",125,0) Q "RTN","PSOORUT1",126,0) PENX S PSOLST(PSOCNT)="52.41^"_$P(PSODATA,"^",10)_"^"_PSOSTA "RTN","PSOORUT1",127,0) K PSODATA,PSOLF,RN,PSOLSP,PSOQTL,PSOLNT "RTN","PSOORUT1",128,0) Q "RTN","PSOORUT1",129,0) PEN ; "RTN","PSOORUT1",130,0) N PSOQTL,PSOLNT,PSOLNTZ,PSOQTLX,PSCMOPF,SPACEZ "RTN","PSOORUT1",131,0) Q:'$D(^PS(52.41,$P(PSODATA,"^",10),0)) "RTN","PSOORUT1",132,0) S PSCMOPF=0 I $P($G(PSODATA),"^",11),$D(^PSDRUG("AQ",$P(PSODATA,"^",11))) S PSCMOPF=1 "RTN","PSOORUT1",133,0) S IEN=IEN+1,^TMP("PSOPF",$J,IEN,0)=$J(PSOCNT,2)_$S($L(PSOCNT)<3:" ",1:"")_$P(PSODRG,"^") "RTN","PSOORUT1",134,0) I $P($G(^PS(52.41,+$P(PSODATA,"^",10),0)),"^",23)=1 S ^TMP("PSOPF",$J,IEN,"RV")="" "RTN","PSOORUT1",135,0) S PSOLNT=$L($P(PSODRG,"^")),PSOLNTZ=$L($P(PSODATA,"^",8)) "RTN","PSOORUT1",136,0) S $P(PSOQTLX," ",(11-PSOLNTZ))=" " "RTN","PSOORUT1",137,0) S:PSOLNT<37 $P(PSOQTL," ",(37-PSOLNT))=" " "RTN","PSOORUT1",138,0) I PSOLNT<38 D G PENX "RTN","PSOORUT1",139,0) .I PSOLNT=37 S PSOQTL="" "RTN","PSOORUT1",140,0) .I $P(^PS(52.41,$P(PSODATA,"^",10),0),"^",3)="RF" S ^TMP("PSOPF",$J,IEN,0)=^TMP("PSOPF",$J,IEN,0)_$G(PSOQTL)_" Refill Request Rx #: "_$P(^PSRX($P(^PS(52.41,$P(PSODATA,"^",10),0),"^",19),0),"^") Q "RTN","PSOORUT1",141,0) .S ^TMP("PSOPF",$J,IEN,0)=^TMP("PSOPF",$J,IEN,0)_$G(PSOQTL)_" "_"QTY: "_$P(PSODATA,"^",8)_$G(PSOQTLX)_" ISDT: "_$S('$P(PSODATA,"^",9):" ",1:$E($P(PSODATA,"^",9),4,5)_"-"_$E($P(PSODATA,"^",9),6,7))_$S($G(PSCMOPF):"> ",1:" ") "RTN","PSOORUT1",142,0) .S ^TMP("PSOPF",$J,IEN,0)=^TMP("PSOPF",$J,IEN,0)_"REF: "_$S($L($P(PSODATA,"^",6))>1:"",1:" ")_$P(PSODATA,"^",6) "RTN","PSOORUT1",143,0) S IEN=IEN+1,$P(SPACEZ," ",42)=" " "RTN","PSOORUT1",144,0) I $P(^PS(52.41,$P(PSODATA,"^",10),0),"^",3)="RF" S ^TMP("PSOPF",$J,IEN,0)=SPACEZ_"Refill Request Rx #: "_$P(^PSRX($P(^PS(52.41,$P(PSODATA,"^",10),0),"^",19),0),"^") G PENX "RTN","PSOORUT1",145,0) S ^TMP("PSOPF",$J,IEN,0)=SPACEZ_"QTY: "_$P(PSODATA,"^",8)_$G(PSOQTLX)_" ISDT: "_$S('$P(PSODATA,"^",9):" ",1:$E($P(PSODATA,"^",9),4,5)_"-"_$E($P(PSODATA,"^",9),6,7))_$S($G(PSCMOPF):"> ",1:" ")_"REF: "_$S($L($P(PSODATA,"^",6))>1:"",1:" ") "RTN","PSOORUT1",146,0) S ^TMP("PSOPF",$J,IEN,0)=^TMP("PSOPF",$J,IEN,0)_$P(PSODATA,"^",6) "RTN","PSOORUT1",147,0) G PENX "RTN","PSOORUT1",148,0) ; "RTN","PSOORUT1",149,0) NVA ; Setting the Non-VA Meds on the Medication Profile Screen (ListMan) "RTN","PSOORUT1",150,0) S IEN=IEN+1,^TMP("PSOPF",$J,IEN,0)=" "_$P(PSODRG,"^")_" " "RTN","PSOORUT1",151,0) I ($L(^TMP("PSOPF",$J,IEN,0))+$L($P(PSODATA,"^",6))>70) S IEN=IEN+1,^TMP("PSOPF",$J,IEN,0)=" " "RTN","PSOORUT1",152,0) S ^TMP("PSOPF",$J,IEN,0)=^TMP("PSOPF",$J,IEN,0)_$P(PSODATA,"^",6)_" " "RTN","PSOORUT1",153,0) I ($L(^TMP("PSOPF",$J,IEN,0))+$L($P(PSODATA,"^",8))>70) S IEN=IEN+1,^TMP("PSOPF",$J,IEN,0)=" " "RTN","PSOORUT1",154,0) S ^TMP("PSOPF",$J,IEN,0)=^TMP("PSOPF",$J,IEN,0)_$P(PSODATA,"^",8) "RTN","PSOORUT1",155,0) I ($L(^TMP("PSOPF",$J,IEN,0))+20)>70 D Q "RTN","PSOORUT1",156,0) . S IEN=IEN+1,$P(^TMP("PSOPF",$J,IEN,0)," ",51)="Date Documented: "_$E($P(PSODATA,"^",9),4,5)_"/"_$E($P(PSODATA,"^",9),6,7)_"/"_$E($P(PSODATA,"^",9),2,3) "RTN","PSOORUT1",157,0) F I=0:0 S ^TMP("PSOPF",$J,IEN,0)=^TMP("PSOPF",$J,IEN,0)_" " Q:$L(^TMP("PSOPF",$J,IEN,0))>49 "RTN","PSOORUT1",158,0) S ^TMP("PSOPF",$J,IEN,0)=^TMP("PSOPF",$J,IEN,0)_"Date Documented: "_$E($P(PSODATA,"^",9),4,5)_"/"_$E($P(PSODATA,"^",9),6,7)_"/"_$E($P(PSODATA,"^",9),2,3) "RTN","PSOORUT1",159,0) Q "RTN","PSORN52") 0^25^B58143232^B50777957 "RTN","PSORN52",1,0) PSORN52 ;BIR/DSD - files renewal entries in prescription file ;08/09/93 "RTN","PSORN52",2,0) ;;7.0;OUTPATIENT PHARMACY;**1,11,27,37,46,79,71,100,117,157,143,219,148,239,201,225,303,358,251,387**;DEC 1997;Build 13 "RTN","PSORN52",3,0) ;Ext ref to ^PS(55 sup by DBIA 2228 "RTN","PSORN52",4,0) ;Ext ref to PSOUL^PSSLOCK sup by DBIA 2789 "RTN","PSORN52",5,0) ;Ext ref to ^VA(200 sup by DBIA 10060 "RTN","PSORN52",6,0) ;Ext ref to SWSTAT^IBBAPI sup by DBIA 4663 "RTN","PSORN52",7,0) ;External reference to $$DS^PSSDSAPI supported by DBIA 5424 "RTN","PSORN52",8,0) EN(PSOX) ;EP "RTN","PSORN52",9,0) START ; "RTN","PSORN52",10,0) D:$D(XRTL) T0^%ZOSV ; Start RT Mon "RTN","PSORN52",11,0) N PSOIBHLD,PSOSCOTH,PSOSCOTX S (PSOSCOTH,PSOSCOTX)=0 S PSOIBHLD="" I $G(PSOFDR),$G(ORD) D "RTN","PSORN52",12,0) .S PSOIBHLD=$S($P($G(^PS(52.41,ORD,0)),"^",16)="SC":1,$P($G(^(0)),"^",16)="NSC":0,1:"") "RTN","PSORN52",13,0) .I '$$DT^PSOMLLDT Q "RTN","PSORN52",14,0) .N PSOIBHLX S PSOIBHLX=$G(^PS(52.41,ORD,"IBQ")) "RTN","PSORN52",15,0) .S PSOIBHLD=PSOIBHLD_"^"_$S($P(PSOIBHLX,"^")=1:1,$P(PSOIBHLX,"^")=0:0,1:"")_"^"_$S($P(PSOIBHLX,"^",2)=1:1,$P(PSOIBHLX,"^",2)=0:0,1:"")_"^"_$S($P(PSOIBHLX,"^",3)=1:1,$P(PSOIBHLX,"^",3)=0:0,1:"") "RTN","PSORN52",16,0) .S PSOIBHLD=PSOIBHLD_"^"_$S($P(PSOIBHLX,"^",4)=1:1,$P(PSOIBHLX,"^",4)=0:0,1:"")_"^"_$S($P(PSOIBHLX,"^",5)=1:1,$P(PSOIBHLX,"^",5)=0:0,1:"")_"^"_$S($P(PSOIBHLX,"^",6)=1:1,$P(PSOIBHLX,"^",6)=0:0,1:"") "RTN","PSORN52",17,0) .S PSOIBHLD=PSOIBHLD_"^"_$S($P(PSOIBHLX,"^",7)=1:1,$P(PSOIBHLX,"^",7)=0:0,1:"") "RTN","PSORN52",18,0) .I $P(PSOIBHLX,"^")=1!($P(PSOIBHLX,"^",2)=1)!($P(PSOIBHLX,"^",3)=1)!($P(PSOIBHLX,"^",4)=1)!($P(PSOIBHLX,"^",5)=1)!($P(PSOIBHLX,"^",6)=1)!($P(PSOIBHLX,"^",7)=1) S PSOSCOTH=1 "RTN","PSORN52",19,0) I $G(PSOSCOTH)!($G(PSORX("SC"))="SC")!($G(PSORX("SC"))="NSC") S PSOSCOTX=1 "RTN","PSORN52",20,0) S PSOANSQ("SC>50")="" D SCP^PSORN52D "RTN","PSORN52",21,0) I $G(PSOFDR),$G(ORD) I $D(^PS(52.41,ORD,"ICD")) S FILE=52.41 D GET^PSORN52D "RTN","PSORN52",22,0) ;Set ans to renew from Rx, only if no ans from Pend file "RTN","PSORN52",23,0) I $G(PSORENW("OIRXN")) D "RTN","PSORN52",24,0) .N PSOLDIBQ S PSOLDIBQ=$G(^PSRX(PSORENW("OIRXN"),"IBQ")) "RTN","PSORN52",25,0) .I $P(PSOIBHLD,"^")="" D "RTN","PSORN52",26,0) ..I $P($G(^PSRX(PSORENW("OIRXN"),"IB")),"^")=2 S $P(PSOIBHLD,"^")=0 "RTN","PSORN52",27,0) .I '$$DT^PSOMLLDT Q "RTN","PSORN52",28,0) .I PSOLDIBQ="" Q "RTN","PSORN52",29,0) .D IBHLD^PSORN52A "RTN","PSORN52",30,0) D INIT G:PSORN52("QFLG") END D FILE^PSORN52A "RTN","PSORN52",31,0) S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV ; Stop RT Mon "RTN","PSORN52",32,0) K PSOANSQ,PSOANSQD,PSONEWFF "RTN","PSORN52",33,0) I $G(PSOIBHLD)'="" D "RTN","PSORN52",34,0) .;Set answers based on Pend Renew, prior to Phar call "RTN","PSORN52",35,0) .Q:'$G(PSOX("IRXN")) "RTN","PSORN52",36,0) .I $P(PSOIBHLD,"^")=1!($P(PSOIBHLD,"^")=0) S PSOANSQ("SC")=$P(PSOIBHLD,"^") "RTN","PSORN52",37,0) .I '$$DT^PSOMLLDT Q "RTN","PSORN52",38,0) .I $P(PSOIBHLD,"^",2)=1!($P(PSOIBHLD,"^",2)=0) S PSOANSQ(PSOX("IRXN"),"MST")=$P(PSOIBHLD,"^",2) "RTN","PSORN52",39,0) .I $P(PSOIBHLD,"^",3)=1!($P(PSOIBHLD,"^",3)=0) S PSOANSQ(PSOX("IRXN"),"VEH")=$P(PSOIBHLD,"^",3) "RTN","PSORN52",40,0) .I $P(PSOIBHLD,"^",4)=1!($P(PSOIBHLD,"^",4)=0) S PSOANSQ(PSOX("IRXN"),"RAD")=$P(PSOIBHLD,"^",4) "RTN","PSORN52",41,0) .I $P(PSOIBHLD,"^",5)=1!($P(PSOIBHLD,"^",5)=0) S PSOANSQ(PSOX("IRXN"),"PGW")=$P(PSOIBHLD,"^",5) "RTN","PSORN52",42,0) .I $P(PSOIBHLD,"^",6)=1!($P(PSOIBHLD,"^",6)=0) S PSOANSQ(PSOX("IRXN"),"HNC")=$P(PSOIBHLD,"^",6) "RTN","PSORN52",43,0) .I $P(PSOIBHLD,"^",7)=1!($P(PSOIBHLD,"^",7)=0) S PSOANSQ(PSOX("IRXN"),"CV")=$P(PSOIBHLD,"^",7) "RTN","PSORN52",44,0) .I $P(PSOIBHLD,"^",8)=1!($P(PSOIBHLD,"^",8)=0) S PSOANSQ(PSOX("IRXN"),"SHAD")=$P(PSOIBHLD,"^",8) "RTN","PSORN52",45,0) K PSOIBHLD "RTN","PSORN52",46,0) I '$G(PSOFDR) I $G(PSORENW("OIRXN")) S FILE=52 D GET^PSORN52D "RTN","PSORN52",47,0) S PSONEW("NEWCOPAY")="" "RTN","PSORN52",48,0) I (PSOSCP<50&('$P($G(^PS(53,+$P(^PSRX(PSOX("IRXN"),0),"^",3),0)),"^",7))),$G(DUZ("AG"))="V" S PSOFLAG=0 D COPAY^PSOCPB "RTN","PSORN52",49,0) ;I PSOSCP>49!($P($G(^PS(53,+$P(^PSRX(PSOX("IRXN"),0),"^",3),0)),"^",7)=1) S PSOFLAG=0 D SC^PSOMLLD2 "RTN","PSORN52",50,0) I PSOSCA&(PSOSCP>49)!((PSOSCA!(PSOBILL=2))&($P($G(^PS(53,+$P(^PSRX(PSOX("IRXN"),0),"^",3),0)),"^",7)=1)) S PSOFLAG=0 D SC^PSOMLLD2 "RTN","PSORN52",51,0) I $$DT^PSOMLLDT D "RTN","PSORN52",52,0) .I $D(PSOIBQS(PSODFN,"CV")) D MESS D CV^PSOMLLDT I $G(PSOANSQ(PSOX("IRXN"),"CV")) K PSONEW("NEWCOPAY") "RTN","PSORN52",53,0) .I $D(PSOIBQS(PSODFN,"VEH")) D MESS D VEH^PSOMLLDT I $G(PSOANSQ(PSOX("IRXN"),"VEH")) K PSONEW("NEWCOPAY") "RTN","PSORN52",54,0) .I $D(PSOIBQS(PSODFN,"RAD")) D MESS D RAD^PSOMLLDT I $G(PSOANSQ(PSOX("IRXN"),"RAD")) K PSONEW("NEWCOPAY") "RTN","PSORN52",55,0) .I $D(PSOIBQS(PSODFN,"PGW")) D MESS D PGW^PSOMLLDT I $G(PSOANSQ(PSOX("IRXN"),"PGW")) K PSONEW("NEWCOPAY") "RTN","PSORN52",56,0) .I $D(PSOIBQS(PSODFN,"SHAD")) D MESS D SHAD^PSOMLLD2 I $G(PSOANSQ(PSOX("IRXN"),"SHAD")) K PSONEW("NEWCOPAY") "RTN","PSORN52",57,0) .I $D(PSOIBQS(PSODFN,"MST")) D MESS D MST^PSOMLLDT I $G(PSOANSQ(PSOX("IRXN"),"MST")) K PSONEW("NEWCOPAY") "RTN","PSORN52",58,0) .I $D(PSOIBQS(PSODFN,"HNC")) D MESS D HNC^PSOMLLDT I $G(PSOANSQ(PSOX("IRXN"),"HNC")) K PSONEW("NEWCOPAY") "RTN","PSORN52",59,0) K PSOSCOTH,PSOSCOTX "RTN","PSORN52",60,0) I $G(PSONEW("NEWCOPAY")) S ^PSRX(PSOX("IRXN"),"IB")=PSONEW("NEWCOPAY") "RTN","PSORN52",61,0) ; "RTN","PSORN52",62,0) D FINISH,ACP^PSOUTIL "RTN","PSORN52",63,0) ; "RTN","PSORN52",64,0) N PSOSCFLD S PSOSCFLD=$S(PSOSCP'="":$G(PSOANSQ("SC")),1:"")_"^"_$G(PSOANSQ(PSOX("IRXN"),"MST"))_"^"_$G(PSOANSQ(PSOX("IRXN"),"VEH"))_"^"_$G(PSOANSQ(PSOX("IRXN"),"RAD")) "RTN","PSORN52",65,0) S PSOSCFLD=PSOSCFLD_"^"_$G(PSOANSQ(PSOX("IRXN"),"PGW"))_"^"_$G(PSOANSQ(PSOX("IRXN"),"HNC"))_"^"_$G(PSOANSQ(PSOX("IRXN"),"CV"))_"^"_$G(PSOANSQ(PSOX("IRXN"),"SHAD")) "RTN","PSORN52",66,0) I PSOSCP<50&($TR(PSOSCFLD,"^")'="")&('$P($G(^PS(53,+$P(^PSRX(PSOX("IRXN"),0),"^",3),0)),"^",7)) S ^PSRX(PSOX("IRXN"),"IBQ")=PSOSCFLD K PSOSCFLD "RTN","PSORN52",67,0) ; "RTN","PSORN52",68,0) D FILE2^PSORN52D "RTN","PSORN52",69,0) D:$$SWSTAT^IBBAPI() GACT^PSOPFSU0(PSOX("IRXN"),0) "RTN","PSORN52",70,0) K PSONEW("NEWCOPAY"),PSOANSQ "RTN","PSORN52",71,0) END D EOJ "RTN","PSORN52",72,0) Q "RTN","PSORN52",73,0) INIT S PSORN52("QFLG")=0 S:'$D(PSOX("DAYS SUPPLY")) PSOX("DAYS SUPPLY")=$P(PSOX("RX0"),"^",8) "RTN","PSORN52",74,0) S:'$D(PSOX("# OF REFILLS")) PSOX("# OF REFILLS")=$P(PSOX("RX0"),"^",9) S:'$D(PSOX("ISSUE DATE")) PSOX("ISSUE DATE")=DT "RTN","PSORN52",75,0) D INIT^PSON52 K PSON52 "RTN","PSORN52",76,0) Q "RTN","PSORN52",77,0) ; "RTN","PSORN52",78,0) FINISH ; "RTN","PSORN52",79,0) N PSODWARN,PSOSIGNIF S (PSODWARN,PSOSIGNIF)=0 S:$$DS^PSSDSAPI&(+$G(^TMP("PSODOSF",$J,0))) PSODWARN=1 "RTN","PSORN52",80,0) I '$D(^XUSEC("PSORPH",DUZ)),$D(^TMP("PSOSER",$J,0)) N PSOINTSV S PSOINTSV="",PSOINTSV=$G(^TMP("PSOSER",$J,0)) S:PSOINTSV[1 PSODWARN=1 S:'$G(PSODWARN)&(PSOINTSV[2) PSOSIGNIF=1 "RTN","PSORN52",81,0) I '$D(^XUSEC("PSORPH",DUZ)),$G(PSODWARN)!$G(PSOSIGNIF) D ;if a tech and regardless of verification parmameter, set 52.4 if there's a critical, significant or dose waring. "RTN","PSORN52",82,0) .K DIC,DLAYGO,DINUM,DIADD,X,DD,DO S DIC="^PS(52.4,",DLAYGO=52.4,DINUM=PSOX("IRXN"),DIC(0)="ML",X=PSOX("IRXN") "RTN","PSORN52",83,0) .D FILE^DICN K DD,DO,DIC,DLAYGO,DINUM,X "RTN","PSORN52",84,0) .S ^PS(52.4,PSOX("IRXN"),0)=PSOX("IRXN")_"^"_$P(PSOX("NRX0"),"^",2)_"^"_DUZ_"^"_$G(PSOX("OIRXN"))_"^"_$E(PSOX("LOGIN DATE"),1,7)_"^"_PSOX("IRXN")_"^"_PSOX("STOP DATE") "RTN","PSORN52",85,0) .D TECH^PSODGDGP K DIK,DA S DIK="^PS(52.4,",DA=PSOX("IRXN") D IX^DIK K DIK,DA "RTN","PSORN52",86,0) ; "RTN","PSORN52",87,0) I ($P(PSOPAR,"^",2)&'$D(^XUSEC("PSORPH",DUZ))),'$G(PSODWARN),$G(PSOSIGNIF) G FINISHX "RTN","PSORN52",88,0) G FINISHP:'$D(^XUSEC("PSORPH",DUZ))&(PSOX("STATUS")=4!$G(PSODWARN)) ;if a tech and regardless of verification parmameter, set label variables if there's a critical, signifcant or dose warning. "RTN","PSORN52",89,0) G FINISHX:'$D(^XUSEC("PSORPH",DUZ))&($D(PSORX("VERIFY"))) "RTN","PSORN52",90,0) ; "RTN","PSORN52",91,0) I $G(PSOX("QS"))="S",$G(PSOBARCD) S DA=PSOX("IRXN"),RXFL(PSOX("IRXN"))=0 D SUS^PSORXL K DA G FINISHX "RTN","PSORN52",92,0) ; "RTN","PSORN52",93,0) I PSOX("FILL DATE")>DT,$P(PSOPAR,"^",6) S DA=PSOX("IRXN"),RXFL(PSOX("IRXN"))=0 D SUS^PSORXL K DA G FINISHX "RTN","PSORN52",94,0) ; "RTN","PSORN52",95,0) ; - Submitting Rx to ECME for 3rd Party Billing "RTN","PSORN52",96,0) N ACTION "RTN","PSORN52",97,0) I $$SUBMIT^PSOBPSUT(PSOX("IRXN"),0) D I ACTION="Q"!(ACTION="^") Q "RTN","PSORN52",98,0) . S ACTION="" D ECMESND^PSOBPSU1(PSOX("IRXN"),0,PSOX("FILL DATE"),"RN") "RTN","PSORN52",99,0) .; Quit if there is an unresolved Tricare non-billable reject code, PSO*7*358 "RTN","PSORN52",100,0) . I $$PSOET^PSOREJP3(PSOX("IRXN"),0) S ACTION="Q" Q "RTN","PSORN52",101,0) . I $$FIND^PSOREJUT(PSOX("IRXN"),0) D "RTN","PSORN52",102,0) . . S ACTION=$$HDLG^PSOREJU1(PSOX("IRXN"),0,"79,88","RN","IOQ","Q") "RTN","PSORN52",103,0) ; "RTN","PSORN52",104,0) I $G(PSOX("QS"))="Q",$G(PSOBARCD) D G FINISHX "RTN","PSORN52",105,0) . N PSOFROM S PSOFROM="BATCH" I $G(PPL),$L(PPL_PSOX("IRXN")_",")>240 D TRI^PSOBBC D Q^PSORXL K PPL,RXFL "RTN","PSORN52",106,0) .S RXFL(PSOX("IRXN"))=0 "RTN","PSORN52",107,0) . I $G(PPL) S PPL=PPL_PSOX("IRXN")_"," "RTN","PSORN52",108,0) . E S PPL=PSOX("IRXN")_"," "RTN","PSORN52",109,0) . Q "RTN","PSORN52",110,0) FINISHP I $G(PSORX("PSOL",1))']"" S PSORX("PSOL",1)=PSOX("IRXN")_",",RXFL(PSOX("IRXN"))=0 G FINISHX "RTN","PSORN52",111,0) F PSOX1=0:0 S PSOX1=$O(PSORX("PSOL",PSOX1)) Q:'PSOX1 S PSOX2=PSOX1 "RTN","PSORN52",112,0) I $L(PSORX("PSOL",PSOX2))+$L(PSOX("IRXN"))<220 S PSORX("PSOL",PSOX2)=PSORX("PSOL",PSOX2)_PSOX("IRXN")_"," "RTN","PSORN52",113,0) E S PSORX("PSOL",PSOX2+1)=PSOX("IRXN")_"," "RTN","PSORN52",114,0) S RXFL(PSOX("IRXN"))=0 "RTN","PSORN52",115,0) FINISHX ; "RTN","PSORN52",116,0) ;call to build bingo board Rx array "RTN","PSORN52",117,0) S:'$G(PSORX("MAIL/WINDOW")) PSORX("MAIL/WINDOW")=$P(PSORENW("NRX0"),"^",11) "RTN","PSORN52",118,0) I $G(PSORX("MAIL/WINDOW"))["W" S BINGCRT=1,BINGRTE="W",BBFLG=1 D BBRX^PSORN52C "RTN","PSORN52",119,0) K PSOX1,PSOX2,^TMP("PSODOSF") "RTN","PSORN52",120,0) Q "RTN","PSORN52",121,0) EOJ ; "RTN","PSORN52",122,0) L -^PSRX("B",PSOX("IRXN")) K PSORN52,PSOX("INS"),PSORENW("INS"),PSORXED("INS"),PSONEW("ENT"),PSORXED("ENT"),OLENT,PSOIBHLD,PSOX("SINS"),PSORENW("SINS"),PSORXED("SINS"),FILE "RTN","PSORN52",123,0) D PSOUL^PSSLOCK(PSOX("IRXN")) D PSOUL^PSSLOCK(PSOX("OIRXN")) "RTN","PSORN52",124,0) Q "RTN","PSORN52",125,0) MESS ; "RTN","PSORN52",126,0) I $G(PSOSCOTX)=1&(PSOSCP<50) W:$G(PSODRUG("DEA"))'["S"&($G(PSODRUG("DEA"))'["I") !!,"This Rx has been flagged by the provider as: "_$S($G(PSOSCOTH):"NO COPAY",$G(PSORX("SC"))="SC":"NO COPAY",1:"COPAY"),! S PSOSCOTX=2 "RTN","PSORN52",127,0) Q "RTN","PSORN52C") 0^26^B50785719^B50060838 "RTN","PSORN52C",1,0) PSORN52C ;BIR/SAB-files renewal entries con't ;08/09/93 "RTN","PSORN52C",2,0) ;;7.0;OUTPATIENT PHARMACY;**1,7,11,27,46,75,87,100,111,124,117,131,146,148,200,225,251,387**;DEC 1997;Build 13 "RTN","PSORN52C",3,0) ;External references PSOL and PSOUL^PSSLOCK supported by DBIA 2789 "RTN","PSORN52C",4,0) S DIC="^PSRX(",DLAYGO=52,DIC(0)="L",X=PSOX("NRX #") K DD,DO "RTN","PSORN52C",5,0) D FILE^DICN S PSOX("IRXN")=+Y K DLAYGO,X,Y,DIC,DD,DO "RTN","PSORN52C",6,0) D:+$G(DGI) TECH^PSODGDGI ; L +^PSRX(PSOX("IRXN")):0 "RTN","PSORN52C",7,0) D:$G(^TMP("PSODAI",$J,0)) "RTN","PSORN52C",8,0) .S $P(^PSRX(PSOX("IRXN"),3),"^",6)=1 "RTN","PSORN52C",9,0) .I $O(^TMP("PSODAI",$J,0)) S DAI=0 F S DAI=$O(^TMP("PSODAI",$J,DAI)) Q:'DAI D "RTN","PSORN52C",10,0) ..S:'$D(^PSRX(PSOX("IRXN"),"DAI",0)) ^PSRX(PSOX("IRXN"),"DAI",0)="^52.03^^" S ^PSRX(PSOX("IRXN"),"DAI",DAI,0)=^TMP("PSODAI",$J,DAI,0) "RTN","PSORN52C",11,0) ..S $P(^PSRX(PSOX("IRXN"),"DAI",0),"^",3)=+$P(^PSRX(PSOX("IRXN"),"DAI",0),"^",3)+1,$P(^(0),"^",4)=+$P(^(0),"^",4)+1 "RTN","PSORN52C",12,0) .K ^TMP("PSODAI",$J),DAI "RTN","PSORN52C",13,0) S PSORN52(PSOX("IRXN"),0)=PSOX("NRX0"),PSORN52(PSOX("IRXN"),2)=PSOX("NRX2"),PSORN52(PSOX("IRXN"),3)=PSOX("NRX3") "RTN","PSORN52C",14,0) S PSORN52(PSOX("IRXN"),"EPH")=PSOX("EPH") "RTN","PSORN52C",15,0) S:'$G(PSOX("ENT")) PSORN52(PSOX("IRXN"),"SIG")=PSOX("SIG") "RTN","PSORN52C",16,0) I '$D(^XUSEC("PSORPH",DUZ)),$$DS^PSSDSAPI&(+$G(^TMP("PSODOSF",$J,0))) S PSOX("STA")=1 "RTN","PSORN52C",17,0) S PSORN52(PSOX("IRXN"),"STA")=PSOX("STA") "RTN","PSORN52C",18,0) S:$G(PSOX("TN"))]"" PSORN52(PSOX("IRXN"),"TN")=PSOX("TN") "RTN","PSORN52C",19,0) I $G(PSOX("METHOD OF PICK-UP"))]"",PSOX("FILL DATE")'>DT S PSORN52(PSOX("IRXN"),"MP")=PSOX("METHOD OF PICK-UP") "RTN","PSORN52C",20,0) S PSORN52(PSOX("IRXN"),"TYPE")=0 "RTN","PSORN52C",21,0) S PSOX1="" F S PSOX1=$O(PSORN52(PSOX("IRXN"),PSOX1)) Q:PSOX1="" S ^PSRX(PSOX("IRXN"),PSOX1)=$G(PSORN52(PSOX("IRXN"),PSOX1)) "RTN","PSORN52C",22,0) I $O(SIG(0)) D G ENT "RTN","PSORN52C",23,0) .S II=0 F I=0:0 S I=$O(SIG(I)) Q:'I S ^PSRX(PSOX("IRXN"),"SIG1",I,0)=SIG(I),II=II+1 "RTN","PSORN52C",24,0) .S ^PSRX(PSOX("IRXN"),"SIG1",0)="^52.04A^"_II_"^"_II,$P(^PSRX(PSOX("IRXN"),"SIG"),"^",2)=1 K I,II "RTN","PSORN52C",25,0) .S $P(^PSRX(PSOX("IRXN"),"SIG"),"^",2)=1 "RTN","PSORN52C",26,0) ENT S ^PSRX(PSOX("IRXN"),"POE")=1,^PSRX(PSOX("IRXN"),"INS")=$G(PSOX("INS")) "RTN","PSORN52C",27,0) I $G(OR0) S:$P(OR0,"^",24) ^PSRX(PSOX("IRXN"),"PKI")=1 "RTN","PSORN52C",28,0) I $G(PSOX("SIG",1))]"",'$O(PSOX("SIG",1)) S ^PSRX(PSOX("IRXN"),"INS1",1,0)=PSOX("SIG",1),^PSRX(PSOX("IRXN"),"INS1",0)="^52.0115^1^1^"_DT_"^^" "RTN","PSORN52C",29,0) I $O(^PSRX(PSOX("OIRXN"),"INS1",0)) D "RTN","PSORN52C",30,0) .F D=0:0 S D=$O(^PSRX(PSOX("OIRXN"),"INS1",D)) Q:'D S ^PSRX(PSOX("IRXN"),"INS1",D,0)=^PSRX(PSOX("OIRXN"),"INS1",D,0) "RTN","PSORN52C",31,0) .S ^PSRX(PSOX("IRXN"),"INS1",0)=^PSRX(PSOX("OIRXN"),"INS1",0) "RTN","PSORN52C",32,0) TNT F I=1:1:PSOX("ENT") S ^PSRX(PSOX("IRXN"),6,I,0)=PSOX("DOSE",I)_"^"_$G(PSOX("DOSE ORDERED",I))_"^"_$G(PSOX("UNITS",I))_"^"_$G(PSOX("NOUN",I))_"^" D "RTN","PSORN52C",33,0) .S ^PSRX(PSOX("IRXN"),6,I,0)=^PSRX(PSOX("IRXN"),6,I,0)_$G(PSOX("DURATION",I))_"^"_$G(PSOX("CONJUNCTION",I))_"^"_$G(PSOX("ROUTE",I))_"^"_$G(PSOX("SCHEDULE",I))_"^"_$G(PSOX("VERB",I)) "RTN","PSORN52C",34,0) .I $G(PSOX("ODOSE",I))]"" S ^PSRX(PSOX("IRXN"),6,I,1)=PSOX("ODOSE",I) "RTN","PSORN52C",35,0) S:$G(PSOX("ENT")) ^PSRX(PSOX("IRXN"),6,0)="^52.0113^"_PSOX("ENT")_"^"_PSOX("ENT") "RTN","PSORN52C",36,0) Q "RTN","PSORN52C",37,0) ORC ; "RTN","PSORN52C",38,0) D MARK^PSOTPCAN "RTN","PSORN52C",39,0) K PSORDEDT,GG,PSOHD,PSOID,PTST,PTDY,PTRF,RFCNT,RN,SEG1,SIG,SIGOK,DIC "RTN","PSORN52C",40,0) K ST0,STA,STP,STR,JJ,LSI,MM,ORDG,ORIG,PHARMST,PSCAN,PSCNT,PSOI,GMRAL,DIC,DIE,HDR,IEN,NAME D KVA^VADPT "RTN","PSORN52C",41,0) I $G(PSOFDR) D "RTN","PSORN52C",42,0) .I $G(PKI1)=1,$G(PKIR)]"" D ACT^PSOPKIV1(PSOX("IRXN")) "RTN","PSORN52C",43,0) .S $P(^PSRX(PSOX("IRXN"),"OR1"),"^",2)=$P(OR0,"^"),^PSRX("APL",$P(OR0,"^"),PSOX("IRXN"))="" "RTN","PSORN52C",44,0) .I $P($G(^PS(52.41,+$G(ORD),"EXT")),"^")="" I $G(PSOSIGFL)!($G(PSODRUG("OI"))'=$P(OR0,"^",8)) K:'$G(PSOPRC) PRC K PHI "RTN","PSORN52C",45,0) .I $O(PRC(0)) S T=0 F S T=$O(PRC(T)) Q:'T S ^PSRX(PSOX("IRXN"),"PRC",T,0)=PRC(T),^PSRX(PSOX("IRXN"),"PRC",0)="^^"_T_"^"_T_"^"_DT_"^" "RTN","PSORN52C",46,0) .I $O(PHI(0)) S T=0 F S T=$O(PHI(T)) Q:'T S ^PSRX(PSOX("IRXN"),"PI",T,0)=PHI(T),^PSRX(PSOX("IRXN"),"PI",0)="^^"_T_"^"_T_"^"_DT_"^" "RTN","PSORN52C",47,0) .I $G(PSOSIGFL)!($G(PSODRUG("OI"))'=$P(OR0,"^",8)) D S PSOI=1 Q "RTN","PSORN52C",48,0) ..S POERR("PLACER")=$P(^PS(52.41,ORD,0),"^"),PSORDEDT=ORD "RTN","PSORN52C",49,0) ..K ^PS(52.41,"AOR",PSODFN,+$P($G(^PS(52.41,ORD,"INI")),"^"),ORD) "RTN","PSORN52C",50,0) ..S DA=ORD,DIK="^PS(52.41," D ^DIK "RTN","PSORN52C",51,0) ..S $P(^PSRX(PSOX("IRXN"),"OR1"),"^")=$G(PSODRUG("OI")) "RTN","PSORN52C",52,0) .E S $P(^PSRX(PSOX("IRXN"),"OR1"),"^")=$P(OR0,"^",8) "RTN","PSORN52C",53,0) .D PSOUL^PSSLOCK(ORD_"S") S DIK="^PS(52.41,",DA=ORD D ^DIK K DIK,DA "RTN","PSORN52C",54,0) I $G(PSOX("OIRXN")),'$G(COPY) S $P(^PSRX(PSOX("IRXN"),"OR1"),"^",3)=PSOX("OIRXN"),$P(^PSRX(PSOX("OIRXN"),"OR1"),"^",4)=PSOX("IRXN"),^PSRX("AQ",PSOX("IRXN"),PSOX("OIRXN"))="" K PRC "RTN","PSORN52C",55,0) I $O(PRC(0)) S T=0 F S T=$O(PRC(T)) Q:'T S ^PSRX(PSOX("IRXN"),"PRC",T,0)=PRC(T),^PSRX(PSOX("IRXN"),"PRC",0)="^^"_T_"^"_T_"^"_DT_"^" "RTN","PSORN52C",56,0) I $O(PHI(0)) S T=0 F S T=$O(PHI(T)) Q:'T S ^PSRX(PSOX("IRXN"),"PI",T,0)=PHI(T),^PSRX(PSOX("IRXN"),"PI",0)="^^"_T_"^"_T_"^"_DT_"^" "RTN","PSORN52C",57,0) S $P(^PSRX(PSOX("IRXN"),"OR1"),"^",5)=DUZ "RTN","PSORN52C",58,0) S $P(^PSRX(PSOX("IRXN"),"OR1"),"^",8)=$$NOW^XLFDT D "RTN","PSORN52C",59,0) . N DA,DIK S DA=PSOX("IRXN"),DIK="^PSRX(",DIK(1)=38.3 D EN1^DIK K DIK,DA "RTN","PSORN52C",60,0) S PHARMST="",$P(^PSRX(PSOX("IRXN"),"OR1"),"^")=$G(PSODRUG("OI")) "RTN","PSORN52C",61,0) S RXN=PSOX("IRXN") D SAVE "RTN","PSORN52C",62,0) S STAT=$S($G(OR0)]""&('$G(PSOI)):"SC",$G(PSOI):"RO",1:"SN") S PHARMST=$S('$G(PSORX("VERIFY")):"CM",1:"IP") ;D EN^PSOHLSN1(RXN,STAT,PHARMST,"",PSONOOR) "RTN","PSORN52C",63,0) S ^TMP("PSORXN",$J,RXN)=STAT_"^"_PHARMST_"^"_PSONOOR D PSOL^PSSLOCK(RXN) "RTN","PSORN52C",64,0) D RESTORE K PSORDEDT,PHI,PRC,STAT,COMM,PSOI,OR2,OR1,PHARMST,RXN,DRG,STA,ACT,OCXR,OCXD1,OCXDT,OCXI "RTN","PSORN52C",65,0) Q "RTN","PSORN52C",66,0) BBRX ;build bingo board Rx array; called by PSON52,PSOR52,PSORN52 "RTN","PSORN52C",67,0) I $G(BBRX(1))']"" S BBRX(1)=PSOX("IRXN")_"," Q "RTN","PSORN52C",68,0) F PSOX1=0:0 S PSOX1=$O(BBRX(PSOX1)) Q:'PSOX1 S PSOX2=PSOX1 "RTN","PSORN52C",69,0) I $L(BBRX(PSOX2))+$L(PSOX("IRXN"))<220 S BBRX(PSOX2)=BBRX(PSOX2)_PSOX("IRXN")_"," "RTN","PSORN52C",70,0) E S BBRX(PSOX2+1)=PSOX("IRXN")_"," "RTN","PSORN52C",71,0) Q "RTN","PSORN52C",72,0) SAVE ;this module will be used to save PSO arrays "RTN","PSORN52C",73,0) K ^TMP("PSOLST",$J) F I=0:0 S I=$O(PSOLST(I)) Q:'I S ^TMP("PSOLST",$J,I,0)=PSOLST(I) "RTN","PSORN52C",74,0) K ^TMP("PSOSD",$J) S (STA,DRG)="" F S STA=$O(PSOSD(STA)) Q:STA="" F S DRG=$O(PSOSD(STA,DRG)) Q:DRG="" S ^TMP("PSOSD",$J,STA,DRG)=PSOSD(STA,DRG) "RTN","PSORN52C",75,0) I $G(PSOSD) S ^TMP("PSOSD",$J,0)=PSOSD "RTN","PSORN52C",76,0) I $G(PSODRUG("NAME"))]"" K ^TMP("PSODRUG",$J) S STA="" F S STA=$O(PSODRUG(STA)) Q:STA="" D "RTN","PSORN52C",77,0) .Q:STA="BAD" "RTN","PSORN52C",78,0) .S ^TMP("PSODRUG",$J,STA)=PSODRUG(STA) "RTN","PSORN52C",79,0) I $G(PSOX("# OF REFILLS"))]"" K ^TMP("PSOX",$J),^TMP("PSORENW",$J),^TMP("PSONEW",$J),^TMP("PSORXED",$J) D "RTN","PSORN52C",80,0) .S STA="" F S STA=$O(PSOX(STA)) Q:STA="" S ^TMP("PSOX",$J,STA)=$G(PSOX(STA)) D "RTN","PSORN52C",81,0) ..I STA="OLD LAST RX#",$O(PSOX(STA,"")) K ^TMP("PSOX",$J,STA) S ^TMP("PSOX",$J,STA,$O(PSOX(STA,"")))=PSOX(STA,$O(PSOX(STA,""))) D Q "RTN","PSORN52C",82,0) ...I $O(PSONEW(STA,"")) S ^TMP("PSONEW",$J,STA,$O(PSONEW(STA,"")))=PSONEW(STA,$O(PSONEW(STA,""))) "RTN","PSORN52C",83,0) ...I $O(PSORENW(STA,"")) S ^TMP("PSORENW",$J,STA,$O(PSORENW(STA,"")))=PSORENW(STA,$O(PSORENW(STA,""))) "RTN","PSORN52C",84,0) ...I $O(PSORXED(STA,"")) S ^TMP("PSORXED",$J,STA,$O(PSORXED(STA,"")))=PSORXED(STA,$O(PSORXED(STA,""))) "RTN","PSORN52C",85,0) ..F ACT="PSORENW","PSONEW","PSORXED" I $G(@(ACT_"("""_STA_""")"))]"" S ^TMP(ACT,$J,STA)=@(ACT_"("""_STA_""")") "RTN","PSORN52C",86,0) K PSOPTPST,PSOSD,PSONEW,PSOLST,PSORENW,PSORXED,PSODRUG "RTN","PSORN52C",87,0) Q "RTN","PSORN52C",88,0) RESTORE ;this module restore saved arrays "RTN","PSORN52C",89,0) S STA=0 F S STA=$O(^TMP("PSOLST",$J,STA)) Q:'STA S PSOLST(STA)=^TMP("PSOLST",$J,STA,0) "RTN","PSORN52C",90,0) I $G(^TMP("PSOSD",$J,0)) S PSOSD=$G(^TMP("PSOSD",$J,0)) "RTN","PSORN52C",91,0) S (STA,DRG)="" F S STA=$O(^TMP("PSOSD",$J,STA)) Q:STA="" F S DRG=$O(^TMP("PSOSD",$J,STA,DRG)) Q:DRG="" S PSOSD(STA,DRG)=^TMP("PSOSD",$J,STA,DRG) "RTN","PSORN52C",92,0) S STA="" F S STA=$O(^TMP("PSODRUG",$J,STA)) Q:STA="" S PSODRUG(STA)=^TMP("PSODRUG",$J,STA) "RTN","PSORN52C",93,0) S STA="" F ACT="PSOX","PSORENW","PSONEW","PSORXED" D:$O(^TMP(ACT,$J,STA))]"" "RTN","PSORN52C",94,0) .F S STA=$O(^TMP(ACT,$J,STA)) Q:STA="" I STA'="OLD LAST RX#" S @(ACT_"("""_STA_""")")=^TMP(ACT,$J,STA) "RTN","PSORN52C",95,0) I $O(^TMP("PSOX",$J,"OLD LAST RX#","")) S PSOX("OLD LAST RX#",$O(^TMP("PSOX",$J,"OLD LAST RX#","")))=^TMP("PSOX",$J,"OLD LAST RX#",$O(^TMP("PSOX",$J,"OLD LAST RX#",""))) "RTN","PSORN52C",96,0) I $O(^TMP("PSONEW",$J,"OLD LAST RX#","")) S PSONEW("OLD LAST RX#",$O(^TMP("PSONEW",$J,"OLD LAST RX#","")))=^TMP("PSONEW",$J,"OLD LAST RX#",$O(^TMP("PSONEW",$J,"OLD LAST RX#",""))) "RTN","PSORN52C",97,0) I $O(^TMP("PSORENW",$J,"OLD LAST RX#","")) S PSORENW("OLD LAST RX#",$O(^TMP("PSORENW",$J,"OLD LAST RX#","")))=^TMP("PSORENW",$J,"OLD LAST RX#",$O(^TMP("PSORENW",$J,"OLD LAST RX#",""))) "RTN","PSORN52C",98,0) I $O(^TMP("PSORXED",$J,"OLD LAST RX#","")) S PSORXED("OLD LAST RX#",$O(^TMP("PSORXED",$J,"OLD LAST RX#","")))=^TMP("PSORXED",$J,"OLD LAST RX#",$O(^TMP("PSORXED",$J,"OLD LAST RX#",""))) "RTN","PSORN52C",99,0) K ^TMP("PSOSD",$J),^TMP("PSODRUG",$J),^TMP("PSOX",$J),^TMP("PSORENW",$J),^TMP("PSONEW",$J),^TMP("PSORXED",$J),^TMP("PSOLST",$J) "RTN","PSORN52C",100,0) Q "RTN","PSORXI") 0^19^B15276698^B15085329 "RTN","PSORXI",1,0) PSORXI ;IHS/DSD/JCM - logs pharmacy interventions ;03/19/93 11:56 "RTN","PSORXI",2,0) ;;7.0;OUTPATIENT PHARMACY;**268,324,251,387**;DEC 1997;Build 13 "RTN","PSORXI",3,0) ;External reference to ^APSPQA(32.4 supported by DBIA 2179 "RTN","PSORXI",4,0) ; This routine is used to create entries in the APSP INTERVENTION file. "RTN","PSORXI",5,0) START ; "RTN","PSORXI",6,0) D INIT,DIC G:PSORXI("QFLG") END "RTN","PSORXI",7,0) D EDIT "RTN","PSORXI",8,0) S:'$D(PSONEW("PROVIDER")) PSONEW("PROVIDER")=$P(^APSPQA(32.4,PSORXI("DA"),0),"^",3) "RTN","PSORXI",9,0) END D EOJ "RTN","PSORXI",10,0) Q "RTN","PSORXI",11,0) INIT ; "RTN","PSORXI",12,0) W !!,"Now creating Pharmacy Intervention",! "RTN","PSORXI",13,0) I $G(PSODRUG("IEN")) W "for "_$P($G(^PSDRUG(PSODRUG("IEN"),0)),"^"),! "RTN","PSORXI",14,0) K PSORXI S PSORXI("QFLG")=0 "RTN","PSORXI",15,0) Q "RTN","PSORXI",16,0) DIC ; "RTN","PSORXI",17,0) K DIC,DR,DA,X,Y,DD,DO S DIC="^APSPQA(32.4,",DLAYGO=9009032.4,DIC(0)="L",X=DT "RTN","PSORXI",18,0) S DIC("DR")=".02////"_+PSODFN_";.04////"_DUZ_";.05////"_PSODRUG("IEN")_";.06///PHARMACY" "RTN","PSORXI",19,0) S DIC("DR")=DIC("DR")_";.07"_$S($G(PSOIVDSN):"////"_$G(PSOIVDSN),$G(PSORX("INTERVENE"))=1:"////18",$G(PSORX("INTERVENE"))=2:"////19",1:"////6")_";.14////0"_";.16////"_$S($G(PSOSITE)]"":PSOSITE,1:"") "RTN","PSORXI",20,0) D FILE^DICN K DIC,DR,DA "RTN","PSORXI",21,0) I Y>0 S PSORXI("DA")=+Y "RTN","PSORXI",22,0) E S PSORXI("QFLG")=1 G DICX "RTN","PSORXI",23,0) D DIE "RTN","PSORXI",24,0) DICX K X,Y "RTN","PSORXI",25,0) Q "RTN","PSORXI",26,0) DIE ; "RTN","PSORXI",27,0) K DIE,DIC,DR,DA "RTN","PSORXI",28,0) S DIE="^APSPQA(32.4,",DA=PSORXI("DA"),DR=$S($G(PSORXI("EDIT"))]"":".03:1600",1:".03;.08") "RTN","PSORXI",29,0) L +^APSPQA(32.4,PSORXI("DA")):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) D ^DIE K DIE,DIC,DR,X,Y,DA L -^APSPQA(32.4,PSORXI("DA")) "RTN","PSORXI",30,0) W $C(7),!!,"See 'Pharmacy Intervention Menu' if you want to delete this",!,"intervention or for more options.",! "RTN","PSORXI",31,0) Q "RTN","PSORXI",32,0) EDIT ; "RTN","PSORXI",33,0) K DIR W ! S DIR(0)="Y",DIR("A")="Would you like to edit this intervention ",DIR("B")="N" D ^DIR K DIR I $D(DIRUT)!'Y G EDITX "RTN","PSORXI",34,0) S PSORXI("EDIT")=1 D DIE G EDIT "RTN","PSORXI",35,0) EDITX W ! K X,Y "RTN","PSORXI",36,0) Q "RTN","PSORXI",37,0) DUPINV ;Duplicate and file intervention "RTN","PSORXI",38,0) N PSOARY,PSOARYC,PSOMSG,PSODA,DUP,DIC,DA,DLAYGO,Y,X "RTN","PSORXI",39,0) S DUP=^TMP($J,"PSOINTERVENE",+PSODFN),DIC="^APSPQA(32.4,",DIC(0)="AEQM" "RTN","PSORXI",40,0) D GETS^DIQ(9009032.4,DUP,"**","I","PSOARY","PSOMSG") "RTN","PSORXI",41,0) I $D(PSOMSG) W !,"Error Retrieving Last Duplicate..." G START "RTN","PSORXI",42,0) L +^APSPQA(32.4):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) "RTN","PSORXI",43,0) K DIC,DR,DA,X,Y,DD,DO "RTN","PSORXI",44,0) S DIC="^APSPQA(32.4,",DLAYGO=9009032.4,DIC(0)="",X=DT "RTN","PSORXI",45,0) D FILE^DICN "RTN","PSORXI",46,0) L -^APSPQA(32.4) "RTN","PSORXI",47,0) I Y<1 W !,"Error Encountered Filing Duplicate..." Q "RTN","PSORXI",48,0) S DA=+Y,PSORXI("DA")=+Y,X=0,^TMP($J,"PSOINTERVENE",PSODFN)=+Y "RTN","PSORXI",49,0) F S X=$O(PSOARY(9009032.4,DUP_",",X)) Q:'X D "RTN","PSORXI",50,0) .S PSOARYC(9009032.4,DA_",",X)=PSOARY(9009032.4,DUP_",",X,"I") "RTN","PSORXI",51,0) S PSOARYC(9009032.4,DA_",",.05)=PSODRUG("IEN") "RTN","PSORXI",52,0) S PSOARYC(9009032.4,DA_",",.15)="" "RTN","PSORXI",53,0) D FILE^DIE("K","PSOARYC","PSOMSG") I $D(PSOMSG) D G START "RTN","PSORXI",54,0) .W !,"Error Encountered Filing Duplicate..." "RTN","PSORXI",55,0) .N DIK S DA=PSORXI("DA"),DIK="^APSPQA(32.4," D ^DIK "RTN","PSORXI",56,0) W ! D EN^DIQ,EDIT "RTN","PSORXI",57,0) Q "RTN","PSORXI",58,0) EOJ ; "RTN","PSORXI",59,0) K PSORXI "RTN","PSORXI",60,0) Q "RTN","PSORXI",61,0) EN1(PSOX) ; Entry Point if have internal rx # "RTN","PSORXI",62,0) N PSODFN,PSONEW,PSODRUG,PSOY "RTN","PSORXI",63,0) I $G(^PSRX(+$G(PSOX),0))']"" W !,$C(7),"No prescription data" G EN1X "RTN","PSORXI",64,0) S PSORXI("IRXN")=PSOX K PSOY S PSOY=^PSRX(PSORXI("IRXN"),0) "RTN","PSORXI",65,0) S PSODFN=$P(PSOY,"^",2),PSONEW("PROVIDER")=$P(PSOY,"^",4),PSODRUG("IEN")=$P(PSOY,"^",6) "RTN","PSORXI",66,0) D START "RTN","PSORXI",67,0) EN1X ; "RTN","PSORXI",68,0) Q "RTN","PSORXI",69,0) ; "RTN","PSORXI",70,0) EN2(PSOIVDST,PSOX) ; Entry Point for dose interventions with a prescription "RTN","PSORXI",71,0) ;PSOIVDST = Dosing intervention text "RTN","PSORXI",72,0) ;PSOX = Internal prescription Number "RTN","PSORXI",73,0) N PSOIVDSN S PSOIVDSN=0 "RTN","PSORXI",74,0) D LOOK I 'PSOIVDSN Q 1 "RTN","PSORXI",75,0) N PSODFN,PSONEW,PSODRUG,PSOY "RTN","PSORXI",76,0) I $G(^PSRX(+$G(PSOX),0))']"" W !,$C(7),"No prescription data" G EN2X "RTN","PSORXI",77,0) S PSORXI("IRXN")=PSOX K PSOY S PSOY=^PSRX(PSORXI("IRXN"),0) "RTN","PSORXI",78,0) S PSODFN=$P(PSOY,"^",2),PSONEW("PROVIDER")=$P(PSOY,"^",4),PSODRUG("IEN")=$P(PSOY,"^",6) "RTN","PSORXI",79,0) D START K PSOIVDSN "RTN","PSORXI",80,0) EN2X Q 0 "RTN","PSORXI",81,0) ; "RTN","PSORXI",82,0) EN3(PSOIVDST) ; Entry Point for dose interventions without a prescription "RTN","PSORXI",83,0) ;PSOIVDST = Dosing intervention text "RTN","PSORXI",84,0) N PSOIVDSN S PSOIVDSN=0 "RTN","PSORXI",85,0) D LOOK I 'PSOIVDSN Q 1 "RTN","PSORXI",86,0) D START K PSOIVDSN "RTN","PSORXI",87,0) EN3X Q 0 "RTN","PSORXI",88,0) ; "RTN","PSORXI",89,0) LOOK ;Find Internal Number of 32.3 file "RTN","PSORXI",90,0) S PSOIVDSN=$$FIND1^DIC(9009032.3,"","X",PSOIVDST,"B") "RTN","PSORXI",91,0) Q "RTN","PSOVER") 0^8^B79826569^B79569350 "RTN","PSOVER",1,0) PSOVER ;BIR/SAB - verify rx's by clerk ;07/03/95 "RTN","PSOVER",2,0) ;;7.0;OUTPATIENT PHARMACY;**16,21,27,117,131,146,251,375,387**;DEC 1997;Build 13 "RTN","PSOVER",3,0) ;External references L, UL, PSOL, and PSOUL^PSSLOCK supported by DBIA 2789 "RTN","PSOVER",4,0) ;External reference to ^PS(56 supported by DBIA 2229 "RTN","PSOVER",5,0) D:'$D(PSOPAR) ^PSOLSET I '$D(PSOPAR) W $C(7),!!,"Pharmacy Division Must be Selected!",! Q "RTN","PSOVER",6,0) Q:'$D(^XUSEC("PSORPH",DUZ)) S PSOZVER=1 "RTN","PSOVER",7,0) PAT K PSOTT,PSOACT,PSOVER,PSOQUIT,PSORX("DFLG"),DTOUT,DIRUT,PSOVQUIT W !! S DIC("A")="Enter PATIENT NAME (or ^C to verify for a clerk): ",DIC="^DPT(",DIC("S")="I $D(^PS(52.4,""C"",+Y))",DIC(0)="QEAMZ" D ^DIC K DIC G CLERK:$E(X,1,2)="^C",END:Y'>0 "RTN","PSOVER",8,0) S PSONV=0,(DFN,PSDFN,PSODFN)=+Y,PPL="",PSONAM=$P(^DPT(PSDFN,0),"^") D ^PSOBUILD "RTN","PSOVER",9,0) L1 D PID^VADPT S PSONV=$O(^PS(52.4,"C",PSDFN,PSONV)) I 'PSONV D:$$GET1^DIQ(52,PSONV,100,"I")'=13 PACK G PAT "RTN","PSOVER",10,0) F DGDG=0:0 S DGDG=$O(^PS(52.4,"C",PSDFN,DGDG)) S PSONV=DGDG K PSOSIG,PSOTHER Q:'DGDG!($G(PSOQUIT)) D Q:$G(DIRUT) "RTN","PSOVER",11,0) .I $D(^PS(52.4,"ADI",DGDG,1)) S PSONV=DGDG D DGDGI Q "RTN","PSOVER",12,0) .I $D(^PSRX(PSONV,"DRI")) S PSOSIG=1 D DGDGI Q "RTN","PSOVER",13,0) .D:'$D(^PS(52.4,"ADI",PSONV,1))&('$D(^PSRX(PSONV,"DRI"))) DSPL Q "RTN","PSOVER",14,0) G QUIT:$D(PSOSD) "RTN","PSOVER",15,0) ; "RTN","PSOVER",16,0) SHOW I '$D(PSOSD) W !,$C(7),"This patient has no prescriptions on file",!! Q "RTN","PSOVER",17,0) I ($Y+5)>IOSL D HD^PSODDPR2(5) Q:$G(PSODLQT) "RTN","PSOVER",18,0) W !,$P(^DPT(DFN,0),"^"),?40,"ID#:"_VA("PID") W:$D(INT)!$D(PSONV) " RX#: "_$S($D(INT):$P(INT,"^"),$D(^PSRX(PSONV)):$P(^PSRX(PSONV,0),"^"),1:"") "RTN","PSOVER",19,0) D ^PSODSPL "RTN","PSOVER",20,0) SHOW2 ; "RTN","PSOVER",21,0) I ($Y+5)>IOSL D HD^PSODDPR2() Q "RTN","PSOVER",22,0) Q:$Y<5 "RTN","PSOVER",23,0) N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT "RTN","PSOVER",24,0) K DIR W ! S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR "RTN","PSOVER",25,0) W @IOF "RTN","PSOVER",26,0) Q "RTN","PSOVER",27,0) ; "RTN","PSOVER",28,0) CLERK D:'$D(PSOPAR) ^PSOLSET I '$D(PSOPAR) W $C(7),!!,"Pharmacy Division Must be Selected!",! G END "RTN","PSOVER",29,0) K PSOVERPL,PSOVERPX,PSOVERPH,PSOVERLX,PSOVERQ,PSORX("DFLG"),DIRUT,DTOUT,PSOVQUIT "RTN","PSOVER",30,0) K PSOQUIT,PSOCQ,PSOVORD,PSOINTV S PSOCLK=1 W ! S DIC="^VA(200,",DIC(0)="AEQM",DIC("S")="I $D(^PS(52.4,""D"",+Y))",DIC("A")="Enter Clerk Name: " "RTN","PSOVER",31,0) D ^DIC K DIC K:Y'>0!($D(DTOUT)) PSORX G END:Y'>0!($D(DTOUT)) "RTN","PSOVER",32,0) S PSOTT=+Y,(PSONV,PSDFN0)=0,PPL="" K PSOVER,PSONAM "RTN","PSOVER",33,0) CL1 F DGDG=0:0 S DGDG=$O(^PS(52.4,"D",PSOTT,DGDG)) Q:'DGDG!($G(PSOQUIT))!($G(PSOCQ)) D Q:$D(DIRUT) "RTN","PSOVER",34,0) .S PSOVQUIT=0,(DFN,PSOVERPX,PSDFN,PSODFN)=$P(^PS(52.4,DGDG,0),"^",2),PSONV=DGDG D PATCHK K PSOSIG,PSOTHER "RTN","PSOVER",35,0) .S CLFLAG=1 D STAT^PSODGDG2 K CLFLAG D:'$G(FLAGST) Q:$D(DIRUT) "RTN","PSOVER",36,0) ..S PSONVXX=PSONV I $G(PSOVERPH)=$G(PSOVERPX),$G(PSOVERLX) Q "RTN","PSOVER",37,0) ..I $G(PSOVERPH)'=$G(PSOVERPX) K PSOVERLX D:$G(PSOVERPH)&('$G(PSOVERPL)) ULP S PSOVERPH=PSOVERPX D LPAT I $G(PSOVERPL) Q "RTN","PSOVER",38,0) ..S PSDFN0=PSDFN D LRX I '$G(PSOMSG) Q "RTN","PSOVER",39,0) ..K PSOMSG I $D(^PS(52.4,"ADI",DGDG,1)) S PSONV=DGDG D DSPL D PSOUL^PSSLOCK(PSONVXX) Q "RTN","PSOVER",40,0) ..I $D(^PSRX(PSONV,"DRI")) S PSOSIG=1 D DSPL D PSOUL^PSSLOCK(PSONVXX) Q "RTN","PSOVER",41,0) ..D:'$D(^PS(52.4,"ADI",PSONV,1))&('$D(^PSRX(PSONV,"DRI"))) DSPL D PSOUL^PSSLOCK(PSONVXX) Q "RTN","PSOVER",42,0) D:$G(PSOVERPH)&('$G(PSOVERPL)) ULP "RTN","PSOVER",43,0) CL2 D:$$GET1^DIQ(52,PSONV,100,"I")'=13 PACK G CLERK "RTN","PSOVER",44,0) PATCHK I $D(PSOVER),PSDFN0,PSDFN0'=DFN S (DFN,PSDFN)=PSDFN0 D PACK S (DFN,PSDFN)=PSODFN D ^PSOBUILD,PID^VADPT S PSONAM=$P(^DPT(DFN,0),"^") Q "RTN","PSOVER",45,0) I PSDFN0'=DFN D ^PSOBUILD,PID^VADPT S PSONAM=$P(^DPT(DFN,0),"^") "RTN","PSOVER",46,0) Q "RTN","PSOVER",47,0) PACK Q:$$GET1^DIQ(52,PSONV,100,"I")=13 S PPL="" F J=0:0 S J=$O(PSOVER(J)) Q:'J S PPL=PPL_J_"," "RTN","PSOVER",48,0) I PPL]"" S PSOOPT=3,PSOTRVV=1 D ^PSORXL K PSOOPT,PSOTRVV "RTN","PSOVER",49,0) K PSD,PSOVER S PPL="" Q "RTN","PSOVER",50,0) QUIT D PACK "RTN","PSOVER",51,0) END K CAN,CLS,DA,DEA1,DEA2,DIC,DIE,DR,DRG,DRGG,DUP,DUPRX,DUPRX0,FLDT,I,ISDT,ISSD,J,LSTFL,PHYS,PPL,PSC,PSD,PSDFN,PSDFN0,PSDNEW,PSDOLD,PSMSG,PSOQUIT,PSOTT,PSOVER,PSREA,PSRFLS,PSRX,PSRX1,PSRX2,PSRXREF,PSVERFLG,RFLS,RX0,RX2,RX3,ST,ST0,STAR,X "RTN","PSOVER",52,0) K D0,DQ,N,PHY,RFL,PSI,PSOTHER,PSS,PSOZVER,PI,PTST,SD,PSONAM,PSONULN,RFDATE,RFL1,RXF,Z,DRUG,II,RFLL,DRGX,DIPGM,PSOCNT,A1,C,ST00,FLAGST,STEXT,PSOCLK,PSOCQ,PSOVERPL,PSOVERPX,PSOVERPH,PSOVERLX,VERLFLAG,PSONVXX D KVA^VADPT "RTN","PSOVER",53,0) K PSONOOR,PSOSIG,DIR,DUOUT,DTOUT,DIRUT,DIROUT,INA,MED,SER1,PSOVORD,PSOINTV,PSOVQUIT,PSVFLAG ;K:'$G(POERR) PSOSD "RTN","PSOVER",54,0) Q "RTN","PSOVER",55,0) DSPL ; "RTN","PSOVER",56,0) Q:$P(^PSRX(PSONV,"STA"),"^")=13 "RTN","PSOVER",57,0) S DA=PSONV I $P($G(^PSRX(DA,"PKI")),"^") N PKI,PKI1,PKIR,PKIE D CER^PSOPKIV1 "RTN","PSOVER",58,0) S PSVFLAG=1 D ^PSOVER1 I $G(PSORX("DFLG")) K PSVFLAG "RTN","PSOVER",59,0) Q "RTN","PSOVER",60,0) DGDGI ;process drug interaction for non verified rxs "RTN","PSOVER",61,0) K DIRUT,DTOUT,PSORX("DFLG") "RTN","PSOVER",62,0) S SER1=$S('$G(PSOSIG):$P(^PS(52.4,PSONV,0),"^",9),1:$P(^PSRX(PSONV,"DRI"),"^")),PSVFLAG=1 "RTN","PSOVER",63,0) S MED=$S('$G(PSOSIG):$P(^PS(52.4,PSONV,0),"^",10),1:$P(^PSRX(PSONV,"DRI"),"^",2)) "RTN","PSOVER",64,0) K LOCKARRY,PSOVMSGX S VERLFLAG=0 I $G(MED) F LOCKINA=1:1 S PSOLKVRX=$P(MED,",",LOCKINA) Q:$G(PSOLKVRX)=""!($G(VERLFLAG)) D LK1 "RTN","PSOVER",65,0) I $G(MED) I $G(VERLFLAG) D:$D(LOCKARRY) ULK1 W !!,"Cannot process this prescription, one of the interacting medications is",!,"being edited.",! D G DONEX "RTN","PSOVER",66,0) .I $G(PSOVMSGX)'="" W PSOVMSGX,! "RTN","PSOVER",67,0) .K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to continue" "RTN","PSOVER",68,0) .D ^DIR K DIR,PSOVMSGX "RTN","PSOVER",69,0) K PSOVMSGX "RTN","PSOVER",70,0) S PSVERFLG=0,IFN=PSONV,INT=^PSRX(IFN,0) N PSOOLDFN S PSOOLDFN=DFN "RTN","PSOVER",71,0) F INA=1:1 S PSODFN=DFN Q:$P(SER1,",",INA)=""!($G(MED)="") D Q:$G(PSOVQUIT)!$G(PSORX("DFLG")) "RTN","PSOVER",72,0) .I $P(SER1,",",INA) S SER=^PS(56,$P(SER1,",",INA),0) "RTN","PSOVER",73,0) .E S $P(SER,"^",4)=$S($P(SER1,",",INA)="Critical":1,1:2) "RTN","PSOVER",74,0) .S RX=^PSRX(PSONV,0),STA=+$G(^("STA")),$P(RX,"^",15)=STA,PSOOPT=1 "RTN","PSOVER",75,0) .W !!!,$P(^DPT(DFN,0),"^"),?39,"ID#: ",$E($P(^(0),"^",9),1,3)_"-"_$E($P(^(0),"^",9),4,5)_"-"_$E($P(^(0),"^",9),6,9),?57,"RX: ",$P(^PSRX(PSONV,0),"^") "RTN","PSOVER",76,0) .I STA'=13 D FULL^VALM1 D ^PSOVER1 S:'$G(DFN) DFN=PSOOLDFN "RTN","PSOVER",77,0) Q:$G(PSORX("DFLG")) Q:$G(DIRUT)!($G(DTOUT)) "RTN","PSOVER",78,0) I '$G(PSVERFLG),$P(^PSRX(PSONV,"STA"),"^")=4!($P(^("STA"),"^")=1) S $P(^PSRX(PSONV,"STA"),"^")=1 D DSPL G DONE "RTN","PSOVER",79,0) I '$D(^PS(52.4,"ADI",PSONV,1)),$P(^PSRX(PSONV,"STA"),"^")=1 D DSPL G DONEX:$G(DIRUT)!($G(DTOUT)) G DONE "RTN","PSOVER",80,0) DONE K PSOVORD I $P(^PSRX(PSONV,"STA"),"^")'=1,$P(^("STA"),"^")'=4 K ^PSRX(PSONV,"DRI") "RTN","PSOVER",81,0) S PSOTHER="" F S PSOTHER=$O(PSOTHER(PSOTHER)) Q:PSOTHER="" D "RTN","PSOVER",82,0) .I $G(PSOTHER),$P($G(^PSRX(PSOTHER,"STA")),"^")=1,$P($G(^PS(52.4,PSOTHER,0)),"^",10)="" S PSONV=PSOTHER D DSPL "RTN","PSOVER",83,0) D:$D(LOCKARRY) ULK1 "RTN","PSOVER",84,0) DONEX K PSOOPT,SER,LOCKARRY,LOCKINA,PSOLKVRX,DTOUT,DIRUT,PSORX("DFLG") "RTN","PSOVER",85,0) Q "RTN","PSOVER",86,0) OERR ; "RTN","PSOVER",87,0) N PSOEDITF,PSOVEDIT,PSOOORN,XQORNOD,Y S PSOVEDIT=0 "RTN","PSOVER",88,0) K PSONOOR,PSODLQT,PSOVER,PSVERFLG,PSOVORD,PSOSIG I $G(PSONACT) W $C(7),$C(7) S VALMSG="No Pharmacy Orderable Item!",VALMBCK="" Q "RTN","PSOVER",89,0) I $G(PSOTPBFG) N PSOTPPEN,PSOTPPEX,PSOTPPE9 S PSOTPPEN=$P(PSOLST($P(PSLST,",",ORD)),"^",2),PSOTPPEX=0,PSOTPPE9=1 D VOPN^PSOTPCAN I PSOTPPEX S VALMBCK="" K PSOTPPEN,PSOTPPEX,PSOTPPE9 Q "RTN","PSOVER",90,0) K PSOTPPEN,PSOTPPEX,PSOTPPE9,PSORX("DFLG") "RTN","PSOVER",91,0) I $G(PSOBEDT) W $C(7),$C(7) S VALMSG="Invalid Action at this time !",VALMBCK="" Q "RTN","PSOVER",92,0) I '$D(^XUSEC("PSORPH",DUZ)) S VALMSG="Unauthorized Action!",VALMBCK="" Q "RTN","PSOVER",93,0) S PSOVRXN=$P(PSOLST($P(PSLST,",",ORD)),"^",2),PSOVDFN=$P($G(^PSRX(PSOVRXN,0)),"^",2) "RTN","PSOVER",94,0) S PSOPLCK=$$L^PSSLOCK(PSOVDFN,0) I '$G(PSOPLCK) S VALMSG=$S($P($G(PSOPLCK),"^",2)'="":$P($G(PSOPLCK),"^",2)_" is working on this patient.",1:"Another person is editing orders for this patient.") S VALMBCK="" K PSOPLCK Q "RTN","PSOVER",95,0) K PSOPLCK D PSOL^PSSLOCK(PSOVRXN) I '$G(PSOMSG) D UL^PSSLOCK(PSOVDFN) S VALMSG=$S($P($G(PSOMSG),"^",2)'="":$P($G(PSOMSG),"^",2),1:"Another person is editing this order.") K PSOMSG S VALMBCK="" Q "RTN","PSOVER",96,0) N PSODFN S (PSOZVER,PSLSTVER)=1 "RTN","PSOVER",97,0) D FULL^VALM1 S (PSONV,X,DA)=$P(PSOLST($P(PSLST,",",ORD)),"^",2) K DIC S DIC(0)="NZ",DIC=52.4 D ^DIC K DIC I Y<1 D D:'$G(PSLSTVER) ULB Q:'$G(PSLSTVER) "RTN","PSOVER",98,0) .I $P($G(^PSRX(+PSONV,"STA")),"^")'=1,$P($G(^("STA")),"^")'=4 K PSONV,DA,X,Y,PSOZVER,PSLSTVER S VALMSG="Invalid Action Selection!",VALMBCK="" Q "RTN","PSOVER",99,0) .S PSLSTVER=2 "RTN","PSOVER",100,0) .S DIC="^PS(52.4,",DLAYGO=52.4,(DINUM,X)=PSONV,DIC(0)="L" K DD,DO D FILE^DICN K DD,DO,DIC,DINUM,DLAYGO "RTN","PSOVER",101,0) .S ^PS(52.4,PSONV,0)=PSONV_"^"_$P(^PSRX(PSONV,0),"^",2)_"^"_+$P(^(0),"^",16)_"^^"_$E($P($G(^(2)),"^"),1,7)_"^"_PSONV_"^"_$E($P($G(^(2)),"^",6),1,7) "RTN","PSOVER",102,0) .S DIK="^PS(52.4,",DA=PSONV D IX^DIK K DIK S Y(0)=^PS(52.4,PSONV,0),(X,DA)=PSONV "RTN","PSOVER",103,0) D STAT^PSODGDG2 G:FLAGST EOJ "RTN","PSOVER",104,0) N LST S (DFN,PSDFN,PSODFN)=$P(^PSRX(PSONV,0),"^",2),PPL="",PSONAM=$P(^DPT(PSDFN,0),"^") "RTN","PSOVER",105,0) D PID^VADPT S PSOVORD=PSONV "RTN","PSOVER",106,0) I $D(^PS(52.4,"ADI",PSONV,1)) D DGDGI G:$G(PSOVQUIT)!$G(PSORX("DFLG")) EOJ G PPL "RTN","PSOVER",107,0) I $D(^PSRX(PSONV,"DRI")) S PSOSIG=1 D DGDGI G:$G(PSOVQUIT)!$G(PSORX("DFLG")) EOJ G PPL "RTN","PSOVER",108,0) G:$G(PSORX("DFLG")) EOJ D DSPL "RTN","PSOVER",109,0) PPL I $G(PSLSTVER)=2,$D(^PS(52.4,PSONV,0)) S DA=PSONV,DIK="^PS(52.4," D ^DIK K DIK,DA "RTN","PSOVER",110,0) G EOJ:'$O(PSOVER(0)) "RTN","PSOVER",111,0) S PSONVLP="" F S PSONVLP=$O(PSOVER(PSONVLP)) Q:PSONVLP="" D "RTN","PSOVER",112,0) .D MARKV^PSOTPCAN "RTN","PSOVER",113,0) .I $G(PSORX("PSOL",1))']"" S PSORX("PSOL",1)=PSONVLP_"," Q "RTN","PSOVER",114,0) .F PSOX1=0:0 S PSOX1=$O(PSORX("PSOL",PSOX1)) Q:'PSOX1 S PSOX2=PSOX1 "RTN","PSOVER",115,0) .I $L(PSORX("PSOL",PSOX2))+$L(PSONVLP)<220 S PSORX("PSOL",PSOX2)=PSORX("PSOL",PSOX2)_PSONVLP_"," "RTN","PSOVER",116,0) .E S PSORX("PSOL",PSOX2+1)=PSONVLP_"," "RTN","PSOVER",117,0) EOJ D ULB,END "RTN","PSOVER",118,0) K D,DGDG,MW,PSONVLP,P,PCOMX,PDA,PSPRXN,RX,PSD,PSOSTA,PSLSTVER,PSOVORD,PSVFLAG "RTN","PSOVER",119,0) I $G(PSOCLK),$G(PSLST) K PSLST "RTN","PSOVER",120,0) I $G(PSOCLK)!($G(PSOPOCK)) D FULL^VALM1 K VALMBCK D ^PSOBUILD,BLD^PSOORUT1 S Y=0 F S Y=$O(PSOLST(Y)) Q:Y="" I $P(PSOLST(Y),"^",2)=PSONV S PSLST=","_Y Q "RTN","PSOVER",121,0) I $G(^PSRX(PSONV,"STA"))'=1&($G(^PSRX(PSONV,"STA"))'=4) S VALMBCK="Q" G EOJ2 "RTN","PSOVER",122,0) I '$G(PSOCLK)!('$G(PSOPOCK)) S VALMBCK="R" "RTN","PSOVER",123,0) EOJ2 ; "RTN","PSOVER",124,0) K PSONV,Y "RTN","PSOVER",125,0) L -^PSRX($P(PSOLST(ORN),"^",2)) "RTN","PSOVER",126,0) Q "RTN","PSOVER",127,0) LPAT ; "RTN","PSOVER",128,0) K PSOVERPL "RTN","PSOVER",129,0) I '$G(PSOVERPX) Q "RTN","PSOVER",130,0) S PSOPLCK=$$L^PSSLOCK(PSOVERPX,0) I '$G(PSOPLCK) D LOCK^PSOORCPY S (PSOVERPL,PSOVERLX)=1 "RTN","PSOVER",131,0) K PSOPLCK "RTN","PSOVER",132,0) Q "RTN","PSOVER",133,0) ULP ; "RTN","PSOVER",134,0) I '$G(PSOVERPH) Q "RTN","PSOVER",135,0) D UL^PSSLOCK(PSOVERPH) K PSOVERPH "RTN","PSOVER",136,0) Q "RTN","PSOVER",137,0) LRX ; "RTN","PSOVER",138,0) K PSOMSG I '$G(PSONV) Q "RTN","PSOVER",139,0) D PSOL^PSSLOCK(PSONV) I '$G(PSOMSG) W !!,$S($P($G(PSOMSG),"^",2)'="":$P($G(PSOMSG),"^",2),1:"Another person is editing this order."),! D K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to Continue" D ^DIR K DIR "RTN","PSOVER",140,0) .I $G(PSDFN) W "for patient "_$P($G(^DPT(PSDFN,0)),"^")_".",! "RTN","PSOVER",141,0) Q "RTN","PSOVER",142,0) ULRX ; "RTN","PSOVER",143,0) I '$G(PSONV) Q "RTN","PSOVER",144,0) D PSOUL^PSSLOCK(PSONV) "RTN","PSOVER",145,0) Q "RTN","PSOVER",146,0) LK1 ; "RTN","PSOVER",147,0) I '$G(PSOLKVRX) Q "RTN","PSOVER",148,0) D PSOL^PSSLOCK(PSOLKVRX) I '$G(PSOMSG) S VERLFLAG=1,PSOVMSGX=$P($G(PSOMSG),"^",2) Q "RTN","PSOVER",149,0) S LOCKARRY(PSOLKVRX)=PSOLKVRX "RTN","PSOVER",150,0) Q "RTN","PSOVER",151,0) ULK1 ; "RTN","PSOVER",152,0) I '$D(LOCKARRY) Q "RTN","PSOVER",153,0) S PSOVOLK="" F S PSOVOLK=$O(LOCKARRY(PSOVOLK)) Q:$G(PSOVOLK)="" D PSOUL^PSSLOCK(PSOVOLK) "RTN","PSOVER",154,0) K PSOVOLK "RTN","PSOVER",155,0) Q "RTN","PSOVER",156,0) ULB ; "RTN","PSOVER",157,0) I $G(PSOVDFN) D UL^PSSLOCK(PSOVDFN) "RTN","PSOVER",158,0) I $G(PSOVRXN) D PSOUL^PSSLOCK(PSOVRXN) "RTN","PSOVER",159,0) K PSOVDFN,PSOVRXN "RTN","PSOVER",160,0) Q "RTN","PSOVER1") 0^9^B116713560^B114770420 "RTN","PSOVER1",1,0) PSOVER1 ;BHAM ISC/SAB - verify one rx ;3/9/05 12:53pm "RTN","PSOVER1",2,0) ;;7.0;OUTPATIENT PHARMACY;**32,46,90,131,202,207,148,243,268,281,324,358,251,375,387**;DEC 1997;Build 13 "RTN","PSOVER1",3,0) ;External reference ^PSDRUG( supported by DBIA 221 "RTN","PSOVER1",4,0) ;External reference to PSOUL^PSSLOCK supported by DBIA 2789 "RTN","PSOVER1",5,0) ;External reference ^PS(55 supported by DBIA 2228 "RTN","PSOVER1",6,0) ;External reference to PSSORPH is supported by DBIA 3234 "RTN","PSOVER1",7,0) ;External references to ^ORRDI1 supported by DBIA 4659 "RTN","PSOVER1",8,0) ;External reference ^XTMP("ORRDI" supported by DBIA 4660 "RTN","PSOVER1",9,0) ;External reference to $$DS^PSSDSAPI supported by DBIA 5425 "RTN","PSOVER1",10,0) ;External reference to ^PS(4 supported by DBIA 2229 "RTN","PSOVER1",11,0) ;External reference to $$GETNDC^PSSNDCUT supported by DBIA 4707 "RTN","PSOVER1",12,0) REDO ; "RTN","PSOVER1",13,0) I '$G(PSOCLK) Q:$G(PSVERFLG) "RTN","PSOVER1",14,0) S (DRG,PSODRUG("NAME"))=$P(^PSDRUG(+$P(^PSRX(PSONV,0),"^",6),0),"^"),PSODRUG("VA CLASS")=$P(^(0),"^",2) "RTN","PSOVER1",15,0) S PSOVQUIT=0,PSODRUG("IEN")=$P(^PSRX(PSONV,0),"^",6) "RTN","PSOVER1",16,0) S PSOY(0)=^PSDRUG(PSODRUG("IEN"),0),PSOY=PSODRUG("IEN")_"^"_$P(PSOY(0),"^") "RTN","PSOVER1",17,0) D SET^PSODRG "RTN","PSOVER1",18,0) I '$D(PSODFN) S PSODFN=$P(^PSRX(PSONV,0),"^",2) "RTN","PSOVER1",19,0) ; "RTN","PSOVER1",20,0) EDIT ; "RTN","PSOVER1",21,0) S (PSDNEW,PSDOLD)="",PSDOLD=$P(^PSDRUG($P(^PSRX(PSONV,0),"^",6),0),"^")_"^"_PSONV "RTN","PSOVER1",22,0) S DA=PSONV D ^PSORXPR "RTN","PSOVER1",23,0) I $G(PKI1)=2 D DCV1^PSOPKIV1 G OUT "RTN","PSOVER1",24,0) K PSDTSTOP S DIR("A")="EDIT",DIR("B")="N",DIR(0)="SB^Y:YES;N:NO;P:PROFILE",DIR("?")="Enter Y to change this RX, P to see a profile, or N to proceed with verification and order checks." "RTN","PSOVER1",25,0) D ^DIR K DIR W ! G OUT:$G(DIRUT)!($G(DTOUT)) "RTN","PSOVER1",26,0) ;PSOPOCK=1 called from Process Order Check option; PSOCLK=1 means initiated from Rx verify by clerk. "RTN","PSOVER1",27,0) I Y="Y",($G(PSOCLK)!($G(PSOPOCK))) D FULLEDT S VALMBCK="R" G KILL:$$CHECK(PSONV) G EDIT "RTN","PSOVER1",28,0) I Y="Y",$G(PSOACT)]"" S VALMBCK="R",PSVERFLG=1 G OUT ;this pops the user back to the med profile screen when verify is called from Patient Prescription Processing "RTN","PSOVER1",29,0) I $D(DIRUT),$G(PSOCLK) S PSOCQ=1 G OUT "RTN","PSOVER1",30,0) I $D(DIRUT),$G(PSOACT)]"" S VALMBCK="R" G OUT "RTN","PSOVER1",31,0) G ORDCHK:Y="N",PROF:Y="P",OUT:"YNP"'[$E(Y) "RTN","PSOVER1",32,0) ; "RTN","PSOVER1",33,0) CHANGE ;S DA=PSONV,(PSRX1,PSRX2)=$P(^PSRX(PSONV,0),"^",6) "RTN","PSOVER1",34,0) ;S DIE="^PSRX(",DR="7;8;9;4;5;12;1;22;11;"_$S($P(PSOPAR,"^",12):"35;",1:"")_$S($P(PSOPAR,"^",15):"10.6",1:"")_";@2" D ^DIE "RTN","PSOVER1",35,0) ;I PSRX1'=PSRX2,DEA1'=DEA2 S DR="6////"_PSRX1 D ^DIE "RTN","PSOVER1",36,0) ; "RTN","PSOVER1",37,0) D EXPIRE K DIE,DR,DEA1,DEA2,P(5),PSRX1,PSRX2 "RTN","PSOVER1",38,0) K PSD(PSDOLD) S PSDNEW="",PSDNEW=$P(^PSDRUG($P(^PSRX(PSONV,0),"^",6),0),"^")_"^"_PSONV,PSD(PSDNEW)=PSONV_"^*^1^"_$P(^PSDRUG($P(^PSRX(PSONV,0),"^",6),0),"^",2) "RTN","PSOVER1",39,0) ; "RTN","PSOVER1",40,0) S DA=$S($D(PSORXED("IRXN")):PSORXED("IRXN"),1:PSONV) D ^PSORXPR G OUT:$G(DIRUT) "RTN","PSOVER1",41,0) G OUT:$D(DIRUT)!($D(DTOUT)) "RTN","PSOVER1",42,0) I '$G(PSOCLK) S DA=$S($D(PSORXED("IRXN")):PSORXED("IRXN"),1:PSONV) W !,"CHANGE",! D ^PSORXPR G OUT:$D(DIRUT)!($D(DTOUT)) G EDIT "RTN","PSOVER1",43,0) G EDIT:PSDNEW=PSDOLD,REDO "RTN","PSOVER1",44,0) PROF I '$D(PSOSD) W !,$C(7),"This patient has no other prescriptions on file",!! G EDIT Q "RTN","PSOVER1",45,0) W !!,$P(^DPT(DFN,0),"^"),?40,"ID#:"_VA("PID") W:$D(INT)!$D(PSONV) " RX#: "_$S($D(INT):$P(INT,"^"),$D(^PSRX(PSONV)):$P(^PSRX(PSONV,0),"^"),1:"") "RTN","PSOVER1",46,0) D HD^PSODDPR2() D ^PSODSPL D SHOW2^PSOVER G EDIT Q "RTN","PSOVER1",47,0) ; "RTN","PSOVER1",48,0) EXPIRE S RX0=^PSRX(DA,0),X1=$P($P(RX0,"^",13),"."),X2=$P(RX0,"^",9)+1*$P(RX0,"^",8),X2=$S($P(RX0,"^",8)=X2:X2,X2<181:184,X2=360:366,1:X2),X=X1 D:X1&X2 C^%DTC "RTN","PSOVER1",49,0) K ^PS(55,PSDFN,"P","A",+$P(^PSRX(DA,2),"^",6),DA) S ^PS(55,PSDFN,"P","A",X,DA)="",$P(^PSRX(DA,2),"^",6)=X,$P(^PS(4,DA,0),"^",7)=X Q "RTN","PSOVER1",50,0) ; "RTN","PSOVER1",51,0) ORDCHK ; "RTN","PSOVER1",52,0) S RX0=^PSRX(PSONV,0) "RTN","PSOVER1",53,0) D ORDCK "RTN","PSOVER1",54,0) I $G(PSOVQUIT)!$G(PSORX("DFLG")) G OUT "RTN","PSOVER1",55,0) ;------ "RTN","PSOVER1",56,0) VERIFY ; "RTN","PSOVER1",57,0) D FULL^VALM1 G:'$P(PSOPAR,"^",2) VERY "RTN","PSOVER1",58,0) I $Y<5 W !,$P(^DPT(DFN,0),"^"),?40,"ID#:"_VA("PID") W:$D(INT)!$D(PSONV) " RX#: "_$S($D(INT):$P(INT,"^"),$D(^PSRX(PSONV)):$P(^PSRX(PSONV,0),"^"),1:"") D "RTN","PSOVER1",59,0) . W:$D(PSODRUG("NAME")) !,PSODRUG("NAME"),! "RTN","PSOVER1",60,0) S DIR("A")="VERIFY FOR "_PSONAM_" ? (Y/N/Delete/Quit): ",DIR("B")="Y",DIR(0)="SA^Y:YES;N:NO;D:DELETE;Q:QUIT" "RTN","PSOVER1",61,0) S DIR("?",1)="Enter Y (or return) to verify this prescription",DIR("?",2)="N to leave this prescription non-verified and to end this session of verification",DIR("?")="D to delete this prescription" "RTN","PSOVER1",62,0) D ^DIR K DIR I Y="N" S PSORX("DFLG")=1 G OUT "RTN","PSOVER1",63,0) G QUIT:"Q^"[$E(Y),DELETE:Y="D" "RTN","PSOVER1",64,0) VERY I $G(PKI1)=1 D REA^PSOPKIV1 G:'$D(PKIR) VERIFY "RTN","PSOVER1",65,0) K ^PSRX(PSONV,"DAI") S $P(^PSRX(PSONV,3),"^",6)="" "RTN","PSOVER1",66,0) K ^PSRX(PSONV,"DRI"),SPFL "RTN","PSOVER1",67,0) I '$O(^PSRX(PSONV,6,0)) D I $D(DUOUT)!($D(DTOUT)) W !!,"Rx: "_$P(^PSRX(DA,0),"^")_" not Verified!!",! H 2 G OUT "RTN","PSOVER1",68,0) .W !!,"Dosing Instructions Missing. Please add!",! "RTN","PSOVER1",69,0) .I $P($G(^PSRX(PSONV,"SIG")),"^")]"",'$P($G(^("SIG")),"^",2) W "SIG: "_$P(^PSRX(PSONV,"SIG"),"^"),! "RTN","PSOVER1",70,0) .I $P($G(^PSRX(PSONV,"SIG")),"^",2),$O(^PSRX(PSONV,"SIG1",0)) D K I "RTN","PSOVER1",71,0) ..W "SIG: " F I=0:0 S I=$O(^PSRX(PSONV,"SIG1",I)) Q:'I W ^PSRX(PSONV,"SIG1",I,0),! "RTN","PSOVER1",72,0) .S DA=PSONV,PSOVER=1 K DIR,DIRUT,DUOUT,DTOUT "RTN","PSOVER1",73,0) .S PSODRUG("IEN")=$P(^PSRX(DA,0),"^",6),PSODFN=$P(^(0),"^",2),PSORXED("IRXN")=DA,PSODRUG("OI")=$P(^PSRX(DA,"OR1"),"^") "RTN","PSOVER1",74,0) .D DOSE^PSSORPH(.DOSE,PSODRUG("IEN"),"O",PSODFN),^PSOORED3 "RTN","PSOVER1",75,0) .K PSODFN,PSODRUG("IEN"),DOSE,PSOVER "RTN","PSOVER1",76,0) .I '$G(ENT) S DUOUT=1 "RTN","PSOVER1",77,0) .Q:$D(DUOUT)!($D(DTOUT)) "RTN","PSOVER1",78,0) .K DIR,DIRUT,DUOUT,DTOUT S DIE=52,DR=114 D ^DIE K DIE,DR,DTOUT "RTN","PSOVER1",79,0) .I X'="" D SIG^PSOHELP D:$G(INS1)]"" EN^DDIOL($E(INS1,2,9999999)) S PSORXED("SIG",1)=$E(INS1,2,9999999) "RTN","PSOVER1",80,0) .D EN^PSOFSIG(.PSORXED,1),UDSIG^PSOORED3 H 2 "RTN","PSOVER1",81,0) S DA=PSONV,$P(^PSRX(DA,2),"^",10)=DUZ,DRG=$P(^PSDRUG($P(^PSRX(DA,0),"^",6),0),"^") "RTN","PSOVER1",82,0) I $P(^PSRX(DA,2),"^",2)>DT,$P(PSOPAR,"^",6) D G KILL "RTN","PSOVER1",83,0) .S (SPFL1,PSOVER)="",PSORX("FILL DATE")=$P(^(2),"^",2),RXF=0 "RTN","PSOVER1",84,0) .D UPSUS S PSTRIVER=1 D SUS^PSORXL "RTN","PSOVER1",85,0) .K PSORX("FILL DATE"),PSTRIVER "RTN","PSOVER1",86,0) S PSOVER(PSONV)="" S $P(^PSRX(PSONV,"STA"),"^")=0,DRG=$P(^PSDRUG($P(^PSRX(DA,0),"^",6),0),"^") "RTN","PSOVER1",87,0) S $P(PSOSD("NON-VERIFIED",DRG),"^",2)=0,PSOSD("ACTIVE",DRG)=PSOSD("NON-VERIFIED",DRG) "RTN","PSOVER1",88,0) I $G(PKI1)=1,$G(PKIR)]"" D ACT^PSOPKIV1(DA) "RTN","PSOVER1",89,0) K PSOSD("NON-VERIFIED",DRG) D EN^PSOHLSN1(PSONV,"SC","CM","") ;S VALMBCK="" "RTN","PSOVER1",90,0) ; "RTN","PSOVER1",91,0) ; - Calling ECME for claims generation and transmission / REJECT handling "RTN","PSOVER1",92,0) N ACTION "RTN","PSOVER1",93,0) I $$SUBMIT^PSOBPSUT(PSONV) D I ACTION="Q"!(ACTION="^") Q "RTN","PSOVER1",94,0) . S ACTION="" D ECMESND^PSOBPSU1(PSONV,,,$S($O(^PSRX(PSONV,1,0)):"RF",1:"OF")) "RTN","PSOVER1",95,0) . ; Quit if there is an unresolved Tricare non-billable reject code, PSO*7*358 "RTN","PSOVER1",96,0) . I $$PSOET^PSOREJP3(PSONV) S ACTION="Q" Q "RTN","PSOVER1",97,0) . I $$FIND^PSOREJUT(PSONV) D "RTN","PSOVER1",98,0) . . S ACTION=$$HDLG^PSOREJU1(PSONV,0,"79,88","OF","IOQ","Q") "RTN","PSOVER1",99,0) ; "RTN","PSOVER1",100,0) KILL S DA=PSONV,DIK="^PS(52.4," D ^DIK K DA,DIK D DCORD^PSONEW2 "RTN","PSOVER1",101,0) OUT ; "RTN","PSOVER1",102,0) I '$G(PSOCLK) S:$G(DIRUT)!($G(DTOUT)) PSORX("DFLG")=1 K DIRUT,DTOUT,DUOUT,UPFLAGX D CLEAN S VALMBCK="Q" Q "RTN","PSOVER1",103,0) I $G(PSOCLK) S PSORX("DFLG")=0 K UPFLAGX D CLEAN Q "RTN","PSOVER1",104,0) DELETE K UPFLAGX D DELETE^PSOVER2 G:$G(UPFLAGX) OUT K PSOSD("NON-VERIFIED",$G(DRG)) Q "RTN","PSOVER1",105,0) QUIT S PSOQUIT="" D CLEAN Q "RTN","PSOVER1",106,0) UPSUS S $P(PSOSD("NON-VERIFIED",DRG),"^",2)=5,PSOSD("ACTIVE",DRG)=PSOSD("NON-VERIFIED",DRG) K PSOSD("NON-VERIFIED",DRG) D EN^PSOHLSN1(PSONV,"SC","CM","") "RTN","PSOVER1",107,0) Q "RTN","PSOVER1",108,0) CLEAN ;cleans up tmp("psorxdc") global "RTN","PSOVER1",109,0) N PSOWRITE "RTN","PSOVER1",110,0) I $O(^TMP("PSORXDC",$J,0)) F RORD=0:0 S RORD=$O(^TMP("PSORXDC",$J,RORD)) Q:'RORD D "RTN","PSOVER1",111,0) .D PSOUL^PSSLOCK(RORD_$S($P(^TMP("PSORXDC",$J,RORD,0),"^")="P":"S",1:"")) "RTN","PSOVER1",112,0) .I $P(^TMP("PSORXDC",$J,RORD,0),"^")="P" D Q "RTN","PSOVER1",113,0) ..S PSOR=^PS(52.41,RORD,0) "RTN","PSOVER1",114,0) ..S DNM=$S($P(PSOR,"^",9):$P($G(^PSDRUG($P(PSOR,"^",9),0)),"^"),1:$P(^PS(50.7,$P(PSOR,"^",8),0),"^")_" "_$P(^PS(50.606,$P(^PS(50.7,$P(PSOR,"^",8),0),"^",2),0),"^")) "RTN","PSOVER1",115,0) ..W $C(7),!," Duplicate "_$S($P(^TMP("PSORXDC",$J,RORD,0),"^",10):"Therapy",1:"Drug")_" Pending Order "_DNM_" NOT Discontinued." S PSOWRITE=1 "RTN","PSOVER1",116,0) .W !," Duplicate "_$S($P(^TMP("PSORXDC",$J,RORD,0),"^",10):"Therapy",1:"Drug")_" Rx #"_$P(^PSRX(RORD,0),"^")_" "_$P(^TMP("PSORXDC",$J,RORD,0),"^",7)_" NOT Discontinued." S PSOWRITE=1 "RTN","PSOVER1",117,0) I $G(PSOWRITE)&('$G(PSOWRIT)) W ! K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to Continue" D ^DIR S:($D(DTOUT))!($D(DUOUT)) PSODLQT=1,PSORX("DFLG")=1 K DIR,X,Y I ($Y+5)>IOSL W @IOF "RTN","PSOVER1",118,0) K ^TMP("PSORXDC",$J),RORD,PRNXZ,ORNZZ,PSOR "RTN","PSOVER1",119,0) Q "RTN","PSOVER1",120,0) KV1 ; "RTN","PSOVER1",121,0) K PSOANSQD,DRET,LST,PSOQUIT,PSODRUG,PSONEW,SIG,PSODIR,PHI,PRC,ORCHK,ORDRG,PSOSIGFL,PSORX("ISSUE DATE"),PSORX("FILL DATE"),CLOZPAT "RTN","PSOVER1",122,0) KV K DIR,DIRUT,DTOUT,DUOUT "RTN","PSOVER1",123,0) Q "RTN","PSOVER1",124,0) NVA ; "RTN","PSOVER1",125,0) I $P(PSOSD(STA,DNM),"^",11) D NVA^PSODRDU1 Q "RTN","PSOVER1",126,0) N PSOOI,CLASS,FLG,X,Y,RXREC,IFN "RTN","PSOVER1",127,0) S (Y,FLG)="" "RTN","PSOVER1",128,0) S RXREC=$P(PSOSD(STA,DNM),"^",10),PSOOI=+$G(^PS(55,DFN,"NVA",RXREC,0)),IFN=RXREC N DNM "RTN","PSOVER1",129,0) F S Y=$O(^PSDRUG("ASP",PSOOI,Y)) Q:Y=""!(FLG) S DNM=$P(^PSDRUG(Y,0),"^"),CLASS=$P(^PSDRUG(Y,0),"^",2) I PSODRUG("NAME")=DNM!(CLASS=PSODRUG("VA CLASS")) D DSP^PSODRDU1 S FLG=1 Q "RTN","PSOVER1",130,0) Q "RTN","PSOVER1",131,0) REMOTE ; "RTN","PSOVER1",132,0) K ^TMP($J,"DD"),^TMP($J,"DC"),^TMP($J,"DI"),^TMP($J,"DI"_PSODFN) D "RTN","PSOVER1",133,0) .I $T(HAVEHDR^ORRDI1)']"" Q "RTN","PSOVER1",134,0) .I '$$HAVEHDR^ORRDI1 Q "RTN","PSOVER1",135,0) .D HD^PSODDPR2():(($Y+5)'>IOSL) "RTN","PSOVER1",136,0) .I $D(^XTMP("ORRDI","OUTAGE INFO","DOWN")) D Q "RTN","PSOVER1",137,0) ..I $T(REMOTE^PSORX1)]"" Q "RTN","PSOVER1",138,0) ..W !!,"Remote data not available - Only local order checks processed.",! D HD^PSODDPR2():(($Y+5)>IOSL) ; D PAUSE^PSOORRD2 "RTN","PSOVER1",139,0) .W !!,"Now doing remote order checks. Please wait..." "RTN","PSOVER1",140,0) .D REMOTE^PSOORRDI(PSODFN,+$P($G(^PSRX(PSONV,0)),"^",6)) "RTN","PSOVER1",141,0) .I $P($G(^XTMP("ORRDI","PSOO",PSODFN,0)),"^",3)<0 W !!,"Remote data not available - Only local order checks processed.",! D HD^PSODDPR2():(($Y+5)>IOSL) ;D PAUSE^PSOORRD2 Q "RTN","PSOVER1",142,0) .I $D(^TMP($J,"DD")) D DUP^PSOORRD2 "RTN","PSOVER1",143,0) .I $D(^TMP($J,"DC")) D CLS^PSOORRD2 "RTN","PSOVER1",144,0) .I $D(^TMP($J,"DI"_PSODFN)) K ^TMP($J,"DI") M ^TMP($J,"DI")=^TMP($J,"DI"_PSODFN) D DRGINT^PSOORRD2 "RTN","PSOVER1",145,0) K ^TMP($J,"DD"),^TMP($J,"DC"),^TMP($J,"DI"),^TMP($J,"DI"_PSODFN) "RTN","PSOVER1",146,0) Q "RTN","PSOVER1",147,0) NOALRGY ; "RTN","PSOVER1",148,0) N PSODFN,PSODRUG "RTN","PSOVER1",149,0) S PSODFN=$P(^PSRX(PSONV,0),"^",2),PSODRUG("IEN")=$P(^PSRX(PSONV,0),"^",6) "RTN","PSOVER1",150,0) D NOALRGY^PSODRG "RTN","PSOVER1",151,0) Q "RTN","PSOVER1",152,0) ; "RTN","PSOVER1",153,0) ORDCK ; "RTN","PSOVER1",154,0) N ORN,ORNZZ,PSOLST,Y,PSOODFN S ORN=PSONV,PSOLST(PSONV)=PSONV_"^"_PSONV,PSOVORD=1 "RTN","PSOVER1",155,0) N DRG,ON,CT,DRGI,PDRG,SEV,STX,INT,CLI,PSONULN,PSONULN1,LST,LSI,DGI,SER,SERS,DUPT,SV "RTN","PSOVER1",156,0) S ORNZZ=ORN,PRNXZ(ORN)=PSOLST(ORN),PSORENW("OIRXN")=PSONV,PSOODFN=DFN "RTN","PSOVER1",157,0) I '$D(PSODFN) S PSODFN=$P(^PSRX(PSONV,0),"^",2) "RTN","PSOVER1",158,0) D SHOW^PSOVER D HD^PSODDPR2():(($Y+5)>IOSL) "RTN","PSOVER1",159,0) S (PSODRUG("IEN"),PSDRUG("IEN"))=$P(^PSRX(PSONV,0),"^",6) "RTN","PSOVER1",160,0) N PSOVINF S PSOVINF=^PSDRUG(PSDRUG("IEN"),0),PSODRUG("VA CLASS")=$P(^(0),"^",2) "RTN","PSOVER1",161,0) S PSODRUG("VA CLASS")=$P(PSOVINF,"^",2),(DRG,PSODRUG("NAME"))=$P(^PSDRUG(PSDRUG("IEN"),0),"^") "RTN","PSOVER1",162,0) S PSODRUG("NDF")=$S($G(^PSDRUG(PSDRUG("IEN"),"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:0) "RTN","PSOVER1",163,0) S PSODRUG("MAXDOSE")=$P(PSOVINF,"^",4),PSODRUG("DEA")=$P(PSOVINF,"^",3),PSODRUG("CLN")=$S($D(^PSDRUG(PSDRUG("IEN"),"ND")):+$P(^("ND"),"^",6),1:0) "RTN","PSOVER1",164,0) S PSODRUG("SIG")=$P(PSOVINF,"^",5),PSODRUG("NDC")=$$GETNDC^PSSNDCUT(PSDRUG("IEN"),$G(PSOSITE)),PSODRUG("STKLVL")=$G(^PSDRUG(PSDRUG("IEN"),660.1)) "RTN","PSOVER1",165,0) S PSODRUG("DAW")=+$$GET1^DIQ(50,PSONV,81) "RTN","PSOVER1",166,0) K PSOVINF "RTN","PSOVER1",167,0) D POST^PSODRG S DFN=PSOODFN "RTN","PSOVER1",168,0) I $$GET1^DIQ(52,PSONV,100,"I")=13 S PSORX("DFLG")=1 Q "RTN","PSOVER1",169,0) I $G(PSVERFLG),$G(PSOCLK) S PSVERFLG=0 "RTN","PSOVER1",170,0) I $G(PSOCLK),$G(PSORX("DFLG")) S PSOVQUIT=1 K PSORX("DFLG"),DIRUT,DTOUT Q "RTN","PSOVER1",171,0) Q:PSORX("DFLG") "RTN","PSOVER1",172,0) D:$$DS^PSSDSAPI&('$G(PSORX("DFLG"))) DOSCK^PSODOSUT("V") "RTN","PSOVER1",173,0) I $$GET1^DIQ(52,PSONV,100,"I")=13 S PSORX("DFLG")=1 Q "RTN","PSOVER1",174,0) I $G(PSOCLK),$G(PSORX("DFLG")) S PSOVQUIT=1 K PSORX("DFLG"),DIRUT,DTOUT Q "RTN","PSOVER1",175,0) Q:PSORX("DFLG") "RTN","PSOVER1",176,0) S PSOLST(ORNZZ)=PRNXZ(ORNZZ),ORN=ORNZZ K PSORENW("OIRXN") "RTN","PSOVER1",177,0) Q "RTN","PSOVER1",178,0) ; "RTN","PSOVER1",179,0) FULLEDT ; "RTN","PSOVER1",180,0) D FULL^VALM1 "RTN","PSOVER1",181,0) N RX,FILL,OPSOLST,OPSLST,OLDDA,PSODRUG,REJ "RTN","PSOVER1",182,0) S (RX,PSORXED("IRXN"))=PSONV "RTN","PSOVER1",183,0) M OPSOLST=PSOLST,OPSLST=PSLST,ODA=DA "RTN","PSOVER1",184,0) N PSOSITE,ORN,PSOPAR,PSOLIST,PSOSD ;,PSD,PSDNEW,PSDOLD,DA,PSOSD,RX0,X1,X2,PSOQUIT "RTN","PSOVER1",185,0) S PSOSITE=$$RXSITE^PSOBPSUT(RX,""),ORN=RX "RTN","PSOVER1",186,0) S PSOPAR=$G(^PS(59,PSOSITE,1)),PSOLIST(1)=ORN_"," "RTN","PSOVER1",187,0) D EPH^PSORXEDT "RTN","PSOVER1",188,0) M PSOLST=OPSOLST,PSLST=OPSLST S VALMBCK="R" S:$D(OLDDA) DA=OLDDA "RTN","PSOVER1",189,0) Q "RTN","PSOVER1",190,0) ; "RTN","PSOVER1",191,0) DRIDOSE(DA,RX0) ;where DA is RXIEN and RX0 is zero node of file 52 for the RXIEN "RTN","PSOVER1",192,0) N T,RXN,RXX,SCRIPT,SEV,X,SER,PSOSERV,PSOSCPT,PSODOSF,RX "RTN","PSOVER1",193,0) S RX=RX0 "RTN","PSOVER1",194,0) S RXN=$P(RX0,"^") "RTN","PSOVER1",195,0) I $D(^PS(52.4,RX,0))!($D(^PSRX(RX,"DRI"))) D "RTN","PSOVER1",196,0) . Q:'$P($G(^PS(52.4,RX,0)),"^",8)&('$D(^PSRX(RX,"DRI"))) "RTN","PSOVER1",197,0) .W !!,"*** During order, there were DRUG-DRUG INTERACTION for the following RX(s):" "RTN","PSOVER1",198,0) I $P($G(^PS(52.4,RX,0)),"^",8) S SCRIPT=$P(^PS(52.4,RX,0),"^",10),SEV=$P(^PS(52.4,RX,0),"^",9) F X=1:1 S RXX(X)=$P(SCRIPT,",",X),SEV(X)=$P(SEV,",",X) Q:RXX(X)="" D "RTN","PSOVER1",199,0) . S SER=$P(^PS(56,SEV(X),0),"^",4) S:$G(SER)=1 PSOSERV=1 "RTN","PSOVER1",200,0) . S PSOSCPT(RXX(X))=" "_$S(SER=1:"CRITICAL",SER=2:"SIGNIFICANT",1:"UNKNOWN")_" INTERACTION "_$P(^PSDRUG($P(^PSRX(RXX(X),0),"^",6),0),"^") "RTN","PSOVER1",201,0) I $D(^PSRX(RX,"DRI")) S SCRIPT=$P(^PSRX(RX,"DRI"),"^",2),SEV=$P(^PSRX(RX,"DRI"),"^") F X=1:1 S RXX(X)=$P(SCRIPT,",",X),SEV(X)=$P(SEV,",",X) Q:RXX(X)="" D "RTN","PSOVER1",202,0) .S SER=$P(^PS(56,SEV(X),0),"^",4) "RTN","PSOVER1",203,0) .S PSOSCPT(RXX(X))=" "_$P($G(^PSRX(RXX(X),0)),"^")_" "_$S(SER=1:"CRITICAL",SER=2:"SIGNIFICANT",1:"UNKNOWN")_" INTERACTION "_$P(^PSDRUG($P(^PSRX(RXX(X),0),"^",6),0),"^") "RTN","PSOVER1",204,0) S SCRIPT="" F S SCRIPT=$O(PSOSCPT(SCRIPT)) Q:SCRIPT="" W !,PSOSCPT(SCRIPT) "RTN","PSOVER1",205,0) I $$DS^PSSDSAPI,$D(^PS(52.4,RX,1)) S T=$P(^PS(52.4,RX,1),"^") D W:PSODOSF'="" !,"*** Dose Warning: ",PSODOSF "RTN","PSOVER1",206,0) . S PSODOSF="",PSODOSF=$S(T=3:"MAX SINGLE DOSE & DAILY DOSE RANGE",T=2:"MAX SINGLE DOSE",T=1:"DAILY DOSE RANGE",1:"") "RTN","PSOVER1",207,0) W ! "RTN","PSOVER1",208,0) Q "RTN","PSOVER1",209,0) CHECK(PSONV) ; "RTN","PSOVER1",210,0) N PSOSTAT S PSOSTAT=$$GET1^DIQ(52,PSONV,100,"I") "RTN","PSOVER1",211,0) I ",11,12,13,14,15,"[(","_PSOSTAT_",") Q 1 "RTN","PSOVER1",212,0) Q 0 "VER") 8.0^22.0 "BLD",8016,6) ^316 **END** **END**