Released PSO*7*390 SEQ #345 Extracted from mail message **KIDS**:PSO*7.0*390^ **INSTALL NAME** PSO*7.0*390 "BLD",8511,0) PSO*7.0*390^OUTPATIENT PHARMACY^0^3121029^y "BLD",8511,4,0) ^9.64PA^^ "BLD",8511,6) 11^ "BLD",8511,6.3) 86 "BLD",8511,"ABPKG") n "BLD",8511,"KRN",0) ^9.67PA^779.2^20 "BLD",8511,"KRN",.4,0) .4 "BLD",8511,"KRN",.4,"NM",0) ^9.68A^^ "BLD",8511,"KRN",.401,0) .401 "BLD",8511,"KRN",.402,0) .402 "BLD",8511,"KRN",.403,0) .403 "BLD",8511,"KRN",.5,0) .5 "BLD",8511,"KRN",.84,0) .84 "BLD",8511,"KRN",3.6,0) 3.6 "BLD",8511,"KRN",3.8,0) 3.8 "BLD",8511,"KRN",9.2,0) 9.2 "BLD",8511,"KRN",9.8,0) 9.8 "BLD",8511,"KRN",9.8,"NM",0) ^9.68A^36^24 "BLD",8511,"KRN",9.8,"NM",11,0) PSODDPRE^^0^B132472323 "BLD",8511,"KRN",9.8,"NM",12,0) PSODDPR2^^0^B104633902 "BLD",8511,"KRN",9.8,"NM",13,0) PSODDPR7^^0^B68911471 "BLD",8511,"KRN",9.8,"NM",15,0) PSODDPR5^^0^B158488185 "BLD",8511,"KRN",9.8,"NM",17,0) PSOORUT2^^0^B95782995 "BLD",8511,"KRN",9.8,"NM",18,0) PSOUTL^^0^B125518087 "BLD",8511,"KRN",9.8,"NM",19,0) PSODRG^^0^B74687625 "BLD",8511,"KRN",9.8,"NM",20,0) PSODDPR8^^0^B30129604 "BLD",8511,"KRN",9.8,"NM",21,0) PSOCAN^^0^B51638197 "BLD",8511,"KRN",9.8,"NM",22,0) PSOCAN2^^0^B85271948 "BLD",8511,"KRN",9.8,"NM",23,0) PSODGAL1^^0^B77114277 "BLD",8511,"KRN",9.8,"NM",24,0) PSODGAL2^^0^B20866110 "BLD",8511,"KRN",9.8,"NM",25,0) PSON52^^0^B65058460 "BLD",8511,"KRN",9.8,"NM",26,0) PSONEW^^0^B41741762 "BLD",8511,"KRN",9.8,"NM",27,0) PSOORNE4^^0^B85067804 "BLD",8511,"KRN",9.8,"NM",28,0) PSOORNEW^^0^B81591143 "BLD",8511,"KRN",9.8,"NM",29,0) PSORENW4^^0^B60124334 "BLD",8511,"KRN",9.8,"NM",30,0) PSOVER1^^0^B126374469 "BLD",8511,"KRN",9.8,"NM",31,0) PSORXEDT^^0^B44148603 "BLD",8511,"KRN",9.8,"NM",32,0) PSODDPR4^^0^B102172775 "BLD",8511,"KRN",9.8,"NM",33,0) PSOLMUTL^^0^B14836265 "BLD",8511,"KRN",9.8,"NM",34,0) PSORXI^^0^B15382592 "BLD",8511,"KRN",9.8,"NM",35,0) PSODEM^^0^B15804329 "BLD",8511,"KRN",9.8,"NM",36,0) PSORENW^^0^B38420531 "BLD",8511,"KRN",9.8,"NM","B","PSOCAN",21) "BLD",8511,"KRN",9.8,"NM","B","PSOCAN2",22) "BLD",8511,"KRN",9.8,"NM","B","PSODDPR2",12) "BLD",8511,"KRN",9.8,"NM","B","PSODDPR4",32) "BLD",8511,"KRN",9.8,"NM","B","PSODDPR5",15) "BLD",8511,"KRN",9.8,"NM","B","PSODDPR7",13) "BLD",8511,"KRN",9.8,"NM","B","PSODDPR8",20) "BLD",8511,"KRN",9.8,"NM","B","PSODDPRE",11) "BLD",8511,"KRN",9.8,"NM","B","PSODEM",35) "BLD",8511,"KRN",9.8,"NM","B","PSODGAL1",23) "BLD",8511,"KRN",9.8,"NM","B","PSODGAL2",24) "BLD",8511,"KRN",9.8,"NM","B","PSODRG",19) "BLD",8511,"KRN",9.8,"NM","B","PSOLMUTL",33) "BLD",8511,"KRN",9.8,"NM","B","PSON52",25) "BLD",8511,"KRN",9.8,"NM","B","PSONEW",26) "BLD",8511,"KRN",9.8,"NM","B","PSOORNE4",27) "BLD",8511,"KRN",9.8,"NM","B","PSOORNEW",28) "BLD",8511,"KRN",9.8,"NM","B","PSOORUT2",17) "BLD",8511,"KRN",9.8,"NM","B","PSORENW",36) "BLD",8511,"KRN",9.8,"NM","B","PSORENW4",29) "BLD",8511,"KRN",9.8,"NM","B","PSORXEDT",31) "BLD",8511,"KRN",9.8,"NM","B","PSORXI",34) "BLD",8511,"KRN",9.8,"NM","B","PSOUTL",18) "BLD",8511,"KRN",9.8,"NM","B","PSOVER1",30) "BLD",8511,"KRN",19,0) 19 "BLD",8511,"KRN",19,"NM",0) ^9.68A^5^4 "BLD",8511,"KRN",19,"NM",1,0) PSO MANAGER^^2 "BLD",8511,"KRN",19,"NM",3,0) PSO USER1^^2 "BLD",8511,"KRN",19,"NM",4,0) PSO CHECK DRUG INTERACTION^^0 "BLD",8511,"KRN",19,"NM",5,0) PSO RX^^2 "BLD",8511,"KRN",19,"NM","B","PSO CHECK DRUG INTERACTION",4) "BLD",8511,"KRN",19,"NM","B","PSO MANAGER",1) "BLD",8511,"KRN",19,"NM","B","PSO RX",5) "BLD",8511,"KRN",19,"NM","B","PSO USER1",3) "BLD",8511,"KRN",19.1,0) 19.1 "BLD",8511,"KRN",101,0) 101 "BLD",8511,"KRN",101,"NM",0) ^9.68A^43^43 "BLD",8511,"KRN",101,"NM",1,0) PSO HIDDEN ACTIONS #2^^0 "BLD",8511,"KRN",101,"NM",2,0) VALM NEXT SCREEN^^0 "BLD",8511,"KRN",101,"NM",3,0) VALM PREVIOUS SCREEN^^0 "BLD",8511,"KRN",101,"NM",4,0) VALM UP ONE LINE^^0 "BLD",8511,"KRN",101,"NM",5,0) VALM DOWN A LINE^^0 "BLD",8511,"KRN",101,"NM",6,0) VALM REFRESH^^0 "BLD",8511,"KRN",101,"NM",7,0) VALM PRINT LIST^^0 "BLD",8511,"KRN",101,"NM",8,0) VALM PRINT SCREEN^^0 "BLD",8511,"KRN",101,"NM",9,0) VALM RIGHT^^0 "BLD",8511,"KRN",101,"NM",10,0) VALM LEFT^^0 "BLD",8511,"KRN",101,"NM",11,0) VALM SEARCH LIST^^0 "BLD",8511,"KRN",101,"NM",12,0) VALM QUIT^^0 "BLD",8511,"KRN",101,"NM",13,0) VALM LAST SCREEN^^0 "BLD",8511,"KRN",101,"NM",14,0) VALM FIRST SCREEN^^0 "BLD",8511,"KRN",101,"NM",15,0) VALM GOTO PAGE^^0 "BLD",8511,"KRN",101,"NM",16,0) PSO SPEED RENEW^^0 "BLD",8511,"KRN",101,"NM",17,0) PSO SPEED CANCEL^^0 "BLD",8511,"KRN",101,"NM",18,0) PSO SPEED RELEASE^^0 "BLD",8511,"KRN",101,"NM",19,0) PSO SPEED REPRINT^^0 "BLD",8511,"KRN",101,"NM",20,0) PSO SPEED REFILL^^0 "BLD",8511,"KRN",101,"NM",21,0) PSO SPEED PULL SUSPENSE^^0 "BLD",8511,"KRN",101,"NM",22,0) PSO LM INPATIENT MEDICATION PROFILE^^0 "BLD",8511,"KRN",101,"NM",23,0) VALM TURN ON/OFF MENUS^^0 "BLD",8511,"KRN",101,"NM",24,0) PSO LM HIDDEN OTHER^^0 "BLD",8511,"KRN",101,"NM",25,0) PSO SPEED SIG LOG REPRINT^^0 "BLD",8511,"KRN",101,"NM",26,0) PSO LM QUEUE TO CMOP^^0 "BLD",8511,"KRN",101,"NM",27,0) PSO FILL/RELEASE DATE DISPLAY^^0 "BLD",8511,"KRN",101,"NM",28,0) PSO RDI REMOTE^^0 "BLD",8511,"KRN",101,"NM",29,0) PSO LM INTERVENTION MENU^^0 "BLD",8511,"KRN",101,"NM",30,0) PSO DRUG CHECK^^0 "BLD",8511,"KRN",101,"NM",31,0) PSO DISPLAY DRUG ALLERGIES^^0^ "BLD",8511,"KRN",101,"NM",32,0) PSO HIDDEN ACTIONS^^2 "BLD",8511,"KRN",101,"NM",33,0) PSO LM PRINT MED INFO^^4^ "BLD",8511,"KRN",101,"NM",34,0) PSO LM DISPLAY ORDER STATUS^^4^ "BLD",8511,"KRN",101,"NM",35,0) PSO LM ACTION PROFILE^^4^ "BLD",8511,"KRN",101,"NM",36,0) PSO LM NON-VA MEDS RPT^^4^ "BLD",8511,"KRN",101,"NM",37,0) PSO LM MULTI-RX PRINT^^4^ "BLD",8511,"KRN",101,"NM",38,0) PSO LM HIDDEN OTHER #2^^2 "BLD",8511,"KRN",101,"NM",39,0) PSO LM DELETE INTERVENTION^^0 "BLD",8511,"KRN",101,"NM",40,0) PSO LM EDIT INTERVENTION^^0 "BLD",8511,"KRN",101,"NM",41,0) PSO LM ADD INTERVENTION^^0 "BLD",8511,"KRN",101,"NM",42,0) PSO LM PRINT INTERVENTION^^0 "BLD",8511,"KRN",101,"NM",43,0) PSO LM VIEW INTERVENTION^^0 "BLD",8511,"KRN",101,"NM","B","PSO DISPLAY DRUG ALLERGIES",31) "BLD",8511,"KRN",101,"NM","B","PSO DRUG CHECK",30) "BLD",8511,"KRN",101,"NM","B","PSO FILL/RELEASE DATE DISPLAY",27) "BLD",8511,"KRN",101,"NM","B","PSO HIDDEN ACTIONS",32) "BLD",8511,"KRN",101,"NM","B","PSO HIDDEN ACTIONS #2",1) "BLD",8511,"KRN",101,"NM","B","PSO LM ACTION PROFILE",35) "BLD",8511,"KRN",101,"NM","B","PSO LM ADD INTERVENTION",41) "BLD",8511,"KRN",101,"NM","B","PSO LM DELETE INTERVENTION",39) "BLD",8511,"KRN",101,"NM","B","PSO LM DISPLAY ORDER STATUS",34) "BLD",8511,"KRN",101,"NM","B","PSO LM EDIT INTERVENTION",40) "BLD",8511,"KRN",101,"NM","B","PSO LM HIDDEN OTHER",24) "BLD",8511,"KRN",101,"NM","B","PSO LM HIDDEN OTHER #2",38) "BLD",8511,"KRN",101,"NM","B","PSO LM INPATIENT MEDICATION PROFILE",22) "BLD",8511,"KRN",101,"NM","B","PSO LM INTERVENTION MENU",29) "BLD",8511,"KRN",101,"NM","B","PSO LM MULTI-RX PRINT",37) "BLD",8511,"KRN",101,"NM","B","PSO LM NON-VA MEDS RPT",36) "BLD",8511,"KRN",101,"NM","B","PSO LM PRINT INTERVENTION",42) "BLD",8511,"KRN",101,"NM","B","PSO LM PRINT MED INFO",33) "BLD",8511,"KRN",101,"NM","B","PSO LM QUEUE TO CMOP",26) "BLD",8511,"KRN",101,"NM","B","PSO LM VIEW INTERVENTION",43) "BLD",8511,"KRN",101,"NM","B","PSO RDI REMOTE",28) "BLD",8511,"KRN",101,"NM","B","PSO SPEED CANCEL",17) "BLD",8511,"KRN",101,"NM","B","PSO SPEED PULL SUSPENSE",21) "BLD",8511,"KRN",101,"NM","B","PSO SPEED REFILL",20) "BLD",8511,"KRN",101,"NM","B","PSO SPEED RELEASE",18) "BLD",8511,"KRN",101,"NM","B","PSO SPEED RENEW",16) "BLD",8511,"KRN",101,"NM","B","PSO SPEED REPRINT",19) "BLD",8511,"KRN",101,"NM","B","PSO SPEED SIG LOG REPRINT",25) "BLD",8511,"KRN",101,"NM","B","VALM DOWN A LINE",5) "BLD",8511,"KRN",101,"NM","B","VALM FIRST SCREEN",14) "BLD",8511,"KRN",101,"NM","B","VALM GOTO PAGE",15) "BLD",8511,"KRN",101,"NM","B","VALM LAST SCREEN",13) "BLD",8511,"KRN",101,"NM","B","VALM LEFT",10) "BLD",8511,"KRN",101,"NM","B","VALM NEXT SCREEN",2) "BLD",8511,"KRN",101,"NM","B","VALM PREVIOUS SCREEN",3) "BLD",8511,"KRN",101,"NM","B","VALM PRINT LIST",7) "BLD",8511,"KRN",101,"NM","B","VALM PRINT SCREEN",8) "BLD",8511,"KRN",101,"NM","B","VALM QUIT",12) "BLD",8511,"KRN",101,"NM","B","VALM REFRESH",6) "BLD",8511,"KRN",101,"NM","B","VALM RIGHT",9) "BLD",8511,"KRN",101,"NM","B","VALM SEARCH LIST",11) "BLD",8511,"KRN",101,"NM","B","VALM TURN ON/OFF MENUS",23) "BLD",8511,"KRN",101,"NM","B","VALM UP ONE LINE",4) "BLD",8511,"KRN",409.61,0) 409.61 "BLD",8511,"KRN",409.61,"NM",0) ^9.68A^2^2 "BLD",8511,"KRN",409.61,"NM",1,0) PSO LM ACTIVE ORDERS^^0 "BLD",8511,"KRN",409.61,"NM",2,0) PSO LM ORDER SELECTION^^0 "BLD",8511,"KRN",409.61,"NM","B","PSO LM ACTIVE ORDERS",1) "BLD",8511,"KRN",409.61,"NM","B","PSO LM ORDER SELECTION",2) "BLD",8511,"KRN",771,0) 771 "BLD",8511,"KRN",779.2,0) 779.2 "BLD",8511,"KRN",870,0) 870 "BLD",8511,"KRN",8989.51,0) 8989.51 "BLD",8511,"KRN",8989.52,0) 8989.52 "BLD",8511,"KRN",8994,0) 8994 "BLD",8511,"KRN","B",.4,.4) "BLD",8511,"KRN","B",.401,.401) "BLD",8511,"KRN","B",.402,.402) "BLD",8511,"KRN","B",.403,.403) "BLD",8511,"KRN","B",.5,.5) "BLD",8511,"KRN","B",.84,.84) "BLD",8511,"KRN","B",3.6,3.6) "BLD",8511,"KRN","B",3.8,3.8) "BLD",8511,"KRN","B",9.2,9.2) "BLD",8511,"KRN","B",9.8,9.8) "BLD",8511,"KRN","B",19,19) "BLD",8511,"KRN","B",19.1,19.1) "BLD",8511,"KRN","B",101,101) "BLD",8511,"KRN","B",409.61,409.61) "BLD",8511,"KRN","B",771,771) "BLD",8511,"KRN","B",779.2,779.2) "BLD",8511,"KRN","B",870,870) "BLD",8511,"KRN","B",8989.51,8989.51) "BLD",8511,"KRN","B",8989.52,8989.52) "BLD",8511,"KRN","B",8994,8994) "BLD",8511,"QUES",0) ^9.62^^ "BLD",8511,"REQB",0) ^9.611^8^8 "BLD",8511,"REQB",1,0) PSO*7.0*251^2 "BLD",8511,"REQB",2,0) PSO*7.0*379^2 "BLD",8511,"REQB",3,0) PSS*1.0*169^2 "BLD",8511,"REQB",4,0) OR*3.0*352^2 "BLD",8511,"REQB",5,0) PSO*7.0*398^2 "BLD",8511,"REQB",6,0) PSO*7.0*401^2 "BLD",8511,"REQB",7,0) PSO*7.0*396^2 "BLD",8511,"REQB",8,0) PSO*7.0*386^2 "BLD",8511,"REQB","B","OR*3.0*352",4) "BLD",8511,"REQB","B","PSO*7.0*251",1) "BLD",8511,"REQB","B","PSO*7.0*379",2) "BLD",8511,"REQB","B","PSO*7.0*386",8) "BLD",8511,"REQB","B","PSO*7.0*396",7) "BLD",8511,"REQB","B","PSO*7.0*398",5) "BLD",8511,"REQB","B","PSO*7.0*401",6) "BLD",8511,"REQB","B","PSS*1.0*169",3) "KRN",19,247,-1) 2^1 "KRN",19,247,0) PSO MANAGER^Outpatient Pharmacy Manager^^M^11712^^^^^^^141^^1^1 "KRN",19,247,10,0) ^19.01PI^32^32 "KRN",19,247,10,3,0) 248^ "KRN",19,247,10,3,"^") PSO RX "KRN",19,247,10,32,0) 14062 "KRN",19,247,10,32,"^") PSO CHECK DRUG INTERACTION "KRN",19,247,10,"A6359",1) Drug enter/edit^471^^ "KRN",19,247,10,"A6359",2) Update patient record^472^^ "KRN",19,247,10,"A6359",3) RX (Prescriptions)^474^^ "KRN",19,247,10,"A6359",4) Medication Profile^447^^ "KRN",19,247,10,"A6359",5) Suspense Functions^1134^^ "KRN",19,247,10,"A6359",6) Delete a Prescription^460^^ "KRN",19,247,10,"A6359",7) Output Reports^1136^^ "KRN",19,247,10,"A6359",8) Release^506^^ "KRN",19,247,10,"A6359",9) Supervisor Functions^505^^ "KRN",19,247,10,"A6359",10) Label/Profile Monitor Reprint^1139^^ "KRN",19,247,"U") OUTPATIENT PHARMACY MANAGER "KRN",19,248,-1) 2^5 "KRN",19,248,0) PSO RX^Rx (Prescriptions)^^M^11712^^^^^^^141^^1^ "KRN",19,248,10,0) ^19.01PI^23^23 "KRN",19,248,10,23,0) 14062 "KRN",19,248,10,23,"^") PSO CHECK DRUG INTERACTION "KRN",19,248,10,"A6359",1) New Prescription Entry^449^^ "KRN",19,248,10,"A6359",2) Refill Prescriptions^459^^ "KRN",19,248,10,"A6359",3) Edit Prescriptions^469^^ "KRN",19,248,10,"A6359",4) Reprint An Outpatient Label^470^^ "KRN",19,248,10,"A6359",5) View Prescriptions^475^^ "KRN",19,248,10,"A6359",6) Cancel Prescription^476^^ "KRN",19,248,10,"A6359",7) Hold/Remove from Hold^479^^ "KRN",19,248,10,"A6359",8) Partial Prescription^478^^ "KRN",19,248,"U") RX (PRESCRIPTIONS) "KRN",19,256,-1) 2^3 "KRN",19,256,0) PSO USER1^Pharmacist Menu^^M^11712^^^^^^^141^^1^1 "KRN",19,256,10,0) ^19.01PI^21^21 "KRN",19,256,10,1,0) 248^ "KRN",19,256,10,1,"^") PSO RX "KRN",19,256,10,21,0) 14062 "KRN",19,256,10,21,"^") PSO CHECK DRUG INTERACTION "KRN",19,256,10,"A6359",1) RX (Prescriptions)^474^^ "KRN",19,256,10,"A6359",2) Update patient record^472^^ "KRN",19,256,10,"A6359",3) Print From Suspense File^455^^ "KRN",19,256,10,"A6359",4) Pull Specific Prescription Number^451^^ "KRN",19,256,10,"A6359",5) One Patient's Suspended Labels^452^^ "KRN",19,256,10,"A6359",6) Medication Profile^447^^ "KRN",19,256,10,"A6359",7) Change Suspense Date^454^^ "KRN",19,256,"U") PHARMACIST MENU "KRN",19,14062,-1) 0^4 "KRN",19,14062,0) PSO CHECK DRUG INTERACTION^Check Drug Interaction^^R^^^^^^^^OUTPATIENT PHARMACY "KRN",19,14062,1,0) ^19.06^2^2^3111215^^^^ "KRN",19,14062,1,1,0) The PSS CHECK DRUG INTERACTION option will allow a user to check drug "KRN",19,14062,1,2,0) interactions and therapeutic duplications between two or more drugs. "KRN",19,14062,25) PSSDGCK^PSOUTL "KRN",19,14062,"U") CHECK DRUG INTERACTION "KRN",101,1803,-1) 0^2 "KRN",101,1803,0) VALM NEXT SCREEN^Next Screen^^A^^^^^^^^LIST MANAGER "KRN",101,1803,1,0) ^^2^2^2920519^^^ "KRN",101,1803,1,1,0) This action will allow the user to view the next screen "KRN",101,1803,1,2,0) of entries, if any exist. "KRN",101,1803,2,0) ^101.02A^1^1 "KRN",101,1803,2,1,0) NX "KRN",101,1803,2,"B","NX",1) "KRN",101,1803,4) "KRN",101,1803,15) "KRN",101,1803,20) D NEXT^VALM4 "KRN",101,1803,99) 62754,41556 "KRN",101,1804,-1) 0^3 "KRN",101,1804,0) VALM PREVIOUS SCREEN^Previous Screen^^A^^^^^^^^LIST MANAGER "KRN",101,1804,1,0) ^^2^2^2920113^^ "KRN",101,1804,1,1,0) This action will allow the user to view the previous screen "KRN",101,1804,1,2,0) of entries, if any exist. "KRN",101,1804,2,0) ^101.02A^3^2 "KRN",101,1804,2,1,0) PR "KRN",101,1804,2,2,0) BK "KRN",101,1804,2,3,0) PR "KRN",101,1804,2,"B","BK",2) "KRN",101,1804,2,"B","PR",1) "KRN",101,1804,2,"B","PR",3) "KRN",101,1804,20) D PREV^VALM4 "KRN",101,1804,99) 62754,41556 "KRN",101,1805,-1) 0^6 "KRN",101,1805,0) VALM REFRESH^Re-Display Screen^^A^^^^^^^^LIST MANAGER "KRN",101,1805,1,0) ^^1^1^2911024^ "KRN",101,1805,1,1,0) This actions allows the user to re-display the current screen. "KRN",101,1805,2,0) ^101.02A^1^1 "KRN",101,1805,2,1,0) RE "KRN",101,1805,2,"B","RE",1) "KRN",101,1805,10,0) ^101.01PA^0^0 "KRN",101,1805,20) D RE^VALM4 "KRN",101,1805,99) 62754,41556 "KRN",101,1806,-1) 0^13 "KRN",101,1806,0) VALM LAST SCREEN^Last Screen^^A^^^^^^^^LIST MANAGER "KRN",101,1806,1,0) ^^1^1^2911026^ "KRN",101,1806,1,1,0) The action will display the last items. "KRN",101,1806,20) D LAST^VALM4 "KRN",101,1806,99) 62754,41556 "KRN",101,1807,-1) 0^14 "KRN",101,1807,0) VALM FIRST SCREEN^First Screen^^A^^^^^^^^LIST MANAGER "KRN",101,1807,1,0) ^^1^1^2960619^^ "KRN",101,1807,1,1,0) This action will display the first screen. "KRN",101,1807,15) "KRN",101,1807,20) D FIRST^VALM4 "KRN",101,1807,99) 62754,41556 "KRN",101,1808,-1) 0^4 "KRN",101,1808,0) VALM UP ONE LINE^Up a Line^^A^^^^^^^^LIST MANAGER "KRN",101,1808,1,0) ^^1^1^2911027^ "KRN",101,1808,1,1,0) Move up a line "KRN",101,1808,20) D UP^VALM40 "KRN",101,1808,99) 62754,41556 "KRN",101,1809,-1) 0^5 "KRN",101,1809,0) VALM DOWN A LINE^Down a Line^^A^^^^^^^^LIST MANAGER "KRN",101,1809,1,0) ^^2^2^2950628^^ "KRN",101,1809,1,1,0) Move down a line. "KRN",101,1809,1,2,0) "KRN",101,1809,3,0) ^101.03P^0^0 "KRN",101,1809,20) D DOWN^VALM40 "KRN",101,1809,99) 62754,41556 "KRN",101,1811,-1) 0^12 "KRN",101,1811,0) VALM QUIT^Quit^^A^^^^^^^^ "KRN",101,1811,.1) "KRN",101,1811,1,0) ^^1^1^2911105^ "KRN",101,1811,1,1,0) This protocol can be used as a generic 'quit' action. "KRN",101,1811,2,0) ^101.02A^2^2 "KRN",101,1811,2,1,0) EXIT "KRN",101,1811,2,2,0) QUIT "KRN",101,1811,2,"B","EXIT",1) "KRN",101,1811,2,"B","QUIT",2) "KRN",101,1811,15) "KRN",101,1811,20) Q "KRN",101,1811,99) 62754,41556 "KRN",101,1812,-1) 0^8 "KRN",101,1812,0) VALM PRINT SCREEN^Print Screen^^A^^^^^^^^LIST MANAGER "KRN",101,1812,1,0) ^^3^3^2920113^^ "KRN",101,1812,1,1,0) This action allows the user to print the current List Manager "KRN",101,1812,1,2,0) display screen. The header and the current portion of the "KRN",101,1812,1,3,0) list are printed. "KRN",101,1812,20) D PRT^VALM1 "KRN",101,1812,99) 62754,41556 "KRN",101,1813,-1) 0^7 "KRN",101,1813,0) VALM PRINT LIST^Print List^^A^^^^^^^^LIST MANAGER "KRN",101,1813,1,0) ^^2^2^2920113^ "KRN",101,1813,1,1,0) This action allws the user to print the entire list of "KRN",101,1813,1,2,0) entries currently being displayed. "KRN",101,1813,20) D PRTL^VALM1 "KRN",101,1813,99) 62754,41556 "KRN",101,1815,-1) 0^23 "KRN",101,1815,0) VALM TURN ON/OFF MENUS^Auto-Display(On/Off)^^A^^^^^^^^LIST MANAGER "KRN",101,1815,20) D MENU^VALM2 "KRN",101,1815,99) 62754,41556 "KRN",101,1817,-1) 0^11 "KRN",101,1817,0) VALM SEARCH LIST^Search List^^A^^^^^^^^LIST MANAGER "KRN",101,1817,1,0) ^^1^1^2920303^^ "KRN",101,1817,1,1,0) Finds text in list of entries. "KRN",101,1817,20) D FIND^VALM40 "KRN",101,1817,99) 62754,41556 "KRN",101,1824,-1) 0^9 "KRN",101,1824,0) VALM RIGHT^Shift View to Right^^A^^^^^^^^LIST MANAGER "KRN",101,1824,20) D RIGHT^VALM40(XQORNOD(0)) "KRN",101,1824,99) 62754,41336 "KRN",101,1825,-1) 0^10 "KRN",101,1825,0) VALM LEFT^Shift View to Left^^A^^^^^^^^LIST MANAGER "KRN",101,1825,20) D LEFT^VALM40(XQORNOD(0)) "KRN",101,1825,99) 62754,41336 "KRN",101,1827,-1) 0^15 "KRN",101,1827,0) VALM GOTO PAGE^Go to Page^^A^^^^^^^^LIST MANAGER "KRN",101,1827,1,0) ^^1^1^2930113^ "KRN",101,1827,1,1,0) "KRN",101,1827,20) D GOTO^VALM40 "KRN",101,1827,99) 62754,41556 "KRN",101,3816,-1) 2^32 "KRN",101,3816,0) PSO HIDDEN ACTIONS^Outpatient Pharmacy Hidden Actions^^M^11922^^^^^^^141 "KRN",101,3816,10,0) ^101.01PA^34^34 "KRN",101,3816,10,1,0) 1803^+^^ "KRN",101,3816,10,1,"^") VALM NEXT SCREEN "KRN",101,3816,10,2,0) 1804^-^^ "KRN",101,3816,10,2,"^") VALM PREVIOUS SCREEN "KRN",101,3816,10,3,0) 1808^UP^^ "KRN",101,3816,10,3,"^") VALM UP ONE LINE "KRN",101,3816,10,4,0) 1809^DN^^ "KRN",101,3816,10,4,"^") VALM DOWN A LINE "KRN",101,3816,10,5,0) 1805^RD^^ "KRN",101,3816,10,5,"^") VALM REFRESH "KRN",101,3816,10,6,0) 1812^PS^^ "KRN",101,3816,10,6,"^") VALM PRINT SCREEN "KRN",101,3816,10,7,0) 1813^PT^^ "KRN",101,3816,10,7,"^") VALM PRINT LIST "KRN",101,3816,10,8,0) 1824^>^^ "KRN",101,3816,10,8,"^") VALM RIGHT "KRN",101,3816,10,9,0) 1825^<^^ "KRN",101,3816,10,9,"^") VALM LEFT "KRN",101,3816,10,10,0) 1817^SL^^ "KRN",101,3816,10,10,"^") VALM SEARCH LIST "KRN",101,3816,10,11,0) 1811^QU^^ "KRN",101,3816,10,11,1) ^ "KRN",101,3816,10,11,"^") VALM QUIT "KRN",101,3816,10,12,0) 1806^LS^^ "KRN",101,3816,10,12,"^") VALM LAST SCREEN "KRN",101,3816,10,13,0) 1807^FS^^ "KRN",101,3816,10,13,"^") VALM FIRST SCREEN "KRN",101,3816,10,14,0) 1827^GO^^ "KRN",101,3816,10,14,"^") VALM GOTO PAGE "KRN",101,3816,10,27,0) 3838^IP^33^ "KRN",101,3816,10,27,"^") PSO LM INPATIENT MEDICATION PROFILE "KRN",101,3816,10,29,0) 3844^OTH^34^ "KRN",101,3816,10,29,"^") PSO LM HIDDEN OTHER #2 "KRN",101,3816,10,30,0) 1815^ADPL^^ "KRN",101,3816,10,30,"^") VALM TURN ON/OFF MENUS "KRN",101,3816,10,33,0) 5849^IN^36^ "KRN",101,3816,10,33,"^") PSO LM INTERVENTION MENU "KRN",101,3816,10,34,0) 5984^DA^37^ "KRN",101,3816,10,34,"^") PSO DISPLAY DRUG ALLERGIES "KRN",101,3823,-1) 0^16 "KRN",101,3823,0) PSO SPEED RENEW^Renew (OP)^^A^^^^^^^^OUTPATIENT PHARMACY "KRN",101,3823,20) D ^PSORENW4 "KRN",101,3823,26) "KRN",101,3823,99) 62754,41337 "KRN",101,3824,-1) 0^1 "KRN",101,3824,0) PSO HIDDEN ACTIONS #2^Outpatient Pharmacy Hidden Actions #2^^M^^^^^^^^OUTPATIENT PHARMACY "KRN",101,3824,1,0) ^101.06^1^1^3080520^^ "KRN",101,3824,1,1,0) This hidden menu is attached to the OP medication profile. "KRN",101,3824,4) 26^2 "KRN",101,3824,10,0) ^101.01PA^30^30 "KRN",101,3824,10,1,0) 1803^+^35^ "KRN",101,3824,10,1,"^") VALM NEXT SCREEN "KRN",101,3824,10,2,0) 1804^-^^ "KRN",101,3824,10,2,"^") VALM PREVIOUS SCREEN "KRN",101,3824,10,3,0) 1808^UP^^ "KRN",101,3824,10,3,"^") VALM UP ONE LINE "KRN",101,3824,10,4,0) 1809^DN^20^ "KRN",101,3824,10,4,"^") VALM DOWN A LINE "KRN",101,3824,10,5,0) 1805^RD^21^ "KRN",101,3824,10,5,"^") VALM REFRESH "KRN",101,3824,10,6,0) 1813^PT^22^ "KRN",101,3824,10,6,"^") VALM PRINT LIST "KRN",101,3824,10,7,0) 1812^PS^23^ "KRN",101,3824,10,7,"^") VALM PRINT SCREEN "KRN",101,3824,10,8,0) 1824^>^24^ "KRN",101,3824,10,8,"^") VALM RIGHT "KRN",101,3824,10,9,0) 1825^<^25^ "KRN",101,3824,10,9,"^") VALM LEFT "KRN",101,3824,10,10,0) 1817^SL^26^ "KRN",101,3824,10,10,"^") VALM SEARCH LIST "KRN",101,3824,10,11,0) 1811^QU^31^ "KRN",101,3824,10,11,"^") VALM QUIT "KRN",101,3824,10,12,0) 1806^LS^32^ "KRN",101,3824,10,12,"^") VALM LAST SCREEN "KRN",101,3824,10,13,0) 1807^FS^33^ "KRN",101,3824,10,13,"^") VALM FIRST SCREEN "KRN",101,3824,10,14,0) 1827^GO^34^ "KRN",101,3824,10,14,"^") VALM GOTO PAGE "KRN",101,3824,10,15,0) 3823^RN^11^ "KRN",101,3824,10,15,"^") PSO SPEED RENEW "KRN",101,3824,10,16,0) 3825^DC^12^ "KRN",101,3824,10,16,"^") PSO SPEED CANCEL "KRN",101,3824,10,17,0) 3826^RL^13^ "KRN",101,3824,10,17,"^") PSO SPEED RELEASE "KRN",101,3824,10,18,0) 3827^RP^10^ "KRN",101,3824,10,18,"^") PSO SPEED REPRINT "KRN",101,3824,10,19,0) 3830^RF^14^ "KRN",101,3824,10,19,"^") PSO SPEED REFILL "KRN",101,3824,10,20,0) 3833^PP^15^ "KRN",101,3824,10,20,"^") PSO SPEED PULL SUSPENSE "KRN",101,3824,10,21,0) 3838^IP^16^ "KRN",101,3824,10,21,"^") PSO LM INPATIENT MEDICATION PROFILE "KRN",101,3824,10,23,0) 1815^ADPL^^ "KRN",101,3824,10,23,"^") VALM TURN ON/OFF MENUS "KRN",101,3824,10,24,0) 3842^OTH^19^ "KRN",101,3824,10,24,"^") PSO LM HIDDEN OTHER "KRN",101,3824,10,25,0) 5596^RS^17^ "KRN",101,3824,10,25,"^") PSO SPEED SIG LOG REPRINT "KRN",101,3824,10,26,0) 5617^CM^18^ "KRN",101,3824,10,26,"^") PSO LM QUEUE TO CMOP "KRN",101,3824,10,27,0) 5722^RDD^27^ "KRN",101,3824,10,27,"^") PSO FILL/RELEASE DATE DISPLAY "KRN",101,3824,10,28,0) 5752^DR^28^ "KRN",101,3824,10,28,"^") PSO RDI REMOTE "KRN",101,3824,10,29,0) 5849^IN^^ "KRN",101,3824,10,29,"^") PSO LM INTERVENTION MENU "KRN",101,3824,10,30,0) 5985^CK^^ "KRN",101,3824,10,30,"^") PSO DRUG CHECK "KRN",101,3824,99) 62754,41556 "KRN",101,3825,-1) 0^17 "KRN",101,3825,0) PSO SPEED CANCEL^Discontinue (OP)^^A^^^^^^^^OUTPATIENT PHARMACY "KRN",101,3825,20) D ^PSOCAN4 "KRN",101,3825,99) 62754,41337 "KRN",101,3826,-1) 0^18 "KRN",101,3826,0) PSO SPEED RELEASE^Release (OP)^^A^^^^^^^^OUTPATIENT PHARMACY "KRN",101,3826,20) D ^PSODISP3 "KRN",101,3826,99) 62754,41337 "KRN",101,3827,-1) 0^19 "KRN",101,3827,0) PSO SPEED REPRINT^Reprint (OP)^^A^^^^^^^^OUTPATIENT PHARMACY "KRN",101,3827,20) D ^PSORXRP1 "KRN",101,3827,99) 62754,41337 "KRN",101,3830,-1) 0^20 "KRN",101,3830,0) PSO SPEED REFILL^Refill (OP)^^A^^^^^^^^OUTPATIENT PHARMACY "KRN",101,3830,20) D SPEED^PSOREF "KRN",101,3830,99) 62754,41337 "KRN",101,3833,-1) 0^21 "KRN",101,3833,0) PSO SPEED PULL SUSPENSE^Pull Rx (OP)^^A^^^^^^^^OUTPATIENT PHARMACY "KRN",101,3833,20) D ^PSOSUPOE "KRN",101,3833,99) 62754,41337 "KRN",101,3838,-1) 0^22 "KRN",101,3838,0) PSO LM INPATIENT MEDICATION PROFILE^Inpat. Profile (OP)^^A^^^^^^^^OUTPATIENT PHARMACY "KRN",101,3838,10,0) ^101.01PA "KRN",101,3838,15) S VALMBCK="R" "KRN",101,3838,20) I $T(ENOR^PSJPR)]"" D FULL^VALM1,ENOR^PSJPR(PSODFN):'$G(PSOBEDT) "KRN",101,3838,99) 62754,41337 "KRN",101,3841,-1) 4^33 "KRN",101,3841,0) PSO LM PRINT MED INFO "KRN",101,3842,-1) 0^24 "KRN",101,3842,0) PSO LM HIDDEN OTHER^Other OP Actions^^M^^^^^^^^OUTPATIENT PHARMACY "KRN",101,3842,10,0) ^101.01PA^15^15 "KRN",101,3842,10,11,0) 3841^MI^10^ "KRN",101,3842,10,11,"^") PSO LM PRINT MED INFO "KRN",101,3842,10,12,0) 3845^DO^21^ "KRN",101,3842,10,12,"^") PSO LM DISPLAY ORDER STATUS "KRN",101,3842,10,13,0) 3846^AP^11^ "KRN",101,3842,10,13,"^") PSO LM ACTION PROFILE "KRN",101,3842,10,14,0) 5127^NV^^ "KRN",101,3842,10,14,"^") PSO LM NON-VA MEDS RPT "KRN",101,3842,10,15,0) 5349^MR^^ "KRN",101,3842,10,15,"^") PSO LM MULTI-RX PRINT "KRN",101,3842,15) S VALMBCK="R" "KRN",101,3842,99) 62754,41337 "KRN",101,3844,-1) 2^38 "KRN",101,3844,0) PSO LM HIDDEN OTHER #2^Other OP Actions^^M^11922^^^^^^^141 "KRN",101,3844,10,0) ^101.01PA^6^6 "KRN",101,3844,10,3,0) 3845^DO^21^ "KRN",101,3844,10,3,"^") PSO LM DISPLAY ORDER STATUS "KRN",101,3844,10,4,0) 3846^AP^11^ "KRN",101,3844,10,4,"^") PSO LM ACTION PROFILE "KRN",101,3845,-1) 4^34 "KRN",101,3845,0) PSO LM DISPLAY ORDER STATUS "KRN",101,3846,-1) 4^35 "KRN",101,3846,0) PSO LM ACTION PROFILE "KRN",101,5127,-1) 4^36 "KRN",101,5127,0) PSO LM NON-VA MEDS RPT "KRN",101,5349,-1) 4^37 "KRN",101,5349,0) PSO LM MULTI-RX PRINT "KRN",101,5596,-1) 0^25 "KRN",101,5596,0) PSO SPEED SIG LOG REPRINT^Reprint Sig Log^^A^^^^^^^^OUTPATIENT PHARMACY "KRN",101,5596,2,0) ^101.02A^^0 "KRN",101,5596,20) D ST^PSOLLLHN "KRN",101,5596,99) 62754,41337 "KRN",101,5617,-1) 0^26 "KRN",101,5617,0) PSO LM QUEUE TO CMOP^Manual Queue to CMOP^^A^^^^^^^^OUTPATIENT PHARMACY "KRN",101,5617,20) D CM^PSORESUS "KRN",101,5617,99) 62754,41337 "KRN",101,5722,-1) 0^27 "KRN",101,5722,0) PSO FILL/RELEASE DATE DISPLAY^Fill/Rel Date Disply^^A^^^^^^^^OUTPATIENT PHARMACY "KRN",101,5722,2,0) ^101.02A^^0 "KRN",101,5722,10,0) ^101.01PA^^0 "KRN",101,5722,20) D RFDSP^PSOLMUTL "KRN",101,5722,99) 62754,41337 "KRN",101,5752,-1) 0^28 "KRN",101,5752,0) PSO RDI REMOTE^Display Remote^^A^^^^^^^^OUTPATIENT PHARMACY "KRN",101,5752,1,0) ^101.06^3^3^3081211^^^^ "KRN",101,5752,1,1,0) This option allows the user to display the pharmacy data from other "KRN",101,5752,1,2,0) facilities only. "KRN",101,5752,1,3,0) "KRN",101,5752,4) ^^^DISPLAY REMOTE FACILITY PHARMACY DATA "KRN",101,5752,20) D REMOTE^PSORMRX "KRN",101,5752,99) 62754,41337 "KRN",101,5849,-1) 0^29 "KRN",101,5849,0) PSO LM INTERVENTION MENU^Intervention Menu^^M^^^^^^^^OUTPATIENT PHARMACY "KRN",101,5849,10,0) ^101.01PA^10^10 "KRN",101,5849,10,6,0) 5850^DI^^ "KRN",101,5849,10,6,"^") PSO LM DELETE INTERVENTION "KRN",101,5849,10,7,0) 5851^EI^^ "KRN",101,5849,10,7,"^") PSO LM EDIT INTERVENTION "KRN",101,5849,10,8,0) 5852^AI^^ "KRN",101,5849,10,8,"^") PSO LM ADD INTERVENTION "KRN",101,5849,10,9,0) 5853^PI^^ "KRN",101,5849,10,9,"^") PSO LM PRINT INTERVENTION "KRN",101,5849,10,10,0) 5854^VI^^ "KRN",101,5849,10,10,"^") PSO LM VIEW INTERVENTION "KRN",101,5849,15) S VALMBCK="R" "KRN",101,5849,99) 62754,41337 "KRN",101,5850,-1) 0^39 "KRN",101,5850,0) PSO LM DELETE INTERVENTION^Delete Intervention^^A^^^^^^^^OUTPATIENT PHARMACY "KRN",101,5850,20) D FULL^VALM1,^PSODELI "KRN",101,5850,99) 62754,41337 "KRN",101,5851,-1) 0^40 "KRN",101,5851,0) PSO LM EDIT INTERVENTION^Edit Intervention^^A^^^^^^^^OUTPATIENT PHARMACY "KRN",101,5851,20) D FULL^VALM1,EDIT^PSODELI "KRN",101,5851,99) 62754,41337 "KRN",101,5852,-1) 0^41 "KRN",101,5852,0) PSO LM ADD INTERVENTION^Enter New Intervention^^A^^^^^^^^OUTPATIENT PHARMACY "KRN",101,5852,20) D FULL^VALM1,NEW^PSODELI "KRN",101,5852,99) 62754,41337 "KRN",101,5853,-1) 0^42 "KRN",101,5853,0) PSO LM PRINT INTERVENTION^Print Intervention^^A^^^^^^^^OUTPATIENT PHARMACY "KRN",101,5853,20) D FULL^VALM1,OUT^PSODELI "KRN",101,5853,99) 62754,41337 "KRN",101,5854,-1) 0^43 "KRN",101,5854,0) PSO LM VIEW INTERVENTION^View Interventions^^A^^^^^^^^OUTPATIENT PHARMACY "KRN",101,5854,20) D VIEW^PSODELI "KRN",101,5854,99) 62754,41337 "KRN",101,5984,-1) 0^31 "KRN",101,5984,0) PSO DISPLAY DRUG ALLERGIES^Display Drug Allergies^^A^^^^^^^^OUTPATIENT PHARMACY "KRN",101,5984,1,0) ^101.06^1^1^3120514^^^^ "KRN",101,5984,1,1,0) This protocol will display drug allergies sign/symptoms. "KRN",101,5984,2,0) ^101.02A^1^1 "KRN",101,5984,2,1,0) DA "KRN",101,5984,2,"B","DA",1) "KRN",101,5984,20) D ^PSODGAL2 "KRN",101,5984,99) 62754,41337 "KRN",101,5985,-1) 0^30 "KRN",101,5985,0) PSO DRUG CHECK^Check Interactions^^A^^^^^^^^OUTPATIENT PHARMACY "KRN",101,5985,4) ^^^ "KRN",101,5985,20) D DGCK^PSODDPR5 "KRN",101,5985,21,0) ^101.021A "KRN",101,5985,99) 62754,41337 "KRN",409.61,425,-1) 0^1 "KRN",409.61,425,0) PSO LM ACTIVE ORDERS^1^^80^10^20^1^1^^PSO LM MEDICATION PROFILE^Medication Profile^1^^1 "KRN",409.61,425,1) ^PSO HIDDEN ACTIONS #2 "KRN",409.61,425,"ARRAY") ^TMP("PSOPF",$J) "KRN",409.61,425,"COL",0) ^409.621^^0 "KRN",409.61,425,"FNL") D EXIT^PSOLMAO "KRN",409.61,425,"HDR") D HDR^PSOLMAO "KRN",409.61,425,"HLP") D HELP^PSOLMAO "KRN",409.61,425,"INIT") D INIT^PSOLMAO "KRN",409.61,431,-1) 0^2 "KRN",409.61,431,0) PSO LM ORDER SELECTION^1^^80^8^20^1^1^^PSO LM SELECT MENU^Order Selection^1^^1 "KRN",409.61,431,1) ^PSO HIDDEN ACTIONS "KRN",409.61,431,"ARRAY") ^TMP("PSOAO",$J) "KRN",409.61,431,"COL",0) ^409.621 "KRN",409.61,431,"FNL") D EXIT^PSOLMLST "KRN",409.61,431,"HDR") D HDR^PSOLMUTL "KRN",409.61,431,"HLP") D HELP^PSOLMLST "KRN",409.61,431,"INIT") D INIT^PSOLMLST "MBREQ") 0 "ORD",15,101) 101;15;;;PRO^XPDTA;PROF1^XPDIA;PROE1^XPDIA;PROF2^XPDIA;;PRODEL^XPDIA "ORD",15,101,0) PROTOCOL "ORD",17,409.61) 409.61;17;1;;;;LME1^XPDIA1;;;LMDEL^XPDIA1 "ORD",17,409.61,0) LIST TEMPLATE "ORD",18,19) 19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA "ORD",18,19,0) OPTION "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) 390^3121029^11922 "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","PSOCAN") 0^21^B51638197^B49661114 "RTN","PSOCAN",1,0) PSOCAN ;BIR/JMB-Rx discontinue and reinstate ;8/3/06 12:38pm "RTN","PSOCAN",2,0) ;;7.0;OUTPATIENT PHARMACY;**11,21,24,27,32,37,88,117,131,185,253,251,375,379,390**;DEC 1997;Build 86 "RTN","PSOCAN",3,0) ;External reference to File #55 supported by DBIA 2228 "RTN","PSOCAN",4,0) ;External references L, UL, PSOL, and PSOUL^PSSLOCK supported by DBIA 2789 "RTN","PSOCAN",5,0) START S WARN=0,(DAYS360,SPCANC)=1 D KCAN1^PSOCAN3 W !! S DIR("A")="Discontinue/Reinstate by Rx# or patient name",DIR(0)="SBO^R:RX NUMBER;P:PATIENT NAME" "RTN","PSOCAN",6,0) S DIR("?")="Enter 'R' to discontinue/reinstate by Rx#. Enter 'P' to discontinue/reinstate by patient name." D ^DIR K DIR "RTN","PSOCAN",7,0) G:$G(DIRUT) KILL^PSOCAN1 K RP S RP=Y G:RP="P" PAT^PSOCAN1 "RTN","PSOCAN",8,0) NUM D DCORD^PSONEW2 "RTN","PSOCAN",9,0) K PSOTECCK,RXSP,PSINV,PSOWUN,PSOULRX D KCAN1^PSOCAN3 S:'$D(PSOCLC) PSOCLC=DUZ S PS="Discontinue" W ! S DIR("A")="Discontinue/Reinstate Prescription(s)#" "RTN","PSOCAN",10,0) S DIR(0)="FO^1:245",DIR("?")="Wand/enter barcode or enter Rx number(s) to discontinued/reinstated. If more than one, separate with commas. Do not exceed 245 characters including commas" "RTN","PSOCAN",11,0) D ^DIR K DIR G:$G(DIRUT) START S OUT=0 I Y["-" D PSOINST^PSOSUPAT G:OUT NUM S (IN,X)=$P(^PSRX($P(Y,"-",2),0),"^") G NO "RTN","PSOCAN",12,0) S IN=Y G RX:Y["," "RTN","PSOCAN",13,0) NO I '$O(^PSRX("B",Y,0)) W " Rx Not Found!",! G NUM "RTN","PSOCAN",14,0) S PSPOP=0,DIC=52,DIC(0)="QEMZ" D ^DIC K DIC Q:$G(POERR)&(Y<0) "RTN","PSOCAN",15,0) G:Y<0 NUM S (DA,IFN,PSOULRX)=+Y,RXNUM=Y(0,0),PSODFN=+$P(^PSRX(DA,0),"^",2) "RTN","PSOCAN",16,0) S PSOWUN=1 S PSOPLCK=$$L^PSSLOCK(PSODFN,0) I '$G(PSOPLCK) D LOCK^PSOORCPY K PSOPLCK G NUM "RTN","PSOCAN",17,0) K PSOPLCK D PSOL^PSSLOCK(IFN) I '$G(PSOMSG) W !!,$S($P($G(PSOMSG),"^",2)'="":$P($G(PSOMSG),"^",2),1:"Another person is editing this order.") K PSOMSG D ULP G NUM "RTN","PSOCAN",18,0) I $P($G(^PSRX(+$G(IFN),"STA")),"^")=12,$P($G(^("PKI")),"^") W !!,"Cannot be Reinstated - Digitally Signed" D ULP G NUM "RTN","PSOCAN",19,0) I $P($G(^PSRX(+$G(IFN),"STA")),"^")=12 S PSOCANRZ=1 "RTN","PSOCAN",20,0) E S PSOCANRD=+$P($G(^PSRX(+$G(IFN),0)),"^",4) "RTN","PSOCAN",21,0) D:$P($G(^PS(55,PSODFN,0)),"^",6)'=2 EN^PSOHLUP(PSODFN) "RTN","PSOCAN",22,0) LMNO D CHK S:'$G(DA)&($G(IFN)) DA=IFN "RTN","PSOCAN",23,0) I DEAD!$P(^PSRX(DA,"STA"),"^")'<13,$P(^("STA"),"^")'=16 S PSINV($P(^PSRX(DA,0),"^"))="" D:$G(PSOWUN) ULP,ULRX G EP1 "RTN","PSOCAN",24,0) I $G(PSODIV),$P($G(^PSRX(DA,2)),"^",9),$P(^(2),"^",9)'=$G(PSOSITE) S RXREC=DA D DIV D:$G(POERR)&(PSPOP) ULP,ULRX Q:$G(POERR)&(PSPOP) D:$G(PSOWUN)&($G(PSPOP)) ULP,ULRX G:PSPOP NUM "RTN","PSOCAN",25,0) D ICN^PSODPT(PSODFN) "RTN","PSOCAN",26,0) N PSTS S PSTS=$S($P(^PSRX(DA,"STA"),"^")=12:1,$P(^PSRX(DA,"STA"),"^")=14:1,$P(^PSRX(DA,"STA"),"^")=15:1,1:0) "RTN","PSOCAN",27,0) S PS=$S($G(PSTS):"Reinstate",1:"Discontinue") "RTN","PSOCAN",28,0) ;S PS=$S($P(^PSRX(DA,"STA"),"^")=12:"Reinstate",1:"Discontinue") "RTN","PSOCAN",29,0) I '$G(POERR) N PKIR D "RTN","PSOCAN",30,0) .I $P(^PSRX(DA,"STA"),"^")=1,$P($G(^("PKI")),"^") S PKIR="" "RTN","PSOCAN",31,0) .D ^PSORXPR "RTN","PSOCAN",32,0) D YN S:PS="Reinstate" PS="Discontinue" Q:$G(POERR)&('%) "RTN","PSOCAN",33,0) I '% D ULP,ULRX G NUM "RTN","PSOCAN",34,0) D REA D:'$D(REA)&($G(PSOWUN)) ULP,ULRX Q:'$D(REA) "RTN","PSOCAN",35,0) D COM^PSOCAN1 Q:$G(POERR)&('$D(INCOM))!($D(DIRUT)) I '$D(INCOM)!($D(DIRUT)) D ULP,ULRX G NUM "RTN","PSOCAN",36,0) S RX=$P(^PSRX(DA,0),"^"),PSCAN(RX)=DA_"^"_REA "RTN","PSOCAN",37,0) D:REA="R" REINS^PSOCAN2 Q:$G(PSOQUIT)&($G(PSOREINS)) "RTN","PSOCAN",38,0) I REA="R",'$G(PSORX("DFLG")) D DCORD^PSONEW2 "RTN","PSOCAN",39,0) K PSOTECCK "RTN","PSOCAN",40,0) D:$G(PSORX("DFLG")) ULP,ULRX "RTN","PSOCAN",41,0) Q:$G(POERR)&($G(PSORX("DFLG"))) "RTN","PSOCAN",42,0) G NUM:$G(PSORX("DFLG")) "RTN","PSOCAN",43,0) D:REA="C" CAN "RTN","PSOCAN",44,0) Q:$G(POERR) "RTN","PSOCAN",45,0) D ULP,ULRX G NUM "RTN","PSOCAN",46,0) YN D EN^PSOCMOPA I $G(XFLAG)]"" S %=0 K XFLAG Q "RTN","PSOCAN",47,0) W ! S DIR("A")="Are you sure you want to "_PS,DIR(0)="Y",DIR("B")="NO" D ^DIR S %=Y K DIR,DUOUT,DTOUT I 'Y!$D(DIRUT) S VALMBCK="R" "RTN","PSOCAN",48,0) K DIRUT Q "RTN","PSOCAN",49,0) REA S REA=+$P(^PSRX(DA,"STA"),"^") I REA=12 S REA="R" Q "RTN","PSOCAN",50,0) I REA,REA'=11 W !?5,$C(7) D "RTN","PSOCAN",51,0) .W "Rx# "_RXNUM_" was"_$S(REA=1:" Non-Verified",REA=13:" Deleted",REA=11:" Expired",REA=5:" Suspended",REA=4:" Pending Due to Drug Interactions",REA=3:" On Hold",REA=14!(REA=15):" Discontinued",REA=16:" Provider Held",1:" In Fill Status")_"." "RTN","PSOCAN",52,0) I REA,REA'=1,REA'=3,REA'=5,REA'=11,REA'<13,REA'=16 D Q "RTN","PSOCAN",53,0) .K REA W !?10,"Rx Cannot Be Discontinued/Reinstated!" H 2 "RTN","PSOCAN",54,0) .S VALMSG="Rx# "_RXNUM_" Cannot Be "_$S($G(PSTS):"Reinstated",1:"Discontinued")_"." "RTN","PSOCAN",55,0) S REA="C" Q "RTN","PSOCAN",56,0) CAN N PSODRUG D CAN1^PSOCAN3 Q "RTN","PSOCAN",57,0) DIV I '$P($G(PSOSYS),"^",2) W !?10,$C(7),"RX# ",$P(^PSRX(DA,0),"^")," is not a valid choice. (Different Division)" S PSPOP=1 Q "RTN","PSOCAN",58,0) I $P($G(PSOSYS),"^",3) W !?10,$C(7) S DIR("A")="RX# "_$P(^PSRX(DA,0),"^")_" is from another division. Continue",DIR(0)="Y",DIR("B")="Y" D ^DIR K DIR S:$G(DIRUT)!('Y) PSPOP=1 "RTN","PSOCAN",59,0) Q "RTN","PSOCAN",60,0) CHK K VADM,DEAD S DFN=PSODFN D DEM^VADPT I $G(VADM(6))="" S DEAD=0 Q "RTN","PSOCAN",61,0) S (PSODEATH,DEAD)=1 W !!,?10,VADM(1)_" DIED "_$P($G(VADM(6)),"^",2) D CAN^PSOCAN3 K PSODEATH "RTN","PSOCAN",62,0) Q "RTN","PSOCAN",63,0) RX N PKI S RXCNT=0,RXSP=1 D TESTRP D COM^PSOCAN1 G:'$D(INCOM)!($D(DIRUT)) NUM K PSINV,PSCAN F II=1:1 S (EN,X)=$P(IN,",",II) Q:$P(IN,",",II)']"" S DIC=52,DIC(0)="QMZ" D ^DIC K DIC S:Y'>0 PSINV(X)="" D:Y>0 "RTN","PSOCAN",64,0) .S YY=Y,YY(0,0)=Y(0,0),(PSODFN,DFN)=$P(Y(0),"^",2) D:$P($G(^PS(55,PSODFN,0)),"^",6)'=2 EN^PSOHLUP(PSODFN) "RTN","PSOCAN",65,0) .D:$G(DFN)>0 CHK I DEAD!($P(^PSRX(+YY,"STA"),"^")=13)!($P(^("STA"),"^")=14) S PSINV(EN)="" Q "RTN","PSOCAN",66,0) .I $P(^PSRX(+YY,"STA"),"^")=12,$P($G(^("PKI")),"^") S PKI=1,PSINV(EN)="" Q "RTN","PSOCAN",67,0) .S DA=+YY I $P($G(^PSRX(DA,"STA")),"^")=11!($P($G(^(2)),"^",6)1:"Change Status",REA="C":"Discontinued",1:"Reinstate"),DIR(0)="Y",DIR("B")="N" "RTN","PSOCAN",73,0) N PSOCNRXV S PSOCNRXV=0 "RTN","PSOCAN",74,0) D ^DIR K DIR Q:$G(DIRUT) I 'Y K PSCAN D INVALD^PSOCAN1 G NUM "RTN","PSOCAN",75,0) K PSOPLCKZ S RX="" F S RX=$O(PSCAN(RX)) Q:'RX D "RTN","PSOCAN",76,0) .S PSODFN=+$P($G(^PSRX(+PSCAN(RX),0)),"^",2) "RTN","PSOCAN",77,0) .S PSOPLCK=$$L^PSSLOCK(+$G(PSODFN),0) D:'$G(PSOPLCK)&('$D(PSOPLCKZ(PSODFN))) LOCK^PSOORCPY I '$G(PSOPLCK) S PSOPLCKZ(PSODFN)=PSODFN Q "RTN","PSOCAN",78,0) .D PSOL^PSSLOCK(+PSCAN(RX)) I '$G(PSOMSG) D D UL^PSSLOCK(PSODFN) Q "RTN","PSOCAN",79,0) ..I $P($G(PSOMSG),"^",2)'="" W !,$P($G(PSOMSG),"^",2),!,"Order "_$P($G(^PSRX(+PSCAN(RX),0)),"^")_"." Q "RTN","PSOCAN",80,0) ..W !,"Another person is editing order "_$P($G(^PSRX(+PSCAN(RX),0)),"^")_"." "RTN","PSOCAN",81,0) .D ACT D PSOUL^PSSLOCK(+PSCAN(RX)),UL^PSSLOCK(PSODFN) "RTN","PSOCAN",82,0) .S PSOCNRXV=1 "RTN","PSOCAN",83,0) K PSOPLCKZ W:$G(PSOCNRXV) !,$S($G(RXCNT)>1:"Statuses Changed",REA="C":"Prescription Discontinued",1:"Prescription Reinstated") D INVALD^PSOCAN1 G NUM "RTN","PSOCAN",84,0) ACT S DA=+PSCAN(RX),REA=$P(PSCAN(RX),"^",2),II=RX,PSODFN=$P(^PSRX(DA,0),"^",2) I REA="R" D REINS^PSOCAN2 Q "RTN","PSOCAN",85,0) D CAN Q "RTN","PSOCAN",86,0) EXP ;S PSINV($P(^PSRX(DA,0),"^"))="" "RTN","PSOCAN",87,0) Q:$P(^PSRX(DA,"STA"),"^")=12 "RTN","PSOCAN",88,0) S $P(^PSRX(DA,"STA"),"^")=11 D ECAN^PSOUTL(DA) "RTN","PSOCAN",89,0) S STAT="SC",PHARMST="ZE",COMM="Medication Expired on "_$E($P(^PSRX(DA,2),"^",6),4,5)_"/"_$E($P(^(2),"^",6),6,7)_"/"_$E($P(^(2),"^",6),2,3) D EN^PSOHLSN1(DA,STAT,PHARMST,COMM) K COMM,STAT,PHARMST "RTN","PSOCAN",90,0) EP1 I '$G(RXSP) D INVALD^PSOCAN1 Q:$G(POERR) G NUM "RTN","PSOCAN",91,0) Q "RTN","PSOCAN",92,0) PSD ;Called from Controlled Subs, PSDRX is internal Rx number "RTN","PSOCAN",93,0) S PSDRFDEL=0 "RTN","PSOCAN",94,0) I '$G(PSDRX)!('$D(^PSRX(+$G(PSDRX),0))) Q "RTN","PSOCAN",95,0) I $P($G(^PSRX(PSDRX,"STA")),"^")<12 Q "RTN","PSOCAN",96,0) N DA,NODE,RF,PSOPSDAL,PSODRX,PSODTE,PSODL,SFN,RIFN,PSOSXP,PSOFILDL "RTN","PSOCAN",97,0) S PSODRX=0 F PSODLP=0:0 S PSODLP=$O(^PSRX(PSDRX,1,PSODLP)) Q:'PSODLP S:$D(^PSRX(PSDRX,1,PSODLP,0)) PSODRX=PSODLP "RTN","PSOCAN",98,0) I 'PSODRX Q "RTN","PSOCAN",99,0) I $P($G(^PSRX(PSDRX,1,PSODRX,0)),"^",18) Q "RTN","PSOCAN",100,0) D PSDREF I $G(PSOFILDL) K PSOFILDL Q "RTN","PSOCAN",101,0) K PSOFILDL,DIE S NODE=0,PSOPSDAL=1,DA(1)=PSDRX,DA=PSODRX,DIE="^PSRX("_DA(1)_",1,",DR=".01///@" D ^DIE K DIE "RTN","PSOCAN",102,0) S PSDRFDEL=1 "RTN","PSOCAN",103,0) Q "RTN","PSOCAN",104,0) PSDREF ; "RTN","PSOCAN",105,0) N PRDL,PSOCNODE "RTN","PSOCAN",106,0) S PSOFILDL=0 "RTN","PSOCAN",107,0) F PRDL=0:0 S PRDL=$O(^PSRX(PSDRX,4,PRDL)) Q:'PRDL I $G(PSODRX)=$P($G(^PSRX(PSDRX,4,PRDL,0)),"^",3) S PSOCNODE=$G(^(0)) "RTN","PSOCAN",108,0) I $G(PSOCNODE)="" Q "RTN","PSOCAN",109,0) I +$P(PSOCNODE,"^",4)<3 S PSOFILDL=1 "RTN","PSOCAN",110,0) Q "RTN","PSOCAN",111,0) TESTRP ; "RTN","PSOCAN",112,0) N PIIN,PIINFLAG S PIINFLAG=0 F PIIN=1:1 S X=$P(IN,",",PIIN) Q:$P(IN,",",PIIN)']"" K DIC S DIC=52,DIC(0)="QMZ" D ^DIC K DIC I +$G(Y) D "RTN","PSOCAN",113,0) .I $P($G(^PSRX(+Y,"STA")),"^")'=12,'$G(PIINFLAG) S PSOCANRD=+$P($G(^PSRX(+Y,0)),"^",4) S PIINFLAG=1 "RTN","PSOCAN",114,0) I '$G(PIINFLAG) S PSOCANRZ=1 "RTN","PSOCAN",115,0) Q "RTN","PSOCAN",116,0) ULP ; "RTN","PSOCAN",117,0) D UL^PSSLOCK(+$G(PSODFN)) "RTN","PSOCAN",118,0) Q "RTN","PSOCAN",119,0) ULRX ; "RTN","PSOCAN",120,0) I $G(PSOULRX) D PSOUL^PSSLOCK(PSOULRX) "RTN","PSOCAN",121,0) Q "RTN","PSOCAN2") 0^22^B85271948^B82356240 "RTN","PSOCAN2",1,0) PSOCAN2 ;BHAM ISC/JMB - rx cancel with speed ability drug check ;10/23/06 11:30am "RTN","PSOCAN2",2,0) ;;7.0;OUTPATIENT PHARMACY;**8,18,62,46,88,164,235,148,259,281,287,251,375,379,396,390**;DEC 1997;Build 86 "RTN","PSOCAN2",3,0) ;External reference to ^PSDRUG supported by dbia 221 "RTN","PSOCAN2",4,0) ;External reference to $$DS^PSSDSAPI supported by DBIA 5425 "RTN","PSOCAN2",5,0) REINS N DODR,ORN "RTN","PSOCAN2",6,0) I $P(^PSRX(DA,2),"^",6)
DT&('$G(DODR)) W !?5,"Placing Rx on suspense. Please wait..." D SUS "RTN","PSOCAN2",52,0) K DODR "RTN","PSOCAN2",53,0) Q "RTN","PSOCAN2",54,0) SUS ;Adds rec to suspense "RTN","PSOCAN2",55,0) S ACT=1,RXN=DA,RX0=^PSRX(DA,0),RXS=$O(^PS(52.5,"B",DA,0)) I RXS S DA=RXS,DIK="^PS(52.5," D ^DIK S DA=RXN "RTN","PSOCAN2",56,0) S RXP=$S($D(RXP):RXP,1:0),DIC="^PS(52.5,",DIC(0)="L",X=RXN,DIC("DR")=".02///"_FDT_";.03///"_$P(RX0,"^",2)_";.04///M;.05///"_RXP_";.06////"_$G(PSOSITE)_";2///0" K DD,DO D FILE^DICN "RTN","PSOCAN2",57,0) I +$G(Y),$G(RFCNT)'="" S $P(^PS(52.5,+Y,0),"^",13)=$G(RFCNT) "RTN","PSOCAN2",58,0) S DA=RXN,$P(^PSRX(DA,"STA"),"^")=5,LFD=$E($P(^PSRX(DA,3),"^"),4,5)_"-"_$E($P(^(3),"^"),6,7)_"-"_$E($P(^(3),"^"),2,3) "RTN","PSOCAN2",59,0) S ACOM="RX Placed on Suspense until "_LFD D AREC^PSOCAN1 S ST="SC",PHST="ZS" D EN^PSOHLSN1(DA,ST,PHST,ACOM) K ST,PHST "RTN","PSOCAN2",60,0) Q "RTN","PSOCAN2",61,0) DRGDRG ;Checks for drug/drug interaction, duplicate drug and class "RTN","PSOCAN2",62,0) Q:$P(^PSRX(DA,2),"^",6)
5 RFCNT=$G(RFCNT)+1 "RTN","PSOCAN2",149,0) S ACNT=$G(ACNT)+1 "RTN","PSOCAN2",150,0) D NOW^%DTC S ^PSRX(DA,"A",0)="^52.3DA^"_ACNT_"^"_ACNT S ^PSRX(DA,"A",ACNT,0)=%_"^R^"_DUZ_"^"_RFCNT_"^"_ACOM "RTN","PSOCAN2",151,0) K ^PSRX("APSOD",PSODFN,DA),ACNT,RFCNT,RF,% "RTN","PSOCAN2",152,0) I $P(^PSRX(DA,3),"^",10) S $P(^PSRX(DA,3),"^")=$P(^PSRX(DA,3),"^",10) ;*396 "RTN","PSOCAN2",153,0) S $P(^PSRX(DA,3),"^",2)=$P(^PSRX(DA,3),"^",8) "RTN","PSOCAN2",154,0) S $P(^PSRX(DA,3),"^",5)="",$P(^(3),"^",8)="" "RTN","PSOCAN2",155,0) Q "RTN","PSOCAN2",156,0) NVER ;Called from PSOCAN3, needs DA defined "RTN","PSOCAN2",157,0) N PSONVC,PSONVCP,PSONVCC "RTN","PSOCAN2",158,0) S PSONVC="SC",PSONVCP="IP",PSONVCC="Put in non-verified status" D EN^PSOHLSN1(DA,PSONVC,PSONVCP,PSONVCC) "RTN","PSOCAN2",159,0) Q "RTN","PSOCAN2",160,0) RMB(IDX) ;remove Rx if found in array BBRX() (Bingo Board) "RTN","PSOCAN2",161,0) N ST4,ST5,ST6,K "RTN","PSOCAN2",162,0) S ST4=BBRX(IDX) Q:ST4'[(DA_",") "RTN","PSOCAN2",163,0) S ST6="" "RTN","PSOCAN2",164,0) F K=1:1 S ST5=$P(ST4,",",K) Q:'ST5 D "RTN","PSOCAN2",165,0) . S:ST5'=DA ST6=ST6_$S('ST6:"",1:",")_ST5 "RTN","PSOCAN2",166,0) . S:ST6]"" BBRX(IDX)=ST6_"," K:ST6="" BBRX(IDX) "RTN","PSOCAN2",167,0) I '$D(BBRX) K BINGCRT "RTN","PSOCAN2",168,0) Q "RTN","PSOCAN2",169,0) ; "RTN","PSODDPR2") 0^12^B104633902^B150369494 "RTN","PSODDPR2",1,0) PSODDPR2 ;BIR/SAB - display enhanced order checks ;11 May 2010 9:06 AM "RTN","PSODDPR2",2,0) ;;7.0;OUTPATIENT PHARMACY;**251,375,379,390**;DEC 1997;Build 86 "RTN","PSODDPR2",3,0) ;External reference to ^PS(50.606 supported by DBIA 2174 "RTN","PSODDPR2",4,0) ;External reference to ^PS(50.7 supported by DBIA 2223 "RTN","PSODDPR2",5,0) ;External reference to ^PS(55 supported by DBIA 2228 "RTN","PSODDPR2",6,0) ;External reference to ^PSDRUG supported by DBIA 221 "RTN","PSODDPR2",7,0) ;External reference to PSOL^PSSLOCK supported by DBIA 2789 "RTN","PSODDPR2",8,0) K ^UTILITY($J),PSODRUG("BAD"),THER,THERO,^TMP($J,"PSODCOR"),PSOINTV,PSOVAG,PSODD,PSI,PSORDIT,DRGNM,PDODCNT "RTN","PSODDPR2",9,0) I $O(^TMP($J,LIST,"OUT","EXCEPTIONS",""))]"" D EXC^PSODDPR5 G EXIT:$G(PSODLQT) "RTN","PSODDPR2",10,0) N COUNT,DRG,ON,CT,DRGI,PDRG,SEV,STX,INT,CLI,PSONULN,PSONULN1,LST,LSI,DGI,SER,SERS,DUPT,SV,PSOLINES,OLDDRG,PSOOLDD,PSOTSUB,PSODSEQ,ZST,ZHDR,ZSUB,ZZDGDGC,PSOCLNS "RTN","PSODDPR2",11,0) S (ON,DRG,SV,LSI,DGI,SER,SERS,PSOOLDD)="",(ZZDGDGC,CT,COUNT)=0,$P(PSONULN,"-",79)="-",$P(PSONULN1,"=",79)="=",ZHDR=1 "RTN","PSODDPR2",12,0) D NSRT^PSODDPR5 K ^TMP("PSODGI",$J),^TMP("PSOSER",$J),^TMP("PSOSERS",$J),^TMP("PSODGS",$J),^TMP("PSOTDD",$J,1) "RTN","PSODDPR2",13,0) S (ON,DRG,SV,DGI,SER,SERS,ZVA)="",(ZST,ZORS,CT,COUNT)=0 "RTN","PSODDPR2",14,0) F S SV=$O(ZZDGDG(SV)) Q:SV=""!$G(PSODLQT) F S ZST=$O(ZZDGDG(SV,ZST)) Q:'ZST!$G(PSODLQT) F S ZORS=$O(ZZDGDG(SV,ZST,ZORS)) Q:'ZORS!$G(PSODLQT) D "RTN","PSODDPR2",15,0) .F S ZVA=$O(ZZDGDG(SV,ZST,ZORS,ZVA)) Q:ZVA=""!$G(PSODLQT) F S DRG=$O(ZZDGDG(SV,ZST,ZORS,ZVA,DRG)) Q:DRG=""!$G(PSODLQT) S COUNT=COUNT+1 D DUP^PSODDPR8,BLD2^PSODGDGP "RTN","PSODDPR2",16,0) K HZVA,ZVA,ZORS,ZZDGDG,PSOCLNS,COUNT,ON,DRG,SV,DGI,PSORX("INTERVENE"),DIR D HD() G EXIT:$G(PSODLQT) "RTN","PSODDPR2",17,0) Q:$D(PSSDIUTL) "RTN","PSODDPR2",18,0) I +$G(PSOINTV) D INT G EXIT:$G(PSODLQT) "RTN","PSODDPR2",19,0) I $G(PSORX("DFLG")) W:$G(COPY) !,$C(7),"RX DELETED",! S PSORX("DFLG")=1,POERR("DFLG")=1,VALMBCK="R" G EXIT Q "RTN","PSODDPR2",20,0) I '$D(^XUSEC("PSORPH",DUZ)) K PSORX("INTERVENE") "RTN","PSODDPR2",21,0) I $G(PSORX("INTERVENE"))]"" D FULL^VALM1,^PSORXI S:'$G(POERR) VALMBCK="R" W ! "RTN","PSODDPR2",22,0) I $G(PSORX("DFLG")) G EXIT "RTN","PSODDPR2",23,0) I $O(^TMP($J,LIST,"OUT","DRUGDRUG","ERROR",""))]"" D G EXIT:PSODLQT I ($Y+5)>IOSL W @IOF "RTN","PSODDPR2",24,0) .S NODDERR=1 K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to Continue" D ^DIR "RTN","PSODDPR2",25,0) .I ($D(DTOUT))!($D(DUOUT)) S PSODLQT=1,PSORX("DFLG")=1 K DIR,DTOUT,DUOUT Q "RTN","PSODDPR2",26,0) .D HD() Q:$G(PSODLQT) W !,"Drug Interaction Error(s):",! S CT=0,ON="" "RTN","PSODDPR2",27,0) .F S ON=$O(^TMP($J,LIST,"OUT","DRUGDRUG","ERROR",ON)) Q:ON="" F S CT=$O(^TMP($J,LIST,"OUT","DRUGDRUG","ERROR",ON,CT)) Q:'CT D "RTN","PSODDPR2",28,0) ..Q:$G(NODDERR)&($P(ON,";")'="Z") "RTN","PSODDPR2",29,0) ..W ?5,$S($P(ON,";")="N":"",$P(ON,";")="R":"Remote Rx for ",$P(ON,";")="O":"Local Rx for ",1:"Prospective Rx for ") "RTN","PSODDPR2",30,0) ..W " "_^TMP($J,LIST,"OUT","DRUGDRUG","ERROR",ON,CT,"MSG"),!," "_^TMP($J,LIST,"OUT","DRUGDRUG","ERROR",ON,CT,"TEXT"),! "RTN","PSODDPR2",31,0) ..D HD() Q:$G(PSODLQT) "RTN","PSODDPR2",32,0) ;therapy "RTN","PSODDPR2",33,0) D HD() G EXIT:$G(PSODLQT) "RTN","PSODDPR2",34,0) THER I '$O(^TMP($J,LIST,"OUT","THERAPY",0)) G EXIT "RTN","PSODDPR2",35,0) I '$D(^XUSEC("PSORPH",DUZ)),$P(PSOPAR,"^",2),$G(PSOTECCK) G EXIT "RTN","PSODDPR2",36,0) D NSRT1^PSODDPR5 "RTN","PSODDPR2",37,0) N ON,DDTH,CLASS,QTHER,ZDRG,ZTHER K DUPT,THER,THERO,SUB,ZOT I '$P(PSOPAR,"^",10) D NOCAN^PSODDPR5 G ERR "RTN","PSODDPR2",38,0) D HD() G EXIT:$G(PSODLQT) W @IOF,PSONULN1,! S (SUB,CT,LST,PSOZZ)=0 S THER=1,THERO=0,QTHER=1 K RXDT "RTN","PSODDPR2",39,0) F S CT=$O(^TMP($J,LIST,"OUT","THERAPY",CT)) Q:'CT!$G(PSODLQT) F S SUB=$O(^TMP($J,LIST,"OUT","THERAPY",CT,"DRUGS",SUB)) Q:'SUB!$G(PSODLQT) S ON=$P(^TMP($J,LIST,"OUT","THERAPY",CT,"DRUGS",SUB),"^") D "RTN","PSODDPR2",40,0) .I $G(PSODCTH(ON)) Q "RTN","PSODDPR2",41,0) .S RXREC=$P(ON,";",2) "RTN","PSODDPR2",42,0) .I $P(ON,";")="Z" Q "RTN","PSODDPR2",43,0) .I $P(ON,";")="N",$G(^TMP($J,"PSONVADD",RXREC,0)) Q "RTN","PSODDPR2",44,0) .I $P(ON,";")="R",$G(^TMP($J,"PSORMDD",RXREC,0)) Q "RTN","PSODDPR2",45,0) .I $P(ON,";")="O",$G(^TMP("PSORXDC",$J,RXREC,0)) Q "RTN","PSODDPR2",46,0) .I $P(ON,";")="P",$G(^TMP("PSORXDC",$J,RXREC,0)) Q "RTN","PSODDPR2",47,0) .I $P(ON,";")="O",$G(^TMP("PSORXDD",$J,RXREC,0)) Q "RTN","PSODDPR2",48,0) .S ZOT=$S($P(ON,";")["C":1,$P(ON,";")="O":2,$P(ON,";")="R":3,$P(ON,";")="P":4,1:5) "RTN","PSODDPR2",49,0) .I $P(ON,";")="P" D "RTN","PSODDPR2",50,0) ..I '$P(^PS(52.41,$P(ON,";",2),0),"^",9) S ZDRG=$P(^PS(50.7,$P(^PS(52.41,$P(ON,";",2),0),"^",8),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^") Q "RTN","PSODDPR2",51,0) ..S ZDRG=$P(^PSDRUG($P(^PS(52.41,$P(ON,";",2),0),"^",9),0),"^") "RTN","PSODDPR2",52,0) .I $P(ON,";")="O" S ZDRG=$P(^PSDRUG($P(^PSRX($P(ON,";",2),0),"^",6),0),"^") "RTN","PSODDPR2",53,0) .I $P(ON,";")="N" D "RTN","PSODDPR2",54,0) ..S DUPRX0=^PS(55,PSODFN,"NVA",$P(ON,";",2),0) "RTN","PSODDPR2",55,0) ..I '$P(DUPRX0,"^",2) S ZDRG=$P(^PS(50.7,$P(DUPRX0,"^"),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^") Q "RTN","PSODDPR2",56,0) ..S ZDRG=$P(^PSDRUG($P(DUPRX0,"^",2),0),"^") "RTN","PSODDPR2",57,0) .I $P(ON,";")="R" D "RTN","PSODDPR2",58,0) ..Q:'$D(^TMP($J,LIST,"OUT","REMOTE",$P(ON,";",2))) "RTN","PSODDPR2",59,0) ..S RXREC=^TMP($J,LIST,"OUT","REMOTE",$P(ON,";",2)),ZDRG=$P(RXREC,"^",3) "RTN","PSODDPR2",60,0) .I $E($P(ON,";"))="C" S RXREC=^TMP($J,LIST,"IN","PROFILE",ON),ZDRG=$P(RXREC,U,4) Q:$D(ZTHER(ZOT_"^"_ZDRG_"^"_ON)) ; clinic order "RTN","PSODDPR2",61,0) .S ZTHER(ZOT_"^"_ZDRG_"^"_ON,SUB)=ON K ZDRG "RTN","PSODDPR2",62,0) G EXIT:$G(PSODLQT) "RTN","PSODDPR2",63,0) I $O(ZTHER(""))]"" D "RTN","PSODDPR2",64,0) .S (PSODUPF,PSODUPC,PSODUPC1,PSOTSUB)="" F S PSODUPF=$O(ZTHER(PSODUPF)) Q:PSODUPF="" F S PSOTSUB=$O(ZTHER(PSODUPF,PSOTSUB)) Q:PSOTSUB="" S PSODUPC1=PSODUPC1+1 "RTN","PSODDPR2",65,0) .;get line counts for each duplicate therapy by setting PSODUPF=1 and calling DUPCL to execute therapy code without actually displaying info. ; no breaks in the middle of displaying individual dup therapies. "RTN","PSODDPR2",66,0) .S PSODUPF=1,PSODUPC=0,PSODUPC("CLASS")="" D DUPCL S PSODUPF=0 "RTN","PSODDPR2",67,0) .;set PSODUPF=0 then call DUPCL to actually print the duplicate therapies. "RTN","PSODDPR2",68,0) .D DUPCL K DDTH,PSODUPC,PSODUPF,PSODUPC1,PSODUPC2 "RTN","PSODDPR2",69,0) G EXIT:$G(PSODLQT) "RTN","PSODDPR2",70,0) K PSODCTH,RXDT,PSOZZ "RTN","PSODDPR2",71,0) I $P(PSOPAR,"^",10),$O(^TMP($J,"PSODCOR",0)),'$G(PSODGCK) D DCOR^PSODDPR3 K ^TMP($J,"PSODCOR") D HD() G EXIT:$G(PSODLQT) W !,PSONULN1,! "RTN","PSODDPR2",72,0) ERR I $O(^TMP($J,LIST,"OUT","THERAPY","ERROR",""))]"" D S NODTERR=1 K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to Continue" D ^DIR "RTN","PSODDPR2",73,0) .D HD() Q:$G(PSODLQT) W !,"Drug Therapy Error(s):",! S CT=0,ON="" "RTN","PSODDPR2",74,0) .F S ON=$O(^TMP($J,LIST,"OUT","THERAPY","ERROR",ON)) Q:ON=""!$G(PSODLQT) F S CT=$O(^TMP($J,LIST,"OUT","THERAPY","ERROR",ON,CT)) Q:'CT!$G(PSODLQT) D "RTN","PSODDPR2",75,0) ..Q:$G(NODTERR)&($P(ON,";")'="Z")!$G(PSODLQT) "RTN","PSODDPR2",76,0) ..D HD() Q:$G(PSODLQT) W ?5,$S($P(ON,";")="P":"Pending Order: ",$P(ON,";")="N":"Non-VA Med Order: ",$P(ON,";")="R":"Remote Rx: ",$P(ON,";")="O":"Rx: ",1:"Prospective Rx: ") "RTN","PSODDPR2",77,0) ..D HD() Q:$G(PSODLQT) W " "_^TMP($J,LIST,"OUT","THERAPY","ERROR",ON,CT,"MSG"),!," "_^TMP($J,LIST,"OUT","THERAPY","ERROR",ON,CT,"TEXT"),! "RTN","PSODDPR2",78,0) I $O(^TMP($J,LIST,"OUT","THERAPY","ERROR",""))]"" S:($D(DTOUT))!($D(DUOUT))!($G(DIRUT)) PSODLQT=1,PSORX("DFLG")=1 K DIR,DTOUT,DUOUT Q:$G(PSODLQT) "RTN","PSODDPR2",79,0) D HD() "RTN","PSODDPR2",80,0) EXIT ; "RTN","PSODDPR2",81,0) D ^PSOBUILD "RTN","PSODDPR2",82,0) K DSPL,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,ZCT "RTN","PSODDPR2",83,0) K IT,LST,THER,THERO,^UTILITY($J),DGI,SER,SEV,SERS,BSIG,I,NODDERR,NODTERR,PDRG,DRGI,STATUS,^UTILITY($J,"W"),X,ZX,DIWL,DIWR,DIWF,THER,THERO,PSOINTV,ZTHER,PSOVORD,PSODCTH,ZZDGDG,ZZDGDG2 "RTN","PSODDPR2",84,0) Q "RTN","PSODDPR2",85,0) ; "RTN","PSODDPR2",86,0) RX D HD() Q:$G(PSODLQT) W ! S RXREC=$P(ON,";",2) "RTN","PSODDPR2",87,0) S DUPRX0=^PSRX(RXREC,0),RFLS=$P(DUPRX0,"^",9),ISSD=$P(^PSRX(RXREC,0),"^",13),RX0=DUPRX0,RX2=^PSRX(RXREC,2),STATUS=+$G(^PSRX(RXREC,"STA")) "RTN","PSODDPR2",88,0) S RXRECLOC=$G(RXREC) "RTN","PSODDPR2",89,0) S J=RXREC D STAT^PSOFUNC K RX0,RX2 "RTN","PSODDPR2",90,0) 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","PSODDPR2",91,0) I STATUS>10,STATUS'=16 K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to continue" D ^DIR W @IOF S:($D(DTOUT))!($D(DUOUT))!($G(DIRUT)) PSODLQT=1,PSORX("DFLG")=1 K DIR,DTOUT,DUOUT,DIRUT,RXRECLOC Q "RTN","PSODDPR2",92,0) I '$P(PSOPAR,"^",2),'$P(PSOPAR,"^",16),'$D(^XUSEC("PSORPH",DUZ)) S PSORX("DFLG")=1 K RXRECLOC Q "RTN","PSODDPR2",93,0) I $P(PSOPAR,"^",2),'$P(PSOPAR,"^",16),'$D(^XUSEC("PSORPH",DUZ)) S PSORX("DFLG")=1 K RXRECLOC Q "RTN","PSODDPR2",94,0) I STATUS=16 W !!,"Prescription "_$P($G(^PSRX(+$G(RXRECLOC),0)),"^")_" is on Provider Hold, it cannot be discontinued.",! K DUP,RXRECLOC S PSORX("DFLG")=1 Q "RTN","PSODDPR2",95,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","PSODDPR2",96,0) .I $P($G(PSOMSG),"^",2)'="" W !!,$P(PSOMSG,"^",2),! Q "RTN","PSODDPR2",97,0) .W !!,"Another person is editing Rx #"_$P($G(^PSRX(RXREC,0)),"^"),! "RTN","PSODDPR2",98,0) K PSOMSG S DIR("A")=$S(STATUS=12:"Reinstate",1:"Discontinue")_" RX # "_$P(^PSRX(RXREC,0),"^"),DIR(0)="Y",DIR("?")="Enter Y to "_$S(STATUS=12:"reinstate",1:"discontinue")_" this RX." "RTN","PSODDPR2",99,0) D ^DIR K DIR S:($D(DTOUT))!($D(DUOUT))!($G(DIRUT)) PSODLQT=1,PSORX("DFLG")=1 Q:$G(PSODLQT) "RTN","PSODDPR2",100,0) S DA=RXREC S ACT=$S($D(SPCANC):"Reinstated during Rx cancel.",1:$S(STATUS=12:"Reinstated",1:"Discontinued")_" while "_$S('$G(PSONV):"entering",1:"verifying")_" new RX") "RTN","PSODDPR2",101,0) D CMOP^PSOUTL I $G(CMOP("S"))="L" W !,"A CMOP Rx cannot be discontinued during transmission!",! S Y=0 K CMOP "RTN","PSODDPR2",102,0) I 'Y W $C(7)," -Prescription was not "_$S(STATUS=12:"reinstated",1:"discontinued")_"..." D Q "RTN","PSODDPR2",103,0) .S:'$D(PSOCLC) PSOCLC=DUZ S MSG=ACT,REA=$S(STATUS=12:"R",1:"C") S:$G(DUP) PSORX("DFLG")=1 K DUP "RTN","PSODDPR2",104,0) .I $D(^TMP("PSORXDC",$J,RXREC,0)) K ^TMP("PSORXDC",$J,RXREC,0) "RTN","PSODDPR2",105,0) S PSOCLC=DUZ,MSG=$S($G(MSG)]"":MSG,1:ACT_" During New RX "_$S('$G(PSONV):"Entry",1:"Verification")_" - Duplicate Rx"),REA=$S(STATUS=12:"R",1:"C") "RTN","PSODDPR2",106,0) W !!,"THERAPEUTIC DUPLICATIONS will be discontinued after the acceptance of the new order.",!! "RTN","PSODDPR2",107,0) S ^TMP("PSORXDC",$J,RXREC,0)="52^"_DA_"^"_MSG_"^"_REA_"^"_ACT_"^"_ST_"^"_DRG,PSONOOR="D" "RTN","PSODDPR2",108,0) K RXRECLOC,DUP,CLS,PSONOOR,STATUS,ACT,PSONV,REA,SPCANC "RTN","PSODDPR2",109,0) Q "RTN","PSODDPR2",110,0) ; "RTN","PSODDPR2",111,0) DUPCL ; "RTN","PSODDPR2",112,0) Q:$G(PSODLQT) "RTN","PSODDPR2",113,0) S:$G(PSODUPF) PSODUPC=PSODUPC+1 W:'$G(PSODUPF) @IOF,PSONULN1,! "RTN","PSODDPR2",114,0) I '$G(PSODUPF) W "*** THERAPEUTIC DUPLICATION(S) *** "_PSODRUG("NAME")_" with" "RTN","PSODDPR2",115,0) S:$G(PSODUPF) PSODUPC=PSODUPC+1 N PSODUPCT,PSODUPC2,PSODUPCL "RTN","PSODDPR2",116,0) S (PSODUPC2,PSODUPCT)=0 S:'$G(PSODUPF) PSODUPCT=2 "RTN","PSODDPR2",117,0) ;displays order and therapy "RTN","PSODDPR2",118,0) K DDTH S (PSODUPCL,ZSUB,ZCT,PSODSEQ)="" "RTN","PSODDPR2",119,0) F S ZCT=$O(ZTHER(ZCT)) Q:ZCT=""!($G(PSODLQT)) F S PSODSEQ=$O(ZTHER(ZCT,PSODSEQ)) Q:PSODSEQ=""!($G(PSODLQT)) S ON=ZTHER(ZCT,PSODSEQ) D "RTN","PSODDPR2",120,0) .S PDODCNT=0,PSODUPC2=PSODUPC2+1 I $G(PSODUPF) S PSODUPC(ZCT)=0 "RTN","PSODDPR2",121,0) .I PSODUPC2=PSODUPC2+1 "RTN","PSODDPR2",122,0) .I '$G(PSODUPF) D "RTN","PSODDPR2",123,0) ..I PSODUPC2=PSODUPC1,(PSODUPCT+PSODUPC(ZCT)+PSODUPC("CLASS"))>22 D HD(15) Q:$G(PSODLQT) S PSODUPCT=0 "RTN","PSODDPR2",124,0) ..I (PSODUPCT+PSODUPC(ZCT))>22 D HD(15) Q:$G(PSODLQT) S PSODUPCT=0 "RTN","PSODDPR2",125,0) ..S PSODUPCT=PSODUPCT+PSODUPC(ZCT) "RTN","PSODDPR2",126,0) .I $P(ON,";")="O" D HD() Q:$G(PSODLQT) S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) ! D DDRX^PSODDPR8 D "RTN","PSODDPR2",127,0) ..Q:STATUS>5&(STATUS'=16) "RTN","PSODDPR2",128,0) ..Q:$G(^TMP("PSORXDC",$J,RXREC,0))]"" "RTN","PSODDPR2",129,0) ..Q:$G(RXDT("O",RXREC)) "RTN","PSODDPR2",130,0) ..S RX0=^PSRX(RXREC,0),J=RXREC,RX2=^PSRX(RXREC,2) D STAT^PSOFUNC K RX0,RX2 "RTN","PSODDPR2",131,0) ..S PSOZZ=PSOZZ+1,^TMP($J,"PSODCOR",PSOZZ)="52"_"^"_RXREC_"^"_ST_"^"_DRGNM,RXDT("O",RXREC)=1 "RTN","PSODDPR2",132,0) .I $P(ON,";")="N" D HD() Q:$G(PSODLQT) S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) ! D ^PSODDPR3 "RTN","PSODDPR2",133,0) .I $P(ON,";")="P" D "RTN","PSODDPR2",134,0) ..D HD(8) Q:$G(PSODLQT) S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) ! S RXREC=$P(ON,";",2) D PEND^PSODDPR8 "RTN","PSODDPR2",135,0) ..Q:$G(^TMP("PSORXDC",$J,RXREC,0))]"" "RTN","PSODDPR2",136,0) ..Q:$G(RXDT("P",RXREC)) "RTN","PSODDPR2",137,0) ..S PSOZZ=PSOZZ+1,DUPRX0=^PS(52.41,RXREC,0) "RTN","PSODDPR2",138,0) ..S ^TMP($J,"PSODCOR",PSOZZ)="P"_"^"_RXREC_"^^"_$S($P(DUPRX0,"^",9):$P(^PSDRUG($P(DUPRX0,"^",9),0),"^"),1:$P(^PS(50.7,$P(DUPRX0,"^",8),0),"^")_" "_$P(^PS(50.606,$P(^PS(50.7,$P(DUPRX0,"^",8),0),"^",2),0),"^")) "RTN","PSODDPR2",139,0) ..S ^TMP($J,"PSODCOR",PSOZZ)=^TMP($J,"PSODCOR",PSOZZ)_"^"_$S('$P(DUPRX0,"^",9):$P(^PS(50.7,$P(DUPRX0,"^",8),0),"^")_" "_$P(^PS(50.606,$P(^PS(50.7,$P(DUPRX0,"^",8),0),"^",2),0),"^"),1:$P(^PSDRUG($P(DUPRX0,"^",9),0),"^")) "RTN","PSODDPR2",140,0) ..S RXDT("P",RXREC)=1 "RTN","PSODDPR2",141,0) .I $P(ON,";")="R" S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) ! D RDI^PSODDPR3 D HD() Q:$G(PSODLQT) "RTN","PSODDPR2",142,0) .I $E($P(ON,";"))="C" D HD() Q:$G(PSODLQT) S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) ! D DUP^PSODDPR7 ; clinic order "RTN","PSODDPR2",143,0) .I $O(ZTHER(ZCT,PSODSEQ))'="" D HD() Q:$G(PSODLQT) S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,PSONULN "RTN","PSODDPR2",144,0) D CLASSES^PSODDPR3 "RTN","PSODDPR2",145,0) Q:$G(PSODLQT) "RTN","PSODDPR2",146,0) I '$G(PSODUPF) S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to continue" D ^DIR K DIR W @IOF "RTN","PSODDPR2",147,0) I '$G(PSODUPF),Y'=1!($D(DTOUT))!($D(DUOUT)) S PSODLQT=1,PSORX("DFLG")=1 Q "RTN","PSODDPR2",148,0) I '$G(PSODUPF),($Y+5)>IOSL W @IOF "RTN","PSODDPR2",149,0) Q "RTN","PSODDPR2",150,0) INT ; "RTN","PSODDPR2",151,0) Q:$D(PSSDIUTL) "RTN","PSODDPR2",152,0) D INT^PSODDPR5 "RTN","PSODDPR2",153,0) Q "RTN","PSODDPR2",154,0) HD(PSOLINES,OVRRID) ; "RTN","PSODDPR2",155,0) S:'$G(PSODLQT) PSODLQT=0 S:'$G(OVRRID) OVRRID=0 S:'$G(PSOLINES) PSOLINES=5 "RTN","PSODDPR2",156,0) I '$G(OVRRID),$G(PSODLQT)!(($Y+PSOLINES)'>IOSL) Q "RTN","PSODDPR2",157,0) N DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y "RTN","PSODDPR2",158,0) W ! K DIR,Y S DIR(0)="E",DIR("A")="Press return to continue" D ^DIR K DIR "RTN","PSODDPR2",159,0) K PSOLINES,OVRRID "RTN","PSODDPR2",160,0) I Y'=1!($D(DTOUT))!($D(DUOUT)) S PSODLQT=1,PSORX("DFLG")=1 Q "RTN","PSODDPR2",161,0) W:'$G(PSODUPF) @IOF "RTN","PSODDPR2",162,0) Q "RTN","PSODDPR4") 0^32^B102172775^B94930565 "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,379,390**;DEC 1997;Build 86 "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) ;External reference to ^PS(50.606 supported by DBIA 2174 "RTN","PSODDPR4",12,0) ;External reference to ^PS(50.7 supported by DBIA 2223 "RTN","PSODDPR4",13,0) ; "RTN","PSODDPR4",14,0) BLD(PSODFN,LIST,PDRG,PTY) ; "RTN","PSODDPR4",15,0) ;build OP, RDI, INP MEDS profiles "RTN","PSODDPR4",16,0) ;PTY - P1;P2 where P1="I" for IP & "O" for OP (required), P2=Pharm order# (optional) "RTN","PSODDPR4",17,0) I '$D(PSODFN) W !,"Patient UNDEFINED!",! Q "RTN","PSODDPR4",18,0) I '$D(LIST) W !,"Input Base UNDEFINED!",! Q "RTN","PSODDPR4",19,0) K ^TMP($J,LIST) "RTN","PSODDPR4",20,0) ORD N PSODTCUT,X1,X2,ODRG,ORTYP,ORN,DO,IEN,NAME,PROF,PSOON S (PROF,CNT)=0 "RTN","PSODDPR4",21,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",22,0) I '$D(PSJDGCK) Q:$O(^TMP($J,LIST,"IN","PROSPECTIVE",""))="" ;no prospective drugs to pass in "RTN","PSODDPR4",23,0) I $D(PSJDGCK),'$D(PSGDGCKF) Q:$O(^TMP($J,LIST,"IN","PROSPECTIVE",""))="" ;no prospective drugs to pass in "RTN","PSODDPR4",24,0) S X1=DT,X2=-120 D C^%DTC S PSODTCUT=X D ^PSOBUILD,PROFILE "RTN","PSODDPR4",25,0) K PSOSD D REMOTE D:$P($G(PTY),";")="I" IN^PSJBLDOC(PSODFN,LIST,.PDRG,$G(PTY)) "RTN","PSODDPR4",26,0) S ^TMP($J,LIST,"IN","IEN")=PSODFN,^TMP($J,LIST,"IN","DRUGDRUG")="",^TMP($J,LIST,"IN","THERAPY")="" "RTN","PSODDPR4",27,0) S ^TMP($J,LIST,"IN","SOURCE")=$P($G(PTY),";") "RTN","PSODDPR4",28,0) I $P($G(PTY),";")="O" D IMO^PSODDPR7(PSODFN) "RTN","PSODDPR4",29,0) N PSOICT,PSODRUG,PSOY,CNT,ZI "RTN","PSODDPR4",30,0) D IN^PSSHRQ2(LIST) "RTN","PSODDPR4",31,0) Q "RTN","PSODDPR4",32,0) PROFILE ;build profile drug input "RTN","PSODDPR4",33,0) N ID,ORTYP,DD,PSOI,ORN,RECTYP S (STA,DNM)="",DO=0 "RTN","PSODDPR4",34,0) F S STA=$O(PSOSD(STA)) Q:STA="" F S DNM=$O(PSOSD(STA,DNM)) Q:DNM="" D "RTN","PSODDPR4",35,0) .I STA="PENDING" D Q "RTN","PSODDPR4",36,0) ..Q:$P(^PS(52.41,$P(PSOSD(STA,DNM),"^",10),0),"^",3)="RF" "RTN","PSODDPR4",37,0) ..S RXREC=$P(PSOSD(STA,DNM),"^",10),ORN=$P(^PS(52.41,RXREC,0),"^"),ODRG=$P(^(0),"^",9),ORTYP="P" "RTN","PSODDPR4",38,0) ..I ODRG D K ODRG Q "RTN","PSODDPR4",39,0) ...I $P($G(^PSDRUG(ODRG,0)),"^",3)["S"!($E($P($G(^PSDRUG(ODRG,0)),"^",2),1,2)="XA") Q "RTN","PSODDPR4",40,0) ...S DRNM=$P(^PSDRUG(ODRG,0),"^"),DO=DO+1 D ID "RTN","PSODDPR4",41,0) ..E N PSOI,DDRG,ODRG,SEQN,DDRG S PSOI=$P(^PS(52.41,RXREC,0),"^",8) D "RTN","PSODDPR4",42,0) ...S DRNM=$P(^PS(50.7,PSOI,0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^") "RTN","PSODDPR4",43,0) ...S DDRG=$$DRG^PSSDSAPM(PSOI,"O") I '$P(DDRG,";") D OIX Q "RTN","PSODDPR4",44,0) ...I $P($G(^PSDRUG($P(DDRG,";"),0)),"^",3)["S"!($E($P($G(^PSDRUG($P(DDRG,";"),0)),"^",2),1,2)="XA") Q "RTN","PSODDPR4",45,0) ...S ODRG=$P(DDRG,";"),SEQN=+$P(DDRG,";",3) K PSOI "RTN","PSODDPR4",46,0) ...N ID S ID=+$$GETVUID^XTID(50.68,,+$P($G(^PSDRUG(ODRG,"ND")),"^",3)_",") "RTN","PSODDPR4",47,0) ...D ID1 "RTN","PSODDPR4",48,0) .I STA="ZNONVA" D Q "RTN","PSODDPR4",49,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",50,0) ..I ODRG D K ODRG Q "RTN","PSODDPR4",51,0) ...I $P($G(^PSDRUG(ODRG,0)),"^",3)["S"!($E($P($G(^PSDRUG(ODRG,0)),"^",2),1,2)="XA") Q "RTN","PSODDPR4",52,0) ...S DRNM=$P(^PSDRUG(ODRG,0),"^"),DO=DO+1 D ID "RTN","PSODDPR4",53,0) ..E N PSOI,DDRG,ODRG,SEQN,DDRG,DRNM S PSOI=$P(^PS(55,PSODFN,"NVA",RXREC,0),"^") D "RTN","PSODDPR4",54,0) ...S DRNM=$P(^PS(50.7,PSOI,0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^") "RTN","PSODDPR4",55,0) ...S DDRG=$$DRG^PSSDSAPM(PSOI,"X") I '$P(DDRG,";") D:'$$NVATST^PSODDPRE(PSOI) OIX Q "RTN","PSODDPR4",56,0) ...I $P($G(^PSDRUG($P(DDRG,";"),0)),"^",3)["S"!($E($P($G(^PSDRUG($P(DDRG,";"),0)),"^",2),1,2)="XA") Q "RTN","PSODDPR4",57,0) ...S ODRG=$P(DDRG,";"),SEQN=+$P(DDRG,";",3),DO=DO+1 K PSOI "RTN","PSODDPR4",58,0) ...N ID S ID=+$$GETVUID^XTID(50.68,,+$P($G(^PSDRUG(ODRG,"ND")),"^",3)_",") "RTN","PSODDPR4",59,0) ...D ID1 "RTN","PSODDPR4",60,0) .S RXREC=+PSOSD(STA,DNM) "RTN","PSODDPR4",61,0) .I $P($G(PTY),";")="O",$P($G(PTY),";",2)=RXREC Q "RTN","PSODDPR4",62,0) .I $P($G(^PSRX(RXREC,0)),"^",6) S ODRG=$P(^PSRX(RXREC,0),"^",6) D "RTN","PSODDPR4",63,0) ..I $P($G(^PSDRUG(ODRG,0)),"^",3)["S"!($E($P($G(^PSDRUG(ODRG,0)),"^",2),1,2)="XA") Q "RTN","PSODDPR4",64,0) ..I STA="DISCONTINUED" Q:$$DUPTHER^PSODDPRE(RXREC) ;screen out duplicate therapy for local orders "RTN","PSODDPR4",65,0) ..S ORN=$P($G(^PSRX(RXREC,"OR1")),"^",2),ORTYP="O",DRNM=$P(^PSDRUG(ODRG,0),"^"),DO=DO+1 D ID "RTN","PSODDPR4",66,0) K RXREC,ID,STA,DNM,SEQN,PSOI,PSODD,P1,P3,OR1,P2,PSODRUG,DD,DRNM,DDRG "RTN","PSODDPR4",67,0) Q "RTN","PSODDPR4",68,0) ID N ID S ID=+$$GETVUID^XTID(50.68,,+$P($G(^PSDRUG(ODRG,"ND")),"^",3)_",") "RTN","PSODDPR4",69,0) S P1=$P($G(^PSDRUG(ODRG,"ND")),"^"),P2=$P($G(^("ND")),"^",3),X=$$PROD0^PSNAPIS(P1,P2),SEQN=+$P(X,"^",7) "RTN","PSODDPR4",70,0) ID1 I '$D(PSJDGCK) S ^TMP($J,LIST,"IN","PROFILE",ORTYP_";"_RXREC_";PROFILE;"_DO)=SEQN_"^"_ID_"^"_ODRG_"^"_DRNM_"^"_ORN_"^O" K ID "RTN","PSODDPR4",71,0) I $D(PSJDGCK) S ^TMP($J,LIST,"IN","PROSPECTIVE",ORTYP_";"_RXREC_";PROSPECTIVE;"_DO)=SEQN_"^"_ID_"^"_ODRG_"^"_DRNM_"^"_ORN_"^O" K ID "RTN","PSODDPR4",72,0) Q "RTN","PSODDPR4",73,0) OIX S ^TMP($J,LIST,"IN","EXCEPTIONS","OI",DRNM)=1_"^"_ORTYP_";"_RXREC_";PROFILE;"_DO "RTN","PSODDPR4",74,0) K TU "RTN","PSODDPR4",75,0) Q "RTN","PSODDPR4",76,0) REMOTE ; "RTN","PSODDPR4",77,0) I $T(HAVEHDR^ORRDI1)']"" Q "RTN","PSODDPR4",78,0) I '$$HAVEHDR^ORRDI1 Q "RTN","PSODDPR4",79,0) I $D(^XTMP("ORRDI","OUTAGE INFO","DOWN")) D Q "RTN","PSODDPR4",80,0) .I $T(REMOTE^PSORX1)]"" Q "RTN","PSODDPR4",81,0) .D HD^PSODDPR2():(($Y+5)'>IOSL) "RTN","PSODDPR4",82,0) .W !!,"Remote data not available - Only local order checks processed.",! D HD^PSODDPR2():(($Y+5)'>IOSL) "RTN","PSODDPR4",83,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",84,0) N PSORDI,RDIINST,RDIVUID,RDIRX,RDIDNAM,RDISTA,RDISIG,RDIDAYS,RDIQTY,RDIFILL,RDIEXP,RDIISS,RDIFILL,ZI "RTN","PSODDPR4",85,0) N RDIREF,RDIPHYS,PSOPROD,PSOCLASS,DRNM,RDITMP,PSODC,IT,PSOICT,NDF,RDIDI,PSOPRODA,PSOFILE,PSOSIG,PSOSEQN,X "RTN","PSODDPR4",86,0) I '$G(DT) S DT=$$DT^XLFDT "RTN","PSODDPR4",87,0) S PSORDI=0 "RTN","PSODDPR4",88,0) I $T(GET^ORRDI1)]"" S PSORDI=$$GET^ORRDI1(PSODFN,"PSOO") "RTN","PSODDPR4",89,0) I PSORDI<1 Q "RTN","PSODDPR4",90,0) I '$D(^XTMP("ORRDI","PSOO",PSODFN)) Q "RTN","PSODDPR4",91,0) K ^TMP($J,LIST,"OUT","REMOTE") "RTN","PSODDPR4",92,0) D PARSE,FILTER "RTN","PSODDPR4",93,0) I '$D(^TMP($J,LIST,"OUT","REMOTE")) Q "RTN","PSODDPR4",94,0) N DIC D REMO "RTN","PSODDPR4",95,0) Q "RTN","PSODDPR4",96,0) REMO ; "RTN","PSODDPR4",97,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",98,0) .Q:$P(RDITMP,"^",2)="" "RTN","PSODDPR4",99,0) .;screen out dc'd remotes "RTN","PSODDPR4",100,0) .I $P($G(^TMP($J,LIST,"OUT","REMOTE",PSORDI)),"^",4)["DISC" D I $G(PSOON) K PSOON Q "RTN","PSODDPR4",101,0) ..K X,Y,X1,X2 "RTN","PSODDPR4",102,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",103,0) ..D C^%DTC I X
($E(DT,2,3)+1) S PSOPRE=PSOPRE-1 "RTN","PSODDPR4",133,0) ..S NEWISS=PSOPRE_$P(RDIISS,"/",3)_$P(RDIISS,"/")_$P(RDIISS,"/",2) I NEWISS>(DT-10000) S RDIEXP=RDIISS,BADEXP=0 "RTN","PSODDPR4",134,0) .I RDISTA["EXPIRE" S PSO30=0 D I PSO30 Q "RTN","PSODDPR4",135,0) ..S PSOPRE=$E(DT) I $P(RDIEXP,"/",3)>($E(DT,2,3)+1) S PSO30=1 Q "RTN","PSODDPR4",136,0) ..S NEWEXP=PSOPRE_$P(RDIEXP,"/",3)_$P(RDIEXP,"/")_$P(RDIEXP,"/",2) "RTN","PSODDPR4",137,0) ..S X1=NEWEXP,X2=30 D C^%DTC I X
($E(DT,2,3)+1) S PSO30=1 Q "RTN","PSODDPR4",142,0) ..S NEWDC=PSOPRE_$P(RDIFILL,"/",3)_$P(RDIFILL,"/")_$P(RDIFILL,"/",2) "RTN","PSODDPR4",143,0) ..S X1=NEWDC,X2=30+RDIDAYS D C^%DTC I X
RDIEXP2 K ^TMP($J,"OUT","REMOTE",PSORDI) Q "RTN","PSODDPR4",179,0) .S PSOPRE=$E(DT) I $P(RDIEXP,"/",3)>($E(DT,2,3)+1) S PSOPRE=PSOPRE-1 "RTN","PSODDPR4",180,0) .S RDIEXP2=PSOPRE_$P(RDIEXP,"/",3)_$P(RDIEXP,"/")_$P(RDIEXP,"/",2) "RTN","PSODDPR4",181,0) .S PSOPRE=$E(DT) I $P(OLDEXP,"/",3)>($E(DT,2,3)+1) S PSOPRE=PSOPRE-1 "RTN","PSODDPR4",182,0) .S OLDEXP2=PSOPRE_$P(OLDEXP,"/",3)_$P(OLDEXP,"/")_$P(OLDEXP,"/",2) "RTN","PSODDPR4",183,0) S OLDRDI=$P(ZZ,"^") K ^TMP($J,LIST,"OUT","REMOTE",OLDRDI) D SETRDI "RTN","PSODDPR4",184,0) Q "RTN","PSODDPR4",185,0) ; "RTN","PSODDPR4",186,0) SETRDI ; "RTN","PSODDPR4",187,0) S RDI(RDIINST,RDIVUID)=PSORDI_"^"_RDISTA_"^"_RDIEXP "RTN","PSODDPR4",188,0) Q "RTN","PSODDPR4",189,0) CPRS(PSODFN,LIST,PDRG,PTY) ; "RTN","PSODDPR4",190,0) ;PDRG - Drug array in format of PDRG(n)=IEN (#50) ^ Drug name "RTN","PSODDPR4",191,0) ;PTY - P1;P2 where P1="I" for IP & "O" for OP (required), P2=Pharm order# (optional) "RTN","PSODDPR4",192,0) I '$G(PSODFN) W !,"Patient UNDEFINED!",! Q "RTN","PSODDPR4",193,0) I '$O(PDRG(0)) W !,"Dispense Drug(s) UNDEFINED!",! Q "RTN","PSODDPR4",194,0) I '$D(LIST) W !,"Input Base UNDEFINED!",! Q "RTN","PSODDPR4",195,0) K ^TMP($J,"ORDERS"),^TMP($J,"DD"),^TMP($J,LIST) N ZII,INDX,INDD S (INDX,INDD)=0 "RTN","PSODDPR4",196,0) ;build patient's drug profile outpat/inpat/non-va "RTN","PSODDPR4",197,0) D BLD^PSOORDRG,ENCHK^PSJORUT2(PSODFN,.INDX),NVA^PSOORDRG "RTN","PSODDPR4",198,0) ;dup drug check CPRS ONLY "RTN","PSODDPR4",199,0) S PSOICT="",CNT=0 F ZII=0:0 S ZII=$O(PDRG(ZII)) Q:'ZII D "RTN","PSODDPR4",200,0) .S PSOY=$P(PDRG(ZII),"^")_"^"_$P($G(^PSDRUG($P(PDRG(ZII),"^"),0)),"^"),PSOY(0)=$G(^PSDRUG(PDRG(ZII),0)) "RTN","PSODDPR4",201,0) .S IEN=+PSOY,NAME=$P(PSOY,"^",2),DNM=0 K PSOX1,PSOY "RTN","PSODDPR4",202,0) .F S DNM=$O(^TMP($J,"ORDERS",DNM)) Q:'DNM I NAME=$P(^TMP($J,"ORDERS",DNM),"^",3) D "RTN","PSODDPR4",203,0) ..S INDD=$G(INDD)+1,^TMP($J,"DD",INDD,0)=IEN_"^"_NAME_"^"_$P(^TMP($J,"ORDERS",DNM),"^",4)_"^"_$P(^(DNM),"^",5) "RTN","PSODDPR4",204,0) K ^TMP($J,"ORDERS") "RTN","PSODDPR4",205,0) D ORD "RTN","PSODDPR4",206,0) Q "RTN","PSODDPR4",207,0) DRG ; "RTN","PSODDPR4",208,0) I $P($G(^PSDRUG(IEN,0)),"^",3)["S"!($E($P($G(^PSDRUG(IEN,0)),"^",2),1,2)="XA") Q "RTN","PSODDPR4",209,0) N ID,SEQN S PSODRUG("NDF")=$S($G(^PSDRUG(IEN,"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:0) "RTN","PSODDPR4",210,0) S ID=$$GETVUID^XTID(50.68,,+$P($G(PSODRUG("NDF")),"A",2)_",") "RTN","PSODDPR4",211,0) S P1=$P($G(^PSDRUG(IEN,"ND")),"^"),P2=$P($G(^("ND")),"^",3),X=$$PROD0^PSNAPIS(P1,P2),SEQN=$P(X,"^",7) "RTN","PSODDPR4",212,0) I '$D(PSJDGCK) S CNT=$G(CNT)+1,^TMP($J,LIST,"IN","PROSPECTIVE",$P(PTY,";")_";"_$P(PTY,";",2)_";PROSPECTIVE;"_CNT)=SEQN_"^"_+ID_"^"_IEN_"^"_NAME "RTN","PSODDPR4",213,0) I $D(PSJDGCK),'$D(PSGDGCKF) S CNT=$G(CNT)+1,^TMP($J,LIST,"IN","PROSPECTIVE",$P(PTY,";")_";"_$P(PTY,";",2)_";PROSPECTIVE;"_CNT)=SEQN_"^"_+ID_"^"_IEN_"^"_NAME "RTN","PSODDPR4",214,0) K ID,SEQN,P1,P2,X,DNM "RTN","PSODDPR4",215,0) Q "RTN","PSODDPR5") 0^15^B158488185^B80117354 "RTN","PSODDPR5",1,0) PSODDPR5 ;BIR/SAB - displays OP/rdi/pending/nva orders ;09/320/06 11:33am "RTN","PSODDPR5",2,0) ;;7.0;OUTPATIENT PHARMACY;**251,375,379,390**;DEC 1997;Build 86 "RTN","PSODDPR5",3,0) ;External reference to ^PSDRUG supported by DBIA 221 "RTN","PSODDPR5",4,0) ;External reference to ^PS(50.606 supported by DBIA 2174 "RTN","PSODDPR5",5,0) ;External reference to ^PS(50.7 supported by DBIA 2223 "RTN","PSODDPR5",6,0) ; "RTN","PSODDPR5",7,0) EXC ;displays order check exceptions "RTN","PSODDPR5",8,0) N Q,CT,ONT,OT,ON,TD,ERRTY,OP,OPP,ZEXC,ZREA,X,DIWL,DIWR,DIWF,PSOWROTE "RTN","PSODDPR5",9,0) I ($Y+5)'>IOSL D HD^PSODDPR2() Q:$G(PSODLQT) ;W @IOF "RTN","PSODDPR5",10,0) S (CT,Q)=0,ONT="" "RTN","PSODDPR5",11,0) F S ONT=$O(^TMP($J,LIST,"OUT","EXCEPTIONS",ONT)) Q:ONT="" F S CT=$O(^TMP($J,LIST,"OUT","EXCEPTIONS",ONT,CT)) Q:'CT D "RTN","PSODDPR5",12,0) .S ZEXC=^TMP($J,LIST,"OUT","EXCEPTIONS",ONT,CT),ZREA=$P(^TMP($J,LIST,"OUT","EXCEPTIONS",ONT,CT),"^",10) "RTN","PSODDPR5",13,0) .S OT=$P(ONT,";"),ON=$P(ONT,";",2),OP=$P(ONT,";",3),OPP=OT_";"_ON_";"_OP "RTN","PSODDPR5",14,0) .I '$D(PSODGCK),'$D(PSSDGCK),OT="Z",ZREA="Drug not matched to NDF"!($P(^TMP($J,LIST,"OUT","EXCEPTIONS",ONT,CT),"^",7)["manual check") S PSODRUG("BAD",PSODRUG("IEN"))=1 "RTN","PSODDPR5",15,0) .Q:$G(^TMP($J,"PSEXC","OUT",OPP)) "RTN","PSODDPR5",16,0) .S Q=Q+1,ERRTY=$S(OT="R":"RDI",OT="N":"Non-VA",OT="P":"Pending",OT="O":"Rx",1:"") "RTN","PSODDPR5",17,0) .K ^UTILITY($J,"W") S DIWL=1,DIWR=75,DIWF="" "RTN","PSODDPR5",18,0) .W ! S X=$P(^TMP($J,LIST,"OUT","EXCEPTIONS",ONT,CT),"^",7) D ^DIWP "RTN","PSODDPR5",19,0) .F ZX=0:0 S ZX=$O(^UTILITY($J,"W",1,ZX)) Q:'ZX W !,^UTILITY($J,"W",1,ZX,0) "RTN","PSODDPR5",20,0) .I $D(PSODGCK)!$D(PSSDGCK) K DIR S DIR(0)="E",DIR("A")="Press Return to Continue..." W ! D ^DIR K DIR W @IOF "RTN","PSODDPR5",21,0) .S:OT'="Z" ^TMP($J,"PSEXC","OUT",OPP)=1,PSOWROTE=1 "RTN","PSODDPR5",22,0) .Q:ZREA="" "RTN","PSODDPR5",23,0) .K ^UTILITY($J,"W") S DIWL=1,DIWR=75,DIWF="" "RTN","PSODDPR5",24,0) .S X=" Reason: "_ZREA D ^DIWP "RTN","PSODDPR5",25,0) .F ZX=0:0 S ZX=$O(^UTILITY($J,"W",1,ZX)) Q:'ZX W !,^UTILITY($J,"W",1,ZX,0) "RTN","PSODDPR5",26,0) .K ^UTILITY($J,"W"),X,DIWL,DIWR,DIWF S PSOWROTE=1 "RTN","PSODDPR5",27,0) .D:$O(^TMP($J,LIST,"OUT","EXCEPTIONS",ONT,CT)) HD^PSODDPR2() Q:$G(PSODLQT) "RTN","PSODDPR5",28,0) I $G(PSOWROTE) 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","PSODDPR5",29,0) Q "RTN","PSODDPR5",30,0) NOCAN ;shows duplicate therapeutic when cancel duplicate class parameter is et to 'no' "RTN","PSODDPR5",31,0) K ^UTILITY($J,"W"),DDTH,DOCPL S DIWL=1,DIWR=78,DIWF="",(CT,SUB)=0 K TCT,TCTP,TCTL,TCTI,ZZQ,ZHDR "RTN","PSODDPR5",32,0) F S CT=$O(^TMP($J,LIST,"OUT","THERAPY",CT)) Q:'CT F S SUB=$O(^TMP($J,LIST,"OUT","THERAPY",CT,"DRUGS",SUB)) Q:'SUB D "RTN","PSODDPR5",33,0) .S ON=$P(^TMP($J,LIST,"OUT","THERAPY",CT,"DRUGS",SUB),"^"),PDRG=$P(^(SUB),"^",3),RXREC=$P(ON,";",2) "RTN","PSODDPR5",34,0) .I $G(PSODCTH(ON)) Q "RTN","PSODDPR5",35,0) .I $P(ON,";")="Z" Q "RTN","PSODDPR5",36,0) .I $P(ON,";")="N",$G(^TMP($J,"PSONVADD",RXREC,0)) Q "RTN","PSODDPR5",37,0) .I $P(ON,";")="R",$G(^TMP($J,"PSORMDD",RXREC,0)) Q "RTN","PSODDPR5",38,0) .I $P(ON,";")="O",$G(^TMP("PSORXDC",$J,RXREC,0)) Q "RTN","PSODDPR5",39,0) .I $P(ON,";")="P",$G(^TMP("PSORXDC",$J,RXREC,0)) Q "RTN","PSODDPR5",40,0) .I $P(ON,";")="O",$G(^TMP("PSORXDD",$J,RXREC,0)) Q "RTN","PSODDPR5",41,0) .I '$G(ZHDR) D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT) W !,PSONULN,!,"*** THERAPEUTIC DUPLICATION(S) *** "_PSODRUG("NAME")_" with",! S ZHDR=1 "RTN","PSODDPR5",42,0) Q:'$G(ZHDR) Q:$G(PSODLQT) "RTN","PSODDPR5",43,0) N ST,STA,STAT,ORT K DOCPL "RTN","PSODDPR5",44,0) S (SUB,CT)=0 F S CT=$O(^TMP($J,LIST,"OUT","THERAPY",CT)) Q:'CT F S SUB=$O(^TMP($J,LIST,"OUT","THERAPY",CT,"DRUGS",SUB)) Q:'SUB D DUPCL K DDTH "RTN","PSODDPR5",45,0) D DUPCP "RTN","PSODDPR5",46,0) Q "RTN","PSODDPR5",47,0) DUPCL ; "RTN","PSODDPR5",48,0) S ON=$P(^TMP($J,LIST,"OUT","THERAPY",CT,"DRUGS",SUB),"^"),PDRG=$P(^(SUB),"^",3),RXREC=$P(ON,";",2) "RTN","PSODDPR5",49,0) I $P(ON,";")="Z" Q "RTN","PSODDPR5",50,0) I $P(ON,";")="N",$G(^TMP($J,"PSONVADD",RXREC,0)) Q "RTN","PSODDPR5",51,0) I $P(ON,";")="R",$G(^TMP($J,"PSORMDD",RXREC,0)) Q "RTN","PSODDPR5",52,0) I $P(ON,";")="O",$G(^TMP("PSORXDC",$J,RXREC,0)) Q "RTN","PSODDPR5",53,0) I $P(ON,";")="P",$G(^TMP("PSORXDC",$J,RXREC,0)) Q "RTN","PSODDPR5",54,0) I $P(ON,";")="O",$G(^TMP("PSORXDD",$J,RXREC,0)) Q "RTN","PSODDPR5",55,0) S ORT=$S($P(ON,";")="N":4,$P(ON,";")="P":3,$P(ON,";")="R":2,1:1) "RTN","PSODDPR5",56,0) S DOCPL(ORT,ON)="" "RTN","PSODDPR5",57,0) Q "RTN","PSODDPR5",58,0) DUPCP D HD^PSODDPR2():(($Y+5)'>IOSL) S ORT=0,ON="" F S ORT=$O(DOCPL(ORT)) Q:'ORT!$G(PSODLQT) F S ON=$O(DOCPL(ORT,ON)) Q:ON=""!$G(PSODLQT) D "RTN","PSODDPR5",59,0) .I $P(ON,";")="O" D "RTN","PSODDPR5",60,0) ..D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT) S ST=$P(^PSRX($P(ON,";",2),"STA"),"^")+1 "RTN","PSODDPR5",61,0) ..S STA="ACTIVE^NON-VERIFIED^REFILL^HOLD^NON-VERIFIED^SUSPENDED^^^^^^EXPIRED^DISCONTINUED^^DISCONTINUED BY PROVIDER^DISCONTINUE EDIT^PROVIDER HOLD" "RTN","PSODDPR5",62,0) ..S STAT=$P(STA,"^",ST) W !?2,"Local Rx #"_$P(^PSRX($P(ON,";",2),0),"^")_" ("_STAT_") for "_$P(^PSDRUG($P(^PSRX($P(ON,";",2),0),"^",6),0),"^") "RTN","PSODDPR5",63,0) .I $P(ON,";")="P" D "RTN","PSODDPR5",64,0) ..D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT) "RTN","PSODDPR5",65,0) ..S RXREC=$P(ON,";",2),DNM=$P(^PS(52.41,RXREC,0),"^",9) "RTN","PSODDPR5",66,0) ..S DUPRX0=^PS(52.41,RXREC,0) "RTN","PSODDPR5",67,0) ..W !?2,"Pending Order for " "RTN","PSODDPR5",68,0) ..I '$P(DUPRX0,"^",9) W $P(^PS(50.7,$P(DUPRX0,"^",8),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^") "RTN","PSODDPR5",69,0) ..E W $P(^PSDRUG($P(DUPRX0,"^",9),0),"^") "RTN","PSODDPR5",70,0) .I $P(ON,";")="R" N RXDAT D "RTN","PSODDPR5",71,0) ..D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT) "RTN","PSODDPR5",72,0) ..S RXDAT=^TMP($J,LIST,"OUT","REMOTE",$P(ON,";",2)) "RTN","PSODDPR5",73,0) ..S RDIRX=$P(RXDAT,"^",5) D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT) W !?2,"Remote Rx #"_RDIRX_" ("_$P(RXDAT,"^",4)_") for "_$P(RXDAT,"^",3) "RTN","PSODDPR5",74,0) .I $P(ON,";")="N" D "RTN","PSODDPR5",75,0) ..Q:'$D(^PS(55,PSODFN,"NVA",$P(ON,";",2),0)) "RTN","PSODDPR5",76,0) ..S DUPRX0=^PS(55,PSODFN,"NVA",$P(ON,";",2),0) N NVAQ "RTN","PSODDPR5",77,0) ..D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT) "RTN","PSODDPR5",78,0) ..W !?2,"Non-VA Med for " "RTN","PSODDPR5",79,0) ..I '$P(DUPRX0,"^",2) W $P(^PS(50.7,$P(DUPRX0,"^"),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^") "RTN","PSODDPR5",80,0) ..E W $P(^PSDRUG($P(DUPRX0,"^",2),0),"^") "RTN","PSODDPR5",81,0) .S DDTH(ON)=1 "RTN","PSODDPR5",82,0) D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT) "RTN","PSODDPR5",83,0) D CLASSES^PSODDPR3 "RTN","PSODDPR5",84,0) D HD^PSODDPR2(0,1) Q:$G(PSODLQT) "RTN","PSODDPR5",85,0) Q "RTN","PSODDPR5",86,0) REMOTE ;backdoor RDI "RTN","PSODDPR5",87,0) Q:$G(PSODLQT) "RTN","PSODDPR5",88,0) S PSORDI=0 F S PSORDI=$O(^TMP($J,LIST,"OUT","REMOTE",PSORDI)) Q:'PSORDI!$G(PSODLQT) S RDITMP=^(PSORDI) D K PSOSEQN "RTN","PSODDPR5",89,0) .I $P(RDITMP,"^",2)="" Q "RTN","PSODDPR5",90,0) .S RDIVUID=$P(RDITMP,"^",2),RDIDNAM=$P(RDITMP,"^",3) "RTN","PSODDPR5",91,0) .I $O(PDRG(0)) F ZI=0:0 S ZI=$O(PDRG(ZI)) Q:'ZI I $P(^PSDRUG($P(PDRG(ZI),"^"),0),"^")=RDIDNAM S INDD=+$G(INDD)+1,^TMP($J,"DD",INDD,0)=$P(PDRG(ZI),"^")_"^"_RDIDNAM_"^^"_PSORDI_"Z;O" "RTN","PSODDPR5",92,0) .S DO=$G(DO)+1 D GETIREF^XTID(50.68,.01,RDIVUID,"PSOSEQN",1) I 'PSOSEQN S ^TMP($J,LIST,"IN","PROFILE","R;"_PSORDI_";PROFILE;"_DO)=0_"^"_RDIVUID_"^0^"_RDIDNAM_"^^" Q "RTN","PSODDPR5",93,0) .S SEQN="" S SEQN=$O(PSOSEQN(50.68,.01,SEQN)) Q:SEQN="" "RTN","PSODDPR5",94,0) .S P3=+SEQN,SEQN=$P($$PROD0^PSNAPIS(,P3),"^",7) "RTN","PSODDPR5",95,0) .S ^TMP($J,LIST,"IN","PROFILE","R;"_PSORDI_";PROFILE;"_DO)=SEQN_"^"_RDIVUID_"^0^"_RDIDNAM_"^^" "RTN","PSODDPR5",96,0) Q "RTN","PSODDPR5",97,0) NSRT ;sort of drug interactions ; called by psoddpr2 "RTN","PSODDPR5",98,0) N SV,SEV,STOP,TYP,CNT,CHK,DRG,ON,CT,ZOT,PSOVAG,PSODD,COUNT,NSRT,NSRT2 S COUNT=0,(SV,DRG,ON,CT,PSOVAG)="" "RTN","PSODDPR5",99,0) F S SV=$O(^TMP($J,LIST,"OUT","DRUGDRUG",SV)) Q:SV=""!$G(PSODLQT) D Q:$G(PSORX("DFLG")) "RTN","PSODDPR5",100,0) .F S DRG=$O(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG)) Q:DRG=""!$G(PSODLQT) F S ON=$O(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG,ON)) Q:ON=""!$G(PSODLQT) F S CT=$O(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT)) Q:'CT!$G(PSODLQT) D "RTN","PSODDPR5",101,0) ..I $P(ON,";")'="Z",$P(ON,";")="O",$P(^PSRX($P(ON,";",2),"STA"),"^")>5,$P(^PSRX($P(ON,";",2),"STA"),"^")'=16 Q "RTN","PSODDPR5",102,0) ..I $P(ON,";")'="Z",$P(ON,";")="R" D RVAGEN Q "RTN","PSODDPR5",103,0) ..I $P(ON,";")'="Z",$P(ON,";")="P",'$P($G(^PS(52.41,$P(ON,";",2),0)),"^",9) S PSORDIT=$P($G(^PS(52.41,$P(ON,";",2),0)),"^",8) D:$G(PSORDIT) DVAGEN Q "RTN","PSODDPR5",104,0) ..I $P(ON,";")'="Z",$P(ON,";")="N",'$P($G(^PS(55,PSODFN,"NVA",$P(ON,";",2),0)),"^",2) S PSORDIT=$P($G(^PS(55,PSODFN,"NVA",$P(ON,";",2),0)),"^") D:$G(PSORDIT) DVAGEN Q "RTN","PSODDPR5",105,0) ..S PSODD=$O(^PSDRUG("B",DRG,0)) D:PSODD'="" VAGEN^PSODDPR3(PSODD) "RTN","PSODDPR5",106,0) ..S:PSOVAG="" PSOVAG=DRG "RTN","PSODDPR5",107,0) ..S ZOT=$S($P(ON,";")["C":1,$P(ON,";")="O":2,$P(ON,";")="R":3,$P(ON,";")="P":4,1:5) "RTN","PSODDPR5",108,0) ..S ZDGDG(SV,ZOT,PSOVAG,DRG)=ON_"^"_CT "RTN","PSODDPR5",109,0) ..I ZOT=1 S PSOCLNS(SV,PSOVAG,DRG,ON)=CT "RTN","PSODDPR5",110,0) ..I '$D(NSRT(SV,PSOVAG)) S NSRT(SV,PSOVAG)=ZOT "RTN","PSODDPR5",111,0) ..E S $P(NSRT(SV,PSOVAG),"^",1)=$P(NSRT(SV,PSOVAG),"^",1)_","_ZOT "RTN","PSODDPR5",112,0) ;resort of zdgdg "RTN","PSODDPR5",113,0) K ZZDGDG S (SEV,STOP,PSOVAG,TYP,ON)="",CNT=0 "RTN","PSODDPR5",114,0) F J=1:1:5 F S SEV=$O(NSRT(SEV)) Q:SEV="" F I=1:1:5 F S PSOVAG=$O(NSRT(SEV,PSOVAG)) Q:PSOVAG="" D "RTN","PSODDPR5",115,0) .S TYP="",TYP=","_$P(NSRT(SEV,PSOVAG),"^",1)_"," "RTN","PSODDPR5",116,0) .Q:TYP'[(","_J_",") "RTN","PSODDPR5",117,0) .S STOP=0 F CHK=1:1:5 I TYP[(","_CHK_",")&(CHK^("I"):1,1:0),$S($P($G(^PSDRUG(PSI,2)),"^",3)'["X":0,1:1) S PSID=$P($G(^PSDRUG(PSI,0)),"^") "RTN","PSODDPR5",156,0) I PSI="" S PSI=0 F S PSI=$O(^PSDRUG("ASP",PSORDIT,PSI)) Q:'PSI!($G(PSID)'="") 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 PSID=$P($G(^PSDRUG(PSI,0)),"^") "RTN","PSODDPR5",157,0) I PSI="" S PSI=0 F S PSI=$O(^PSDRUG("ASP",PSORDIT,PSI)) Q:'PSI!($G(PSID)'="") I $S('$D(^PSDRUG(PSI,"I")):1,'^("I"):1,DT'>^("I"):1,1:0),$S($P($G(^PSDRUG(PSI,2)),"^",3)'["U":0,1:1) S PSID=$P($G(^PSDRUG(PSI,0)),"^") "RTN","PSODDPR5",158,0) I PSI="" S PSI=0 F S PSI=$O(^PSDRUG("ASP",PSORDIT,PSI)) Q:'PSI!($G(PSID)'="") I $S('$D(^PSDRUG(PSI,"I")):1,'^("I"):1,DT'>^("I"):1,1:0),$S($P($G(^PSDRUG(PSI,2)),"^",3)'["I":0,1:1) S PSID=$P($G(^PSDRUG(PSI,0)),"^") "RTN","PSODDPR5",159,0) I PSI="" S PSI=0 F S PSI=$O(^PSDRUG("ASP",PSORDIT,PSI)) Q:'PSI!($G(PSID)'="") I $S('$D(^PSDRUG(PSI,"I")):1,'^("I"):1,DT'>^("I"):1,1:0),$S('$L($P($G(^PSDRUG(PSI,2)),"^",3)):0,1:1) S PSID=$P($G(^PSDRUG(PSI,0)),"^") "RTN","PSODDPR5",160,0) I PSI="" S PSI=0 F S PSI=$O(^PSDRUG("ASP",PSORDIT,PSI)) Q:'PSI!($G(PSID)'="") I $S('$D(^PSDRUG(PSI,"I")):1,'^("I"):1,DT'>^("I"):1,1:0),$S($L($P($G(^PSDRUG(PSI,2)),"^",3)):0,1:1) S PSID=$P($G(^PSDRUG(PSI,0)),"^") "RTN","PSODDPR5",161,0) Q:$G(PSID)']"" "RTN","PSODDPR5",162,0) S PSODD=$O(^PSDRUG("B",PSID,0)) D VAGEN^PSODDPR3(PSODD) "RTN","PSODDPR5",163,0) Q:$G(PSOVAG)']"" "RTN","PSODDPR5",164,0) S ZOT=$S($P(ON,";")="O":1,$P(ON,";")="R":2,$P(ON,";")="P":3,1:4),ZDGDG(SV,ZOT,PSOVAG,DRG)=ON_"^"_CT,COUNT=COUNT+1 "RTN","PSODDPR5",165,0) K PSI,PSID,PSORDIT,PSODD,PSOVAG "RTN","PSODDPR5",166,0) Q "RTN","PSODDPR5",167,0) ; "RTN","PSODDPR5",168,0) INT ; "RTN","PSODDPR5",169,0) I $G(PSOVORD),$P(PSOINTV,"^")=1 D Q "RTN","PSODDPR5",170,0) .K DIR,DTOUT,DIRUT,DIROUT,DUOUT "RTN","PSODDPR5",171,0) .W ! S DIR(0)="SA^1:YES;0:NO",DIR("A")="Do you want to Continue? ",DIR("B")="Y" D ^DIR S:($D(DTOUT))!($D(DUOUT))!($G(DIRUT)) PSODLQT=1,PSORX("DFLG")=1 Q:$G(PSODLQT) "RTN","PSODDPR5",172,0) .K DIR,DTOUT,DIRUT,DIROUT,DUOUT "RTN","PSODDPR5",173,0) .I 'Y S PSORX("DFLG")=1 Q "RTN","PSODDPR5",174,0) .S DA=PSONV,RXREC=DA,RX=$G(^PSRX(RXREC,0)),PSORX("INTERVENE")=1 "RTN","PSODDPR5",175,0) .D:'$D(PSODGCK) CRI^PSODGDG1 "RTN","PSODDPR5",176,0) .I $G(OLDDA) S DA=OLDDA K OLDDA "RTN","PSODDPR5",177,0) Q:$G(PSODLQT)!($G(PSORX("DFLG"))) "RTN","PSODDPR5",178,0) I '$D(PSODGCK),$P(PSOINTV,"^") S IT=$P(PSOINTV,"^"),ON=$P(PSOINTV,"^",2) D ^PSODGDGP K DIR S IT=$P(PSOINTV,"^") "RTN","PSODDPR5",179,0) Q "RTN","PSODDPR5",180,0) ; "RTN","PSODDPR5",181,0) DGCK ;CK - Drug check option at patient profile "RTN","PSODDPR5",182,0) I '$D(PSOSD) D FULL^VALM1 W !!,"Not enough drugs found in profile!",! K DIR S DIR("A")="Press Return to continue",DIR(0)="E",DIR("?")="Press Return to continue" D ^DIR K DIR G DGCKQ "RTN","PSODDPR5",183,0) S PSODGCK=1 "RTN","PSODDPR5",184,0) D FULL^VALM1 "RTN","PSODDPR5",185,0) D PSOCK^PSOUTL "RTN","PSODDPR5",186,0) K DIR S DIR(0)="E",DIR("A")="Press Return to Continue..." W ! D ^DIR K DIR W @IOF,! "RTN","PSODDPR5",187,0) D SELECT "RTN","PSODDPR5",188,0) I $G(PSONEW("DFLG"))=1!'$D(PSOSD) W ! G DGCKQ "RTN","PSODDPR5",189,0) D SET^PSODRG "RTN","PSODDPR5",190,0) DGCKNP D POST^PSODRG "RTN","PSODDPR5",191,0) DGCKQ S VALMBCK="R" "RTN","PSODDPR5",192,0) K PSODGCK,PSODGCKX,MON,PSONEW("DFLG"),PSORX("DFLG"),PSOIENID,PSOGCNPT,PSOGCNID,PSONDFID,DGCKDUPF "RTN","PSODDPR5",193,0) Q "RTN","PSODDPR5",194,0) ; "RTN","PSODDPR5",195,0) GCN(PSOIENID) ;Return 0 for not matched, 1 for matched with no GCNSEQNO, 1^1 for matched with a GCNSEQNO "RTN","PSODDPR5",196,0) N PSONDFID,PSOGCNPT,PSOGCNID "RTN","PSODDPR5",197,0) S PSONDFID=$P($G(^PSDRUG(PSOIENID,"ND")),"^"),PSOGCNPT=$P($G(^PSDRUG(PSOIENID,"ND")),"^",3) "RTN","PSODDPR5",198,0) I 'PSONDFID!('PSOGCNPT) Q 0 "RTN","PSODDPR5",199,0) S PSOGCNID=$$PROD0^PSNAPIS(PSONDFID,PSOGCNPT) "RTN","PSODDPR5",200,0) I $P(PSOGCNID,"^",7) Q PSOIENID_";"_PSONDFID_";"_$P(PSOGCNID,"^",7) "RTN","PSODDPR5",201,0) Q PSOIENID_";"_PSONDFID "RTN","PSODDPR5",202,0) ; "RTN","PSODDPR5",203,0) PKGFLG(PKF1) ;Return 0 for not in range of acceptable package flags, 1 for within range "RTN","PSODDPR5",204,0) I $S(PKF1["O":1,1:0) Q 1 "RTN","PSODDPR5",205,0) I $S(PKF1["X":1,1:0) Q 1 "RTN","PSODDPR5",206,0) Q 0 "RTN","PSODDPR5",207,0) ; "RTN","PSODDPR5",208,0) SELECT ; "RTN","PSODDPR5",209,0) N PSODGCKD S PSODGCKD=0 K:'$G(PSORXED) CLOZPAT "RTN","PSODDPR5",210,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","PSODDPR5",211,0) I $G(PSODRUG("IEN"))]"",'$D(PSODGCK) S Y=PSODRUG("NAME"),PSONEW("OLD VAL")=PSODRUG("IEN") "RTN","PSODDPR5",212,0) W !,"DRUG: " R X:$S($D(DTIME):DTIME,1:300) I '$T S DTOUT=1 "RTN","PSODDPR5",213,0) I PSODGCK,X="",PSOSD<2 W !!,"Not enough drugs found in profile!",! K DIR S DIR("A")="Press Return to continue",DIR(0)="E",DIR("?")="Press Return to continue" D ^DIR K DIR S PSONEW("DFLG")=1 G SELECTX "RTN","PSODDPR5",214,0) S:X="" PSODGCKX=1 "RTN","PSODDPR5",215,0) I X="",$G(Y)]"" S:Y X=Y S:'X X=$G(PSODRUG("IEN")) S:X X="`"_X "RTN","PSODDPR5",216,0) I X="",$D(PSOSD) S X=$O(PSOSD($O(PSOSD("")),"")),PSODGCKD=1 "RTN","PSODDPR5",217,0) I X="",'$D(PSOSD) D Q "RTN","PSODDPR5",218,0) .W !!,"Now Processing Enhanced Order Checks! Please wait..." H 1 "RTN","PSODDPR5",219,0) .W !!,"No Order Check Warnings Found",! K DIR S DIR("A")="Press Return to continue",DIR(0)="E",DIR("?")="Press Return to continue" D ^DIR K DIR "RTN","PSODDPR5",220,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","PSODDPR5",221,0) I $G(PSORXED),X["^" S PSORXED("DFLG")=1 G SELECTX "RTN","PSODDPR5",222,0) I X="^"!(X["^^")!($D(DTOUT)) S PSONEW("DFLG")=1 G SELECTX "RTN","PSODDPR5",223,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","PSODDPR5",224,0) S DIC=50,DIC(0)="MZV",D="B^C^VAPN^VAC" "RTN","PSODDPR5",225,0) I 'PSODGCKD S DIC=50,DIC(0)="EMQZVT",DIC("T")="",D="B^C^VAPN^VAC" "RTN","PSODDPR5",226,0) S DIC("S")="I $S('$D(^PSDRUG(+Y,""I"")):1,'^(""I""):1,DT'>^(""I""):1,1:0),$$GCN^PSODDPR5(+Y),$$PKGFLG^PSODDPR5($P($G(^PSDRUG(+Y,2)),""^"",3)),$D(^PSDRUG(""ASP"",+$G(^(2)),+Y))" "RTN","PSODDPR5",227,0) D MIX^DIC1 K DIC,PKF1,D "RTN","PSODDPR5",228,0) I $$PSOSUPCK^PSOUTL(+Y) G SELECT "RTN","PSODDPR5",229,0) S (DGCKSTA,DGCKDNM)="" "RTN","PSODDPR5",230,0) I '$D(PSODGCKX),$D(PSOSD) F S DGCKSTA=$O(PSOSD(DGCKSTA)) Q:DGCKSTA=""!$G(DGCKDUPF) F S DGCKDNM=$O(PSOSD(DGCKSTA,DGCKDNM)) Q:DGCKDNM=""!$G(DGCKDUPF) D "RTN","PSODDPR5",231,0) .I DGCKDNM=$G(Y(0,0)) D "RTN","PSODDPR5",232,0) ..S DGCKDUPF=1 W !!,"Duplicate Drug in Patient profile, please select a different drug:",! "RTN","PSODDPR5",233,0) ..K DIR S DIR(0)="E",DIR("A")="Press Return to Continue..." D ^DIR K DIR W @IOF "RTN","PSODDPR5",234,0) I $D(DGCKDUPF) K DGCKDUPF,PSODGCKX G SELECT "RTN","PSODDPR5",235,0) I '$D(PSOSD) D Q "RTN","PSODDPR5",236,0) .W !!,"Now Processing Enhanced Order Checks! Please wait..." H 1 "RTN","PSODDPR5",237,0) .W !!,"No Order Check Warnings Found",! K DIR S DIR("A")="Press Return to continue",DIR(0)="E",DIR("?")="Press Return to continue" D ^DIR K DIR "RTN","PSODDPR5",238,0) I $D(DTOUT) S PSONEW("DFLG")=1 G SELECTX "RTN","PSODDPR5",239,0) I $D(DUOUT) K DUOUT G SELECT "RTN","PSODDPR5",240,0) I Y<0 G SELECT "RTN","PSODDPR5",241,0) S:$G(PSONEW("OLD VAL"))=+Y&('$G(PSOEDIT)) PSODRG("QFLG")=1 "RTN","PSODDPR5",242,0) K PSOY S PSOY=Y,PSOY(0)=Y(0) "RTN","PSODDPR5",243,0) I $P(PSOY(0),"^")="OTHER DRUG"!($P(PSOY(0),"^")="OUTSIDE DRUG") D TRADE^PSODRG "RTN","PSODDPR5",244,0) SELECTX K X,Y,DTOUT,DUOUT,PSONEW("OLD VAL"),PSODGCKD,DGCKDNM,DGCKSTA "RTN","PSODDPR5",245,0) Q "RTN","PSODDPR5",246,0) ; "RTN","PSODDPR7") 0^13^B68911471^n/a "RTN","PSODDPR7",1,0) PSODDPR7 ; BIR/OG ; Enhanced order checks - IMO Utilities ;12/6/11 "RTN","PSODDPR7",2,0) ;;7.0;OUTPATIENT PHARMACY;**390**;DEC 1997;Build 86 "RTN","PSODDPR7",3,0) ;External reference to IN^PSJBLDOC supported by DBIA 5306 "RTN","PSODDPR7",4,0) ; "RTN","PSODDPR7",5,0) ; Required to be present: "RTN","PSODDPR7",6,0) ; DFN: patient internal entry number "RTN","PSODDPR7",7,0) ; DRG - dispensed drug name "RTN","PSODDPR7",8,0) ; SV - Severity "RTN","PSODDPR7",9,0) ; ZVA - VA Generic Name "RTN","PSODDPR7",10,0) ; ON: Order identifier = first ";" piece: I1 - IV order. I2 - UD order; second ";" piece: order id; example: ON="C2;4;PROFILE;5" "RTN","PSODDPR7",11,0) ; "RTN","PSODDPR7",12,0) Q:$E($P(ON,";"))'["C" "RTN","PSODDPR7",13,0) N DRGNAME,STATUS,STARTDT,STOPDT,SCHEDULE,ORDID,DOSAGE,FILENODE,ADD,SOL,ADDNAM,SOLNAM,BOTTLE,STRENGTH,AFLG,ADDS,SOLUTION,VOLUME,IVDATA,SORT,INFUSE,SFLG,PSOCON,PSOCLINI,SORT2,PSOCLIN "RTN","PSODDPR7",14,0) N PSOCDRG,DRGDRG,STARTDTF,STOPDTF,ORDDATE "RTN","PSODDPR7",15,0) S SORT="PSOPEPS CLINIC" "RTN","PSODDPR7",16,0) S (PSOCDRG,PSOCON,STATUS)="" "RTN","PSODDPR7",17,0) Q:'$D(PSOCLNS(SV,ZVA)) "RTN","PSODDPR7",18,0) ;sort by status within drug name "RTN","PSODDPR7",19,0) F S PSOCDRG=$O(PSOCLNS(SV,ZVA,PSOCDRG)) Q:PSOCDRG="" I DRG=PSOCDRG F S PSOCON=$O(PSOCLNS(SV,ZVA,PSOCDRG,PSOCON)) Q:PSOCON="" D "RTN","PSODDPR7",20,0) .S (ORDID,PSOCLINI,FILENODE)="",DRGDRG=1,ORDID=$P(PSOCON,";",2),PSOCLINI=$P(^TMP($J,"PSOPEPS","IN","PROFILE",PSOCON),"^",7),FILENODE=$P(PSOCLINI,";") "RTN","PSODDPR7",21,0) .I FILENODE=1 D PSS436^PSS55(PSODFN,ORDID,SORT) S:$D(^TMP($J,SORT,ORDID,100)) STATUS=$P(^TMP($J,SORT,ORDID,100),"^",2) "RTN","PSODDPR7",22,0) .I FILENODE=2 D PSS431^PSS55(PSODFN,ORDID,"","",SORT) S:$D(^TMP($J,SORT,ORDID,28)) STATUS=$P(^TMP($J,SORT,ORDID,28),"^",2) "RTN","PSODDPR7",23,0) .I FILENODE=3!(FILENODE=4)!(FILENODE=5) D PSJ^PSJ53P1(ORDID,SORT) S:$D(^TMP($J,SORT,ORDID,28)) STATUS=$P(^TMP($J,SORT,ORDID,28),"^",2) "RTN","PSODDPR7",24,0) .I STATUS="" S STATUS="Z" "RTN","PSODDPR7",25,0) .S PSOCLIN(SV,ZVA,$S(STATUS["ACTIVE":1,STATUS["NON-VERIFIED":2,STATUS["DISCONTINUED":3,STATUS["EXPIRE":4,1:5),PSOCON)=PSOCDRG "RTN","PSODDPR7",26,0) Q:'$D(PSOCLIN(SV,ZVA)) "RTN","PSODDPR7",27,0) S (SORT2,ORDID,PSOCLINI,FILENODE,PSOCON)="" "RTN","PSODDPR7",28,0) K ^TMP($J,SORT) "RTN","PSODDPR7",29,0) F S SORT2=$O(PSOCLIN(SV,ZVA,SORT2)) Q:SORT2="" F S PSOCON=$O(PSOCLIN(SV,ZVA,SORT2,PSOCON)) Q:PSOCON="" D CLINIC "RTN","PSODDPR7",30,0) Q "RTN","PSODDPR7",31,0) DUP ; "RTN","PSODDPR7",32,0) ;Required: ZCT = Order identifier = first ";" piece: I1 - IV order. I2 - UD order; second ";" piece: order id; example: ON="C2;4;PROFILE;5" "RTN","PSODDPR7",33,0) Q:ZCT="" "RTN","PSODDPR7",34,0) N DRGNAME,STATUS,STARTDT,STOPDT,SCHEDULE,ORDID,DOSAGE,FILENODE,ADD,SOL,ADDNAM,SOLNAM,BOTTLE,STRENGTH,AFLG,ADDS,SOLUTION,VOLUME,IVDATA,SORT,INFUSE,SFLG,PSOCON "RTN","PSODDPR7",35,0) N PSOCLINI,SORT2,PSOCLIN,DRGDRG,STARTDTF,STOPDTF,ORDDATE "RTN","PSODDPR7",36,0) S SORT="PSOPEPS CLINIC",DRGDRG=0 "RTN","PSODDPR7",37,0) S PSOCON=$P(ZCT,"^",3),DRGNAME=$P(ZCT,"^",2) D CLINIC "RTN","PSODDPR7",38,0) Q "RTN","PSODDPR7",39,0) ; "RTN","PSODDPR7",40,0) CLINIC ; "RTN","PSODDPR7",41,0) K ^TMP($J,SORT) "RTN","PSODDPR7",42,0) S (ORDID,PSOCLINI,FILENODE)="",ORDID=$P(PSOCON,";",2),PSOCLINI=$P(^TMP($J,"PSOPEPS","IN","PROFILE",PSOCON),"^",7) "RTN","PSODDPR7",43,0) Q:'PSOCLINI "RTN","PSODDPR7",44,0) S FILENODE=$P(PSOCLINI,";") I DRGDRG S DRGNAME=PSOCLIN(SV,ZVA,SORT2,PSOCON) I DRGNAME'="" S DRGDRG=0 "RTN","PSODDPR7",45,0) S (STATUS,SCHEDULE,DOSAGE,STARTDT,STOPDT,INFUSE,STARTDTF,STOPDTF,ORDDATE)="" "RTN","PSODDPR7",46,0) D GETDATA "RTN","PSODDPR7",47,0) K ^TMP($J,SORT) "RTN","PSODDPR7",48,0) W ! "RTN","PSODDPR7",49,0) Q "RTN","PSODDPR7",50,0) GETDATA ; "RTN","PSODDPR7",51,0) I FILENODE=1 D PSS436^PSS55(PSODFN,ORDID,SORT) D Q ;IV for file 55 "RTN","PSODDPR7",52,0) .I DRGDRG S DRGNAME=$P(^TMP($J,"PSOPEPS","IN","PROFILE",PSOCON),"^",4) "RTN","PSODDPR7",53,0) .I $D(^TMP($J,SORT,ORDID,100)) S STATUS=$P(^TMP($J,SORT,ORDID,100),"^",2) "RTN","PSODDPR7",54,0) .I $D(^TMP($J,SORT,ORDID,.09)) S SCHEDULE=^TMP($J,SORT,ORDID,.09) "RTN","PSODDPR7",55,0) .I $D(^TMP($J,SORT,ORDID,109)) S DOSAGE=^TMP($J,SORT,6,109) "RTN","PSODDPR7",56,0) .I $D(^TMP($J,SORT,ORDID,.02)) S STARTDT=$P(^TMP($J,SORT,ORDID,.02),"^",2) "RTN","PSODDPR7",57,0) .I STARTDT="" S:$D(^TMP($J,SORT,ORDID,115)) STARTDT=$D(^TMP($J,SORT,ORDID,115)) S:STARTDT'="" STARTDTF=1 "RTN","PSODDPR7",58,0) .I $D(^TMP($J,SORT,ORDID,.03)) S STOPDT=$P(^TMP($J,SORT,ORDID,.03),"^",2) "RTN","PSODDPR7",59,0) .S:$D(^TMP($J,SORT,ORDID,27)) ORDDATE=^TMP($J,SORT,ORDID,27) "RTN","PSODDPR7",60,0) .I STOPDT="" S:$D(^TMP($J,SORT,ORDID,117)) STARTDT=$D(^TMP($J,SORT,ORDID,117)) S:STOPDT'="" STOPDTF=1 "RTN","PSODDPR7",61,0) .I $D(^TMP($J,SORT,ORDID,.08)) S INFUSE=^TMP($J,SORT,ORDID,.08) "RTN","PSODDPR7",62,0) .D WRITE "RTN","PSODDPR7",63,0) ; "RTN","PSODDPR7",64,0) I FILENODE=2 D PSS431^PSS55(PSODFN,ORDID,"","",SORT) D Q ;Unit dose for file 55 "RTN","PSODDPR7",65,0) .I DRGDRG S DRGNAME=$P(^TMP($J,"PSOPEPS","IN","PROFILE",PSOCON),"^",4) "RTN","PSODDPR7",66,0) .I $D(^TMP($J,SORT,ORDID,28)) S STATUS=$P(^TMP($J,SORT,ORDID,28),"^",2) "RTN","PSODDPR7",67,0) .I $D(^TMP($J,SORT,ORDID,26)) S SCHEDULE=^TMP($J,SORT,ORDID,26) "RTN","PSODDPR7",68,0) .I $D(^TMP($J,SORT,ORDID,109)) S DOSAGE=^TMP($J,SORT,ORDID,109) "RTN","PSODDPR7",69,0) .I $D(^TMP($J,SORT,ORDID,10)) S STARTDT=$P(^TMP($J,SORT,ORDID,10),"^",2) "RTN","PSODDPR7",70,0) .I $D(^TMP($J,SORT,ORDID,34)) S STOPDT=$P(^TMP($J,SORT,ORDID,34),"^",2) "RTN","PSODDPR7",71,0) .I $D(^TMP($J,SORT,ORDID,.08)) S INFUSE=^TMP($J,SORT,ORDID,.08) "RTN","PSODDPR7",72,0) .D WRITE "RTN","PSODDPR7",73,0) ; "RTN","PSODDPR7",74,0) I FILENODE=3!(FILENODE=4)!(FILENODE=5) D Q ;unit dose for file 53.1 "RTN","PSODDPR7",75,0) .D PSJ^PSJ53P1(ORDID,SORT) "RTN","PSODDPR7",76,0) .I DRGDRG,$D(^TMP($J,SORT,ORDID,108)) S DRGNAME=$P(^TMP($J,SORT,ORDID,108),"^",2) "RTN","PSODDPR7",77,0) .I $D(^TMP($J,SORT,ORDID,28)) S STATUS=$P(^TMP($J,SORT,ORDID,28),"^",2) "RTN","PSODDPR7",78,0) .I $D(^TMP($J,SORT,ORDID,26)) S SCHEDULE=$P(^TMP($J,SORT,ORDID,26),"^",2) "RTN","PSODDPR7",79,0) .I $D(^TMP($J,SORT,ORDID,27)) S ORDDATE=^TMP($J,SORT,ORDID,27) S Y=ORDDATE D DD^%DT S ORDDATE=Y "RTN","PSODDPR7",80,0) .I $D(^TMP($J,SORT,ORDID,109)) S DOSAGE=^TMP($J,SORT,ORDID,109) "RTN","PSODDPR7",81,0) .I $D(^TMP($J,SORT,ORDID,10)) S STARTDT=$P(^TMP($J,SORT,ORDID,10),"^",2) "RTN","PSODDPR7",82,0) .I STARTDT="",$D(^TMP($J,SORT,ORDID,115)) S STARTDT=$P(^TMP($J,SORT,ORDID,115),"^",2) S:STARTDT'="" STARTDTF=1 "RTN","PSODDPR7",83,0) .I $D(^TMP($J,SORT,ORDID,25)) S STOPDT=$P(^TMP($J,SORT,ORDID,25),"^",2) "RTN","PSODDPR7",84,0) .I $D(^TMP($J,SORT,ORDID,117))&(STOPDT="") S STOPDT=$P(^TMP($J,SORT,ORDID,117),"^",2) S:STOPDT'="" STOPDTF=1 "RTN","PSODDPR7",85,0) .I $D(^TMP($J,SORT,ORDID,116)) S DURATION=^TMP($J,SORT,ORDID,116) "RTN","PSODDPR7",86,0) .D WRITE "RTN","PSODDPR7",87,0) Q "RTN","PSODDPR7",88,0) ; "RTN","PSODDPR7",89,0) WRITE ; "RTN","PSODDPR7",90,0) D HD^PSODDPR2() Q:$G(PSODLQT) "RTN","PSODDPR7",91,0) S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J("Clinic Order: ",23)_DRGNAME_" ("_STATUS_")" "RTN","PSODDPR7",92,0) I $D(^TMP($J,SORT,ORDID,"ADD")) D:FILENODE=1 IV55 D:FILENODE=3 IV531 "RTN","PSODDPR7",93,0) I SCHEDULE'="" S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J("Schedule: ",23),SCHEDULE "RTN","PSODDPR7",94,0) I DOSAGE'="" S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J("Dosage: ",23),DOSAGE "RTN","PSODDPR7",95,0) I STARTDT=""&(ORDDATE'="") S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J("Order Date: ",23),ORDDATE "RTN","PSODDPR7",96,0) I STARTDT'="" S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J($S($G(STARTDTF):"Requested Start Date: ",1:"Start Date: "),23),STARTDT "RTN","PSODDPR7",97,0) E S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J("Start Date: ",23),"********" "RTN","PSODDPR7",98,0) I STOPDT'="" S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J($S($G(STOPDTF):"Requested Stop Date: ",1:"Stop Date: "),23),STOPDT "RTN","PSODDPR7",99,0) E S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J("Stop Date: ",23),"********" "RTN","PSODDPR7",100,0) WRITE2 ; "RTN","PSODDPR7",101,0) I '$G(PSODUPF) D HD^PSODDPR2():(($Y+5)>IOSL) "RTN","PSODDPR7",102,0) Q "RTN","PSODDPR7",103,0) ; "RTN","PSODDPR7",104,0) IMO(DFN) ;Inpatient Meds ordered in outpatient pharmacy (IMO) - determine IMO drugs to be added to the profile drugs submitted to FDB. "RTN","PSODDPR7",105,0) ; In: DFN - Patient IED "RTN","PSODDPR7",106,0) ; Output: ^TMP( file of inpatient meds drugs; example of each type of order: "RTN","PSODDPR7",107,0) ; ^TMP(540771229,"PSOPEPS","IN","PROFILE","C2;6;PROFILE;6")="16579^4010153^65^SIMVASTATIN 40MG TAB^10711^I" "RTN","PSODDPR7",108,0) ; ^TMP(540771229,"PSOPEPS","IN","PROFILE","C4;1597;PROFILE;7")="11664^4006819^1848^CIMETIDINE 300MG/5ML SOL (OZ)^10746^I" "RTN","PSODDPR7",109,0) ; "RTN","PSODDPR7",110,0) ; The first piece of the 5th subscript denotes the type of order (ex: C2 and C4 in the example above). "RTN","PSODDPR7",111,0) ; When adding clinic orders, this piece is always "C" concatenated with an number 1-4 where 1 means UD file 55, 2 means IV file 55, 3 means UD file 53.1 or 4 means IV for file 53.1. "RTN","PSODDPR7",112,0) ; For clinic orders, the 2nd piece of the 5th subscript is the subfile IEN. "RTN","PSODDPR7",113,0) ; "RTN","PSODDPR7",114,0) D IN^PSJBLDOC(DFN,LIST,.PDRG,"O;") "RTN","PSODDPR7",115,0) Q "RTN","PSODDPR7",116,0) ; "RTN","PSODDPR7",117,0) IV55 ; "RTN","PSODDPR7",118,0) I '$G(PSODUPF) D HD^PSODDPR2() Q:$G(PSODLQT) "RTN","PSODDPR7",119,0) S (ADD,SOL,AFLG)=0 "RTN","PSODDPR7",120,0) ;W:'$G(AFLG) !,$J("Other Additives: ",23) "RTN","PSODDPR7",121,0) F S ADD=$O(^TMP($J,SORT,ORDID,"ADD",ADD)) Q:ADD="" D "RTN","PSODDPR7",122,0) .I $D(^TMP($J,SORT,ORDID,"ADD",ADD,.01)) S ADDNAM=$P(^TMP($J,SORT,ORDID,"ADD",ADD,.01),"^",2) "RTN","PSODDPR7",123,0) .Q:DRGNAME[(ADDNAM_" "_^TMP($J,SORT,ORDID,"ADD",ADD,.02)) "RTN","PSODDPR7",124,0) .S (BOTTLE,STRENGTH)="" "RTN","PSODDPR7",125,0) .I $D(^TMP($J,SORT,ORDID,"ADD",ADD,.03)) S BOTTLE=^TMP($J,SORT,ORDID,"ADD",ADD,.03) "RTN","PSODDPR7",126,0) .I $D(^TMP($J,SORT,ORDID,"ADD",ADD,.02)) S STRENGTH=^TMP($J,SORT,ORDID,"ADD",ADD,.02) "RTN","PSODDPR7",127,0) .I '$G(AFLG) S ADDS=ADDNAM_" "_STRENGTH S:BOTTLE'="" ADDS=ADDS_" ("_BOTTLE_")" "RTN","PSODDPR7",128,0) .I $G(AFLG) S ADDS=ADDS_", "_ADDNAM_" "_STRENGTH S:BOTTLE'="" ADDS=ADDS_" ("_BOTTLE_")" "RTN","PSODDPR7",129,0) .S:'$G(AFLG) AFLG=1 "RTN","PSODDPR7",130,0) S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 "RTN","PSODDPR7",131,0) I '$G(PSODUPF) D HD^PSODDPR2() Q:$G(PSODLQT) "RTN","PSODDPR7",132,0) I $G(AFLG),'$G(PSODUPF) W !,$J("Other Additives: ",23) D MYWRITE(ADDS,23,78) "RTN","PSODDPR7",133,0) F S SOL=$O(^TMP($J,SORT,ORDID,"SOL",SOL)) Q:SOL="" D "RTN","PSODDPR7",134,0) .S (SOLUTION,VOLUME)="" "RTN","PSODDPR7",135,0) .I $D(^TMP($J,SORT,ORDID,"SOL",SOL,.01)) S SOLUTION=$P(^TMP($J,SORT,ORDID,"SOL",SOL,.01),"^",2) "RTN","PSODDPR7",136,0) .I $D(^TMP($J,SORT,ORDID,"SOL",SOL,1)) S VOLUME=^TMP($J,SORT,ORDID,"SOL",SOL,1) "RTN","PSODDPR7",137,0) .I '$G(PSODUPF) D HD^PSODDPR2() Q:$G(PSODLQT) "RTN","PSODDPR7",138,0) .W:'$G(SFLG)&'$G(PSODUPF) !,$J("Solution(s): ",23)_SOLUTION_" "_VOLUME_" "_INFUSE "RTN","PSODDPR7",139,0) .S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 "RTN","PSODDPR7",140,0) .I $G(SFLG),'$G(PSODUPF) W !?23,SOLUTION_" "_VOLUME_" "_INFUSE "RTN","PSODDPR7",141,0) .S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 "RTN","PSODDPR7",142,0) .S SFLG=1 "RTN","PSODDPR7",143,0) Q "RTN","PSODDPR7",144,0) ; "RTN","PSODDPR7",145,0) IV531 ; "RTN","PSODDPR7",146,0) I '$G(PSODUPF) D HD^PSODDPR2() Q:$G(PSODLQT) "RTN","PSODDPR7",147,0) S (ADD,SOL,AFLG,SFLG)=0 "RTN","PSODDPR7",148,0) F S ADD=$O(^TMP($J,SORT,ORDID,"ADD",ADD)) Q:ADD="" D "RTN","PSODDPR7",149,0) .S (BOTTLE,STRENGTH,IVDATA)="",IVDATA=^TMP($J,SORT,ORDID,"ADD",ADD) "RTN","PSODDPR7",150,0) .S BOTTLE=$P(IVDATA,"^",3),STRENGTH=$P(IVDATA,"^",2),ADDNAM=$P(IVDATA,"^") "RTN","PSODDPR7",151,0) .I $D(^TMP($J,SORT,ORDID,"ADD",ADD+1)) Q:DRGNAME[(ADDNAM_" "_STRENGTH) "RTN","PSODDPR7",152,0) .I '$G(AFLG) S ADDS=ADDNAM_" "_STRENGTH S:BOTTLE'="" ADDS=ADDS_" ("_BOTTLE_")" "RTN","PSODDPR7",153,0) .I $G(AFLG) S ADDS=ADDS_", "_ADDNAM_" "_STRENGTH S:BOTTLE'="" ADDS=ADDS_" ("_BOTTLE_")" "RTN","PSODDPR7",154,0) .S:'$G(AFLG) AFLG=1 "RTN","PSODDPR7",155,0) S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 "RTN","PSODDPR7",156,0) I '$G(PSODUPF) D HD^PSODDPR2() Q:$G(PSODLQT) "RTN","PSODDPR7",157,0) I $G(AFLG),'$G(PSODUPF) W !,$J("Other Additives: ",23) D MYWRITE(ADDS,23,78) "RTN","PSODDPR7",158,0) F S SOL=$O(^TMP($J,SORT,ORDID,"SOL",SOL)) Q:SOL="" D "RTN","PSODDPR7",159,0) .S (SOLUTION,VOLUME)="" "RTN","PSODDPR7",160,0) .S (SOLUTION,VOLUME,IVDATA)="",IVDATA=^TMP($J,SORT,ORDID,"SOL",SOL) "RTN","PSODDPR7",161,0) .S VOLUME=$P(IVDATA,"^",2),SOLUTION=$P(IVDATA,"^") "RTN","PSODDPR7",162,0) .S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 "RTN","PSODDPR7",163,0) .W:'$G(SFLG)&'$G(PSODUPF) !,$J("Solution(s): ",23)_SOLUTION_" "_VOLUME_" "_INFUSE "RTN","PSODDPR7",164,0) .I $G(SFLG),'$G(PSODUPF) W !?23,SOLUTION_" "_VOLUME_" "_INFUSE "RTN","PSODDPR7",165,0) .S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 "RTN","PSODDPR7",166,0) .S SFLG=1 "RTN","PSODDPR7",167,0) I '$G(PSODUPF) D HD^PSODDPR2() Q:$G(PSODLQT) "RTN","PSODDPR7",168,0) Q "RTN","PSODDPR7",169,0) ; "RTN","PSODDPR7",170,0) MYWRITE(X,DIWL,DIWR) ;Continue writing on the same line "RTN","PSODDPR7",171,0) NEW DN,PSOCNT "RTN","PSODDPR7",172,0) I '$G(DIWL) S DIWL=1 "RTN","PSODDPR7",173,0) I '$G(DIWR) S DIWR=75 "RTN","PSODDPR7",174,0) K ^UTILITY($J,"W") D ^DIWP "RTN","PSODDPR7",175,0) F PSOCNT=0:0 S PSOCNT=$O(^UTILITY($J,"W",DIWL,PSOCNT)) Q:'PSOCNT W:PSOCNT'=1 ! W ?DIWL,^UTILITY($J,"W",DIWL,PSOCNT,0) "RTN","PSODDPR7",176,0) Q "RTN","PSODDPR8") 0^20^B30129604^n/a "RTN","PSODDPR8",1,0) PSODDPR8 ;BIR/SAB - display enhanced order checks ;11 May 2010 9:06 AM "RTN","PSODDPR8",2,0) ;;7.0;OUTPATIENT PHARMACY;**390**;DEC 1997;Build 86 "RTN","PSODDPR8",3,0) ;External reference to ^PS(50.7 supported by DBIA 2223 "RTN","PSODDPR8",4,0) ;External reference to ^PS(50.606 supported by DBIA 2174 "RTN","PSODDPR8",5,0) ;External reference to ^PSDRUG( supported by DBIA 221 "RTN","PSODDPR8",6,0) DUP ;display drug interaction, clinical effects, and call to display monograph "RTN","PSODDPR8",7,0) Q:$G(PSODLQT) "RTN","PSODDPR8",8,0) S ZZDGDGC=ZZDGDGC+1,ON=$P(ZZDGDG(SV,ZST,ZORS,ZVA,DRG),"^"),CT=$P(ZZDGDG(SV,ZST,ZORS,ZVA,DRG),"^",2),SEV=$G(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT,"SEV")) K ISTX "RTN","PSODDPR8",9,0) S IT=$S(SEV="Critical":1,SEV="Significant":2,1:0),PDRG=$P(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT),"^",4),DRGI=$P(^(CT),"^",2) "RTN","PSODDPR8",10,0) D HD() Q:$G(PSODLQT) "RTN","PSODDPR8",11,0) I $G(ZHDR) W @IOF,PSONULN,!,"***"_SEV_"*** Drug Interaction with Prospective Drug:",!?20,PDRG_" and",! S ZHDR=0 "RTN","PSODDPR8",12,0) E W ! "RTN","PSODDPR8",13,0) I $P(ON,";")["C" D ^PSODDPR7 "RTN","PSODDPR8",14,0) I $P(ON,";")="N" D ^PSODDPR3 D HD():(($Y+5)>IOSL) Q:$G(PSODLQT) "RTN","PSODDPR8",15,0) I $P(ON,";")="P" D PEND D HD():(($Y+5)>IOSL) Q:$G(PSODLQT) "RTN","PSODDPR8",16,0) I $P(ON,";")="O" D DDRX D HD():(($Y+5)>IOSL) Q:$G(PSODLQT) "RTN","PSODDPR8",17,0) I $P(ON,";")="Z" D DDRX1 D HD():(($Y+5)>IOSL) Q:$G(PSODLQT) "RTN","PSODDPR8",18,0) I $P(ON,";")="R" D RDI^PSODDPR3 D HD():(($Y+5)>IOSL) Q:$G(PSODLQT) "RTN","PSODDPR8",19,0) I '+$G(PSOINTV),IT=2 S PSOINTV=2_"^"_ON "RTN","PSODDPR8",20,0) I IT=1 S PSOINTV=1_"^"_ON "RTN","PSODDPR8",21,0) D HD():(($Y+5)>IOSL) Q:$G(PSODLQT) I COUNT=ZZDGDG2(SV,ZVA) S COUNT=0 W ! D CL D HD():(($Y+5)'>IOSL) "RTN","PSODDPR8",22,0) Q "RTN","PSODDPR8",23,0) ; "RTN","PSODDPR8",24,0) PEND N DUPRX0,RFLS,ISSD,DNM,RXREC,Y "RTN","PSODDPR8",25,0) D HD() Q:$G(PSODLQT) S RXREC=$P(ON,";",2),DNM=$P(^PS(52.41,RXREC,0),"^",9) "RTN","PSODDPR8",26,0) S DUPRX0=^PS(52.41,RXREC,0),RFLS=$P(DUPRX0,"^",11),ISSD=$P(DUPRX0,"^",6) "RTN","PSODDPR8",27,0) I '$P(DUPRX0,"^",9) D HD() Q:$G(PSODLQT) S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J("Pending Order: ",20)_$P(^PS(50.7,$P(DUPRX0,"^",8),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^") "RTN","PSODDPR8",28,0) E S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J("Pending Drug: ",20)_$S($P(DUPRX0,"^",9):$P(^PSDRUG($P(DUPRX0,"^",9),0),"^"),1:"No Dispense Drug Selected") "RTN","PSODDPR8",29,0) D FSIG^PSOUTLA("P",RXREC,50) "RTN","PSODDPR8",30,0) S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J("SIG: ",20) F I=0:0 S I=$O(FSIG(I)) Q:'I W:'$G(PSODUPF) FSIG(I) I $O(FSIG(I)) S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J(" ",20) "RTN","PSODDPR8",31,0) Q "RTN","PSODDPR8",32,0) ; "RTN","PSODDPR8",33,0) DDRX ; "RTN","PSODDPR8",34,0) S RXREC=$P(ON,";",2),DUPRX0=^PSRX(RXREC,0),RFLS=$P(DUPRX0,"^",9),ISSD=$P(^PSRX(RXREC,0),"^",13),RX0=DUPRX0,RX2=^PSRX(RXREC,2),($P(RX0,"^",15),STATUS)=+$G(^PSRX(RXREC,"STA")) "RTN","PSODDPR8",35,0) S J=RXREC D STAT^PSOFUNC K RX0,RX2,LSTFD S RXRECLOC=$G(RXREC),DRGNM=$P(^PSDRUG($P(DUPRX0,"^",6),0),"^") "RTN","PSODDPR8",36,0) D HD() Q:$G(PSODLQT) S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J("Local RX#: ",20)_$P(DUPRX0,"^"),!,$J("Drug: ",20)_DRGNM_" ("_ST_")" "RTN","PSODDPR8",37,0) K FSIG,BSIG I $P($G(^PSRX(RXREC,"SIG")),"^",2) D FSIG^PSOUTLA("R",RXREC,50) F PSREV=1:1 Q:'$D(FSIG(PSREV)) S BSIG(PSREV)=FSIG(PSREV) "RTN","PSODDPR8",38,0) K FSIG,PSREV I '$P($G(^PSRX(RXREC,"SIG")),"^",2) D EN2^PSOUTLA1(RXREC,50) "RTN","PSODDPR8",39,0) D HD() Q:$G(PSODLQT) S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J("SIG: ",20),$G(BSIG(1)) "RTN","PSODDPR8",40,0) I $O(BSIG(1)) F PSREV=1:0 S PSREV=$O(BSIG(PSREV)) Q:'PSREV S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J(" ",20)_$G(BSIG(PSREV)) "RTN","PSODDPR8",41,0) K BSIG,PSREV "RTN","PSODDPR8",42,0) I $G(QTHER) D HD() Q:$G(PSODLQT) S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J("QTY: ",20)_$P(DUPRX0,"^",7),?44,$J("Days Supply: ",20)_$P(DUPRX0,"^",8) "RTN","PSODDPR8",43,0) D PRSTAT^PSODDPRE(RXREC) S LSTFD=+^PSRX(RXREC,3) S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J("Last Filled On: ",20)_$E(LSTFD,4,5)_"/"_$E(LSTFD,6,7)_"/"_$E(LSTFD,2,3) "RTN","PSODDPR8",44,0) Q "RTN","PSODDPR8",45,0) ; "RTN","PSODDPR8",46,0) DDRX1 ; "RTN","PSODDPR8",47,0) W:SV="C" !,$J("Drug: ",21)_$S($D(PSSDIUTL):PDRG,1:DRG) "RTN","PSODDPR8",48,0) W:SV="S" !,$J("Drug: ",24)_$S($D(PSSDIUTL):PDRG,1:DRG) "RTN","PSODDPR8",49,0) Q "RTN","PSODDPR8",50,0) ; "RTN","PSODDPR8",51,0) CL Q:$G(PSODLQT) N CLI,LT,STX,I,BSIG S ZHDR=1 "RTN","PSODDPR8",52,0) D HD():(($Y+5)>IOSL) Q:$G(PSODLQT) "RTN","PSODDPR8",53,0) I IT=2 W !?2,"*** Refer to MONOGRAPH for SIGNIFICANT INTERACTION CLINICAL EFFECTS",! "RTN","PSODDPR8",54,0) I IT=1 W ! D "RTN","PSODDPR8",55,0) .S CLI=$P($G(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT,"CLIN")),"CLINICAL EFFECTS: ",2) "RTN","PSODDPR8",56,0) .S LT=75,STX=CLI D FT Q:$G(PSODLQT) F I=0:0 S I=$O(BSIG(I)) Q:'I W ?2,BSIG(I),! D HD():(($Y+5)>IOSL) Q:$G(PSODLQT) ;;HD must be called during clinical effects so that nothing rolls off the screen; DON'T REMOVE "RTN","PSODDPR8",57,0) D HD():(($Y+5)>IOSL) Q:$G(PSODLQT) ;HD must be called after incase text rolls off the screen. ; DON'T REMOVE "RTN","PSODDPR8",58,0) I $O(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT,"PMON",0)) D MON^PSODDPR3 K X,Y "RTN","PSODDPR8",59,0) D HD():(($Y+5)>IOSL) "RTN","PSODDPR8",60,0) Q "RTN","PSODDPR8",61,0) ; "RTN","PSODDPR8",62,0) FT ;format text "RTN","PSODDPR8",63,0) D HD():(($Y+5)>IOSL) Q:$G(PSODLQT) K BSIG N BBSIG,BVAR,BVAR1,III,ZNT,NNN,BLIM S BBSIG=STX S (BVAR,BVAR1)="",III=1 "RTN","PSODDPR8",64,0) S ZNT=0 F NNN=1:1:$L(BBSIG) I $E(BBSIG,NNN)=" "!($L(BBSIG)=NNN) S ZNT=ZNT+1 D I $L(BVAR)>LT S BSIG(III)=BLIM_" ",III=III+1,BVAR=BVAR1 "RTN","PSODDPR8",65,0) .S BVAR1=$P(BBSIG," ",(ZNT)),BLIM=BVAR,BVAR=$S(BVAR="":BVAR1,1:BVAR_" "_BVAR1) D HD(6):(($Y+6)>IOSL) "RTN","PSODDPR8",66,0) I $G(BVAR)'="" S BSIG(III)=BVAR "RTN","PSODDPR8",67,0) I $G(BSIG(1))=""!($G(BSIG(1))=" ") S BSIG(1)=$G(BSIG(2)) K BSIG(2) "RTN","PSODDPR8",68,0) K LT D HD():(($Y+5)>IOSL) "RTN","PSODDPR8",69,0) Q "RTN","PSODDPR8",70,0) ; "RTN","PSODDPR8",71,0) HD(PSOLINES,OVRRID) ; "RTN","PSODDPR8",72,0) S:'$G(PSODLQT) PSODLQT=0 S:'$G(OVRRID) OVRRID=0 S:'$G(PSOLINES) PSOLINES=5 "RTN","PSODDPR8",73,0) I '$G(OVRRID),$G(PSODLQT)!(($Y+PSOLINES)'>IOSL) Q "RTN","PSODDPR8",74,0) N DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y "RTN","PSODDPR8",75,0) W ! K DIR,Y S DIR(0)="E",DIR("A")="Press return to continue" D ^DIR K DIR "RTN","PSODDPR8",76,0) K PSOLINES,OVRRID "RTN","PSODDPR8",77,0) I Y'=1!($D(DTOUT))!($D(DUOUT)) S PSODLQT=1,PSORX("DFLG")=1 Q "RTN","PSODDPR8",78,0) W:'$G(PSODUPF) @IOF "RTN","PSODDPR8",79,0) Q "RTN","PSODDPR8",80,0) ; "RTN","PSODDPRE") 0^11^B132472323^B127148270 "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,379,390**;DEC 1997;Build 86 "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) ;External reference to ^PS(50.606 supported by DBIA 2174 "RTN","PSODDPRE",10,0) ;External reference to $$SUP^PSSDSAPI supported by DBIA 5425 "RTN","PSODDPRE",11,0) ; "RTN","PSODDPRE",12,0) K IT,^TMP("PSORXDC",$J),^TMP("PSORXDD",$J),CLS,^TMP($J,"PSONVADD"),^TMP($J,"PSONRVADD"),^TMP($J,"PSORDI"),^TMP($J,"PSORMDD") "RTN","PSODDPRE",13,0) N PSONULN,PSODLQT,ZZPSODRG S LIST="PSOPEPS",$P(PSONULN,"-",79)="-",(STA,DNM)="" "RTN","PSODDPRE",14,0) D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT) "RTN","PSODDPRE",15,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",16,0) .I STA="PENDING" D ^PSODDPR1 Q "RTN","PSODDPRE",17,0) .I STA="ZNONVA" D NVA^PSODDPR1 Q "RTN","PSODDPRE",18,0) .D:PSODRUG("NAME")=$P(DNM,"^")&('$D(^XUSEC("PSORPH",DUZ))) Q:$G(PSORX("DFLG")) "RTN","PSODDPRE",19,0) ..I '$P(PSOPAR,"^",2),'$P(PSOPAR,"^",16) D DUP I $G(PSOTECCK) S PSORX("DFLG")=1 Q "RTN","PSODDPRE",20,0) ..I '$P(PSOPAR,"^",2),$P(PSOPAR,"^",16),$G(PSOTECCK) D DUP Q "RTN","PSODDPRE",21,0) ..I $P(PSOPAR,"^",2),$G(PSOTECCK) D Q "RTN","PSODDPRE",22,0) ...S DA=+PSOSD(STA,DNM),PSOCLC=DUZ "RTN","PSODDPRE",23,0) ...S MSG="Discontinued During Reinstating Prescription Entry",ACT="Discontinued during Rx Reinstate." "RTN","PSODDPRE",24,0) ...S ^TMP("PSORXDC",$J,DA,0)="52^"_DA_"^"_MSG_"^C^"_ACT_"^"_STA_"^"_DNM,PSONOOR="D",^TMP("PSORXDD",$J)=DNM "RTN","PSODDPRE",25,0) ..I $P($G(PSOPAR),"^",16) D DUP Q "RTN","PSODDPRE",26,0) ..I $P(PSOPAR,"^",2),'$P(PSOPAR,"^",16) D DUP S PSORX("DFLG")=1 Q "RTN","PSODDPRE",27,0) .D:PSODRUG("NAME")=$P(DNM,"^")&($D(^XUSEC("PSORPH",DUZ))) DUP "RTN","PSODDPRE",28,0) K ^TMP($J,"DD"),^TMP($J,"DC"),^TMP($J,"DI"),^TMP($J,"PSODRDI") "RTN","PSODDPRE",29,0) Q:$G(PSORX("DFLG")) "RTN","PSODDPRE",30,0) M ZZPSODRG=PSODRUG "RTN","PSODDPRE",31,0) S LIST="PSOPEPS" D REMOTE^PSOCPPRE "RTN","PSODDPRE",32,0) M PSODRUG=ZZPSODRG "RTN","PSODDPRE",33,0) Q "RTN","PSODDPRE",34,0) OBX ;process enhanced order checks "RTN","PSODDPRE",35,0) K ZDGDG,ZTHER,IT "RTN","PSODDPRE",36,0) S LIST="PSOPEPS" K PSODLQT,DTOUT,DUOUT,DIRUT,PSODOSD "RTN","PSODDPRE",37,0) I $P(^TMP($J,LIST,"OUT",0),"^")=-1 G EXIT "RTN","PSODDPRE",38,0) W !,"Now Processing Enhanced Order Checks! Please wait...",! H 1 "RTN","PSODDPRE",39,0) D FDB S PDRG=PSODRUG("IEN"),DO=0 D IN^PSSHRQ2(LIST) ;call 2 fdb "RTN","PSODDPRE",40,0) ; "RTN","PSODDPRE",41,0) K DIR "RTN","PSODDPRE",42,0) I $P(^TMP($J,LIST,"OUT",0),"^")=-1 D DATACK G EXIT "RTN","PSODDPRE",43,0) I '$D(PSODGCK) D ^PSODDPR2 ;if order checks returned "RTN","PSODDPRE",44,0) I $D(PSODGCK) D PROC^PSSDIUTL Q ;if running DX option "RTN","PSODDPRE",45,0) I '$G(PSOCOPY)&('$G(PSORENW)),$G(PSOQUIT) D "RTN","PSODDPRE",46,0) .I $G(PSOREINS) Q:$G(PSODLQT) S PSORX("DFLG")=1 "RTN","PSODDPRE",47,0) ; "RTN","PSODDPRE",48,0) EXIT ; "RTN","PSODDPRE",49,0) D ^PSOBUILD "RTN","PSODDPRE",50,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",51,0) K DO,PDRG,IT,PSODLQT "RTN","PSODDPRE",52,0) K ^TMP($J,LIST,"IN","PING"),^TMP($J,LIST,"OUT","EXCEPTIONS"),^TMP($J,"PSOPEPS"),^TMP($J,"PSORDI") "RTN","PSODDPRE",53,0) Q "RTN","PSODDPRE",54,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",55,0) S RXREC=+PSOSD(STA,DNM),MSG="Discontinued During "_$S('$G(PSONV):"New Prescription Entry",1:"Verification")_" - Duplicate Drug" "RTN","PSODDPRE",56,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",57,0) S RXRECLOC=$G(RXREC) "RTN","PSODDPRE",58,0) S DA=RXREC "RTN","PSODDPRE",59,0) D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT) "RTN","PSODDPRE",60,0) W !,$J("Rx: ",24)_$P(^PSRX(+PSOSD(STA,DNM),0),"^") "RTN","PSODDPRE",61,0) W !,$J("Drug: ",24)_$P(DNM,"^") "RTN","PSODDPRE",62,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",63,0) K FSIG,PSREV I '$P($G(^PSRX(RXREC,"SIG")),"^",2) D EN2^PSOUTLA1(RXREC,54) "RTN","PSODDPRE",64,0) W !,$J("SIG: ",24) W $G(BSIG(1)) "RTN","PSODDPRE",65,0) I $O(BSIG(1)) F PSREV=1:0 S PSREV=$O(BSIG(PSREV)) Q:'PSREV W !?24,$G(BSIG(PSREV)) "RTN","PSODDPRE",66,0) K BSIG,PSREV "RTN","PSODDPRE",67,0) D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT) "RTN","PSODDPRE",68,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",69,0) S PHYS=$S($D(^VA(200,+$P(DUPRX0,"^",4),0)):$P(^(0),"^"),1:"UNKNOWN") "RTN","PSODDPRE",70,0) W !,$J("Provider: ",24)_PHYS,?42,$J("Issued: ",24),$E(ISSD,4,5)_"/"_$E(ISSD,6,7)_"/"_$E(ISSD,2,3) "RTN","PSODDPRE",71,0) W !,$J("Status: ",24) S J=RXREC D STAT^PSOFUNC W ST K RX0,RX2 "RTN","PSODDPRE",72,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",73,0) D PRSTAT(RXREC) "RTN","PSODDPRE",74,0) W !?42,$J("Days Supply: ",24)_$P(DUPRX0,"^",8) "RTN","PSODDPRE",75,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",76,0) ASKCAN I $P(PSOSD(STA,DNM),"^",2)>10,$P(PSOSD(STA,DNM),"^",2)'=16 D Q "RTN","PSODDPRE",77,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",78,0) .S ^TMP("PSORXDD",$J,RXREC,0)=1 "RTN","PSODDPRE",79,0) I '$P(PSOPAR,"^",16),'$D(^XUSEC("PSORPH",DUZ)) D Q "RTN","PSODDPRE",80,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",81,0) .D ^DIR K DIR "RTN","PSODDPRE",82,0) I $P(PSOSD(STA,DNM),"^",2)=16,$G(DUP) D Q "RTN","PSODDPRE",83,0) .W !!,"Prescription "_$P($G(^PSRX(+$G(RXRECLOC),0)),"^")_" is on Provider Hold, it cannot be discontinued.",! "RTN","PSODDPRE",84,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",85,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",86,0) .I $P($G(PSOMSG),"^",2)'="" W !!,$P(PSOMSG,"^",2),! Q "RTN","PSODDPRE",87,0) .W !!,"Another person is editing Rx "_$P($G(^PSRX(RXRECLOC,0)),"^"),! "RTN","PSODDPRE",88,0) I $D(PSODGCK) K RXRECLOC,DUP,CLS,PSONOOR Q "RTN","PSODDPRE",89,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",90,0) S DIR("?")="Enter Y to "_$S($P(PSOSD(STA,DNM),"^",2)=12:"reinstate",1:"discontinue")_" this RX." "RTN","PSODDPRE",91,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",92,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",93,0) I 'Y W !,$C(7)," -Prescription was not "_$S($P(PSOSD(STA,DNM),"^",2)=12:"reinstated",1:"discontinued")_"..." D Q "RTN","PSODDPRE",94,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",95,0) .K ^TMP("PSORXDC",$J,RXREC,0) "RTN","PSODDPRE",96,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",97,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",98,0) W !! K ^UTILITY($J,"W") S DIWL=1,DIWR=75,DIWF="" "RTN","PSODDPRE",99,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",100,0) F ZX=0:0 S ZX=$O(^UTILITY($J,"W",1,ZX)) Q:'ZX W !,^UTILITY($J,"W",1,ZX,0) "RTN","PSODDPRE",101,0) K ^UTILITY($J,"W"),X,DIWL,DIWR,DIWF W ! "RTN","PSODDPRE",102,0) S ^TMP("PSORXDC",$J,RXREC,0)="52^"_DA_"^"_MSG_"^"_REA_"^"_ACT_"^"_STA_"^"_DNM,PSONOOR="D",^TMP("PSORXDD",$J)=DNM H 2 "RTN","PSODDPRE",103,0) K RXRECLOC,DUP,CLS,PSONOOR "RTN","PSODDPRE",104,0) Q "RTN","PSODDPRE",105,0) FDB ;build drug check input "RTN","PSODDPRE",106,0) N ID,ORTYP,PSOI,ORN S DFN=PSODFN,CT=0 "RTN","PSODDPRE",107,0) S ID=+$$GETVUID^XTID(50.68,,+$P(PSODRUG("NDF"),"A",2)_",") "RTN","PSODDPRE",108,0) S P1=$P(PSODRUG("NDF"),"A"),P2=$P(PSODRUG("NDF"),"A",2),X=$$PROD0^PSNAPIS(P1,P2),SEQN=+$P(X,"^",7) "RTN","PSODDPRE",109,0) I 'SEQN K ^TMP($J,LIST,"OUT","EXCEPTIONS"),^TMP($J,LIST,"IN") "RTN","PSODDPRE",110,0) S ^TMP($J,LIST,"IN","PROSPECTIVE","Z;1;PROSPECTIVE;1")=SEQN_"^"_ID_"^"_PSODRUG("IEN")_"^"_$P(^PSDRUG(PSODRUG("IEN"),0),"^") "RTN","PSODDPRE",111,0) K:$D(PSODGCK)&$D(PSODGCKX) ^TMP($J,LIST,"IN","PROSPECTIVE","Z;1;PROSPECTIVE;1"),PSODGCKX "RTN","PSODDPRE",112,0) S ^TMP($J,LIST,"IN","IEN")=PSODFN,^TMP($J,LIST,"IN","DRUGDRUG")="",^TMP($J,LIST,"IN","THERAPY")="" "RTN","PSODDPRE",113,0) K ID,P1,P2 N ODRG,TU S (STA,DNM)="" I '$G(PSOCOPY),'$G(SEQN) K SEQN Q "RTN","PSODDPRE",114,0) ;build profile drug order checks "RTN","PSODDPRE",115,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",116,0) .Q:$P(PSOSD(STA,DNM),"^")=$G(PSORENW("OIRXN"))&('$G(PSOCOPY)) "RTN","PSODDPRE",117,0) .S CT=CT+1 "RTN","PSODDPRE",118,0) .I STA="PENDING" N DDRG D "RTN","PSODDPRE",119,0) ..Q:$G(^TMP("PSORXDC",$J,$P(PSOSD(STA,DNM),"^",10),0))]"" "RTN","PSODDPRE",120,0) ..Q:$G(PSODRUG("IEN"))=$P(^PS(52.41,$P(PSOSD(STA,DNM),"^",10),0),"^",9) "RTN","PSODDPRE",121,0) ..Q:$P(^PS(52.41,$P(PSOSD(STA,DNM),"^",10),0),"^",3)="RF" "RTN","PSODDPRE",122,0) ..Q:$G(^TMP("PSORXPO",$J,$P(PSOSD(STA,DNM),"^",10),0)) "RTN","PSODDPRE",123,0) ..S RXREC=$P(PSOSD(STA,DNM),"^",10),ORN=$P(^PS(52.41,RXREC,0),"^"),ODRG=$P(^(0),"^",9),ORTYP="P" "RTN","PSODDPRE",124,0) ..I ODRG D K ODRG Q "RTN","PSODDPRE",125,0) ...I $P($G(^PSDRUG(ODRG,0)),"^",3)["S"!($E($P($G(^PSDRUG(ODRG,0)),"^",2),1,2)="XA") Q "RTN","PSODDPRE",126,0) ...S PDNM=$P(^PSDRUG(ODRG,0),"^") D ID "RTN","PSODDPRE",127,0) ..E N PSOI,DDRG,ODRG,SEQN,DDRG S PSOI=$P(^PS(52.41,RXREC,0),"^",8) D "RTN","PSODDPRE",128,0) ...S PDNM=$P(^PS(50.7,PSOI,0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^") "RTN","PSODDPRE",129,0) ...S DDRG=$$DRG^PSSDSAPM(PSOI,"O") I '$P(DDRG,";") D OIX Q "RTN","PSODDPRE",130,0) ...I $P($G(^PSDRUG($P(DDRG,";"),0)),"^",3)["S"!($E($P($G(^PSDRUG($P(DDRG,";"),0)),"^",2),1,2)="XA") Q "RTN","PSODDPRE",131,0) ...S ODRG=$P(DDRG,";"),SEQN=+$P(DDRG,";",3) K PSOI "RTN","PSODDPRE",132,0) ...N ID S ID=+$$GETVUID^XTID(50.68,,+$P($G(^PSDRUG(ODRG,"ND")),"^",3)_",") "RTN","PSODDPRE",133,0) ...D ID1 "RTN","PSODDPRE",134,0) .I STA="ZNONVA" D Q "RTN","PSODDPRE",135,0) ..Q:$G(^TMP($J,"PSONVADD",$P(PSOSD(STA,DNM),"^",10),0))]"" "RTN","PSODDPRE",136,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",137,0) ..I ODRG D K ODRG Q "RTN","PSODDPRE",138,0) ...I $P($G(^PSDRUG(ODRG,0)),"^",3)["S"!($E($P($G(^PSDRUG(ODRG,0)),"^",2),1,2)="XA") Q "RTN","PSODDPRE",139,0) ...S PDNM=$P(^PSDRUG(ODRG,0),"^") D ID "RTN","PSODDPRE",140,0) ..E N PSOI,DDRG,ODRG,SEQN,DDRG S PSOI=$P(^PS(55,PSODFN,"NVA",RXREC,0),"^") D "RTN","PSODDPRE",141,0) ...S PDNM=$P(^PS(50.7,PSOI,0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^") "RTN","PSODDPRE",142,0) ...S DDRG=$$DRG^PSSDSAPM(PSOI,"X") I '$P(DDRG,";") D:'$$NVATST(PSOI) OIX Q "RTN","PSODDPRE",143,0) ...I $P($G(^PSDRUG($P(DDRG,";"),0)),"^",3)["S"!($E($P($G(^PSDRUG($P(DDRG,";"),0)),"^",2),1,2)="XA") Q "RTN","PSODDPRE",144,0) ...S ODRG=$P(DDRG,";"),SEQN=+$P(DDRG,";",3) K PSOI "RTN","PSODDPRE",145,0) ...N ID S ID=+$$GETVUID^XTID(50.68,,+$P($G(^PSDRUG(ODRG,"ND")),"^",3)_",") "RTN","PSODDPRE",146,0) ...D ID1 "RTN","PSODDPRE",147,0) .I $P($G(^PSRX(+PSOSD(STA,DNM),0)),"^",6) D "RTN","PSODDPRE",148,0) ..Q:$G(^TMP("PSORXDC",$J,$P(PSOSD(STA,DNM),"^"),0))]"" "RTN","PSODDPRE",149,0) ..Q:$G(^TMP("PSORXBO",$J,$P(PSOSD(STA,DNM),"^"),0)) "RTN","PSODDPRE",150,0) ..Q:$G(^TMP("PSORXDD",$J,$P(PSOSD(STA,DNM),"^"),0)) "RTN","PSODDPRE",151,0) ..;I $P(PSOSD(STA,DNM),"^",2)>5,$P(PSOSD(STA,DNM),"^",2)'=16 Q "RTN","PSODDPRE",152,0) ..S RXREC=+PSOSD(STA,DNM),ODRG=$P(^PSRX(RXREC,0),"^",6),ORN=$P($G(^("OR1")),"^",2),ORTYP="O" "RTN","PSODDPRE",153,0) ..I ODRG D "RTN","PSODDPRE",154,0) ...I $P($G(^PSDRUG(ODRG,0)),"^",3)["S"!($E($P($G(^PSDRUG(ODRG,0)),"^",2),1,2)="XA") Q "RTN","PSODDPRE",155,0) ...I STA="DISCONTINUED" Q:$$DUPTHER(RXREC) "RTN","PSODDPRE",156,0) ...S PDNM=$P(^PSDRUG(ODRG,0),"^") D ID "RTN","PSODDPRE",157,0) D IMO^PSODDPR7(PSODFN) "RTN","PSODDPRE",158,0) K RXREC,ID,STA,DNM,PSOI,ORN,ODRG,ORTYP,CT,PDNM,TU,DDRG "RTN","PSODDPRE",159,0) Q "RTN","PSODDPRE",160,0) ; "RTN","PSODDPRE",161,0) ID N ID,P1,P2,PSODGCKP S ID=+$$GETVUID^XTID(50.68,,+$P($G(^PSDRUG(ODRG,"ND")),"^",3)_",") "RTN","PSODDPRE",162,0) S P1=$P($G(^PSDRUG(ODRG,"ND")),"^"),P2=$P($G(^("ND")),"^",3),X=$$PROD0^PSNAPIS(P1,P2),SEQN=$P(X,"^",7) "RTN","PSODDPRE",163,0) ID1 S PSODGCKP=$S($G(PSODGCK):"PROSPECTIVE",1:"PROFILE") "RTN","PSODDPRE",164,0) S ^TMP($J,LIST,"IN",PSODGCKP,$S($D(PSODGCK):"Z",1:ORTYP)_";"_RXREC_";"_PSODGCKP_";"_CT)=SEQN_"^"_ID_"^"_ODRG_"^"_PDNM_"^"_ORN_"^O" K ID "RTN","PSODDPRE",165,0) Q "RTN","PSODDPRE",166,0) DUPTHER(RXREC) ;screen out discontinued/duplicate therapy Rx's greater than business rule calculation (cancel date + days supply +7 days) "RTN","PSODDPRE",167,0) ;Note: If the dup allowance is 1 you have to have at least 3 eligible drug orders (or 2 matches) to produce the dupl. therapy warning "RTN","PSODDPRE",168,0) ;Business rule for expired orders is (expiration date+120 days) which is the length of time expired order currently stay on med profile. No changes for this. "RTN","PSODDPRE",169,0) N X,Y,X1,X2 S X1=$P($G(^PSRX(RXREC,3)),"^",5),X2=(+$P(^PSRX(RXREC,0),"^",8)+7) D C^%DTC I DT>X Q 1 "RTN","PSODDPRE",170,0) Q 0 "RTN","PSODDPRE",171,0) OIX S ^TMP($J,LIST,"IN","EXCEPTIONS","OI",PDNM)=1_"^"_ORTYP_";"_RXREC_";PROFILE;"_CT "RTN","PSODDPRE",172,0) Q "RTN","PSODDPRE",173,0) ULRX ; "RTN","PSODDPRE",174,0) I '$G(RXRECLOC) Q "RTN","PSODDPRE",175,0) D PSOUL^PSSLOCK(RXRECLOC) "RTN","PSODDPRE",176,0) Q "RTN","PSODDPRE",177,0) ; "RTN","PSODDPRE",178,0) PRSTAT(DA) ;Displays the prescription's status "RTN","PSODDPRE",179,0) N PSOTRANS,PSOREL,PSOCMOP,RXPSTA,PSOX,RFLZRO,PSOLRD,PSORTS,CMOP "RTN","PSODDPRE",180,0) D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT) S RXPSTA="Processing Status: ",PSOLRD=$P($G(^PSRX(RXREC,2)),"^",13) "RTN","PSODDPRE",181,0) D ^PSOCMOPA I $G(PSOCMOP)]"" D K CMOP,PSOTRANS,PSOREL "RTN","PSODDPRE",182,0) .S PSOTRANS=$E($P(PSOCMOP,"^",2),4,5)_"/"_$E($P(PSOCMOP,"^",2),6,7)_"/"_$E($P(PSOCMOP,"^",2),2,3) "RTN","PSODDPRE",183,0) .S PSOREL=$S(CMOP("L")=0:$P($G(^PSRX(DA,2)),"^",13),1:$P(^PSRX(DA,1,CMOP("L"),0),"^",18)) "RTN","PSODDPRE",184,0) .S PSOREL=$E(PSOREL,4,5)_"/"_$E(PSOREL,6,7)_"/"_$E(PSOREL,2,3)_"@"_$E($P(PSOREL,".",2),1,4) "RTN","PSODDPRE",185,0) .I '$D(IOINORM)!('$D(IOINHI)) S X="IORVOFF;IORVON;IOINHI;IOINORM" D ENDR^%ZISS "RTN","PSODDPRE",186,0) .I $P($G(^PSRX(RXREC,"STA")),"^")=0 W:$$TRANCMOP^PSOUTL(RXREC) ?5,IORVON_IOINHI "RTN","PSODDPRE",187,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",188,0) D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT) "RTN","PSODDPRE",189,0) I $G(PSOCMOP)']"" D "RTN","PSODDPRE",190,0) .F PSOX=0:0 S PSOX=$O(^PSRX(RXREC,1,PSOX)) Q:'PSOX D "RTN","PSODDPRE",191,0) ..S RFLZRO=$G(^PSRX(RXREC,1,PSOX,0)) "RTN","PSODDPRE",192,0) ..S:$P(RFLZRO,"^",18)'="" PSOLRD=$P(RFLZRO,"^",18) I $P(RFLZRO,"^",16) S PSOLRD=PSOLRD_"^R",PSORTS=$P(RFLZRO,"^",16) "RTN","PSODDPRE",193,0) .I '$O(^PSRX(RXREC,1,0)),$P(^PSRX(RXREC,2),"^",15) S PSOLRD=PSOLRD_"^R",PSORTS=$P(^PSRX(RXREC,2),"^",15) "RTN","PSODDPRE",194,0) .S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J(RXPSTA,24) "RTN","PSODDPRE",195,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",196,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",197,0) Q "RTN","PSODDPRE",198,0) ; "RTN","PSODDPRE",199,0) DATACK ;check FDB returned data to determine whether to continue processing. "RTN","PSODDPRE",200,0) S DIR(0)="E",DIR("A",1)="No Enhanced Order Checks can be performed." "RTN","PSODDPRE",201,0) S DIR("A",2)=" Reason(s): "_$P($G(^TMP($J,LIST,"OUT",0)),"^",2) "RTN","PSODDPRE",202,0) S DIR("A")="Press Return to continue...",DIR("?")="Press Return to continue" "RTN","PSODDPRE",203,0) W ! D ^DIR K DIRUT,DUOUT,DIR,X,Y W @IOF ;I $P(^TMP($J,LIST,"OUT",0),"^")=1 "RTN","PSODDPRE",204,0) Q "RTN","PSODDPRE",205,0) ; "RTN","PSODDPRE",206,0) NVATST(PSONVTOI) ; Look for any active Non-VA Dispense Drugs not marked as a supply item "RTN","PSODDPRE",207,0) N PSONVT1,PSONVTFL,PSONVTIN "RTN","PSODDPRE",208,0) S PSONVTFL=1 "RTN","PSODDPRE",209,0) F PSONVT1=0:0 S PSONVT1=$O(^PSDRUG("ASP",PSONVTOI,PSONVT1)) Q:'PSONVT1!('PSONVTFL) D "RTN","PSODDPRE",210,0) .I $P($G(^PSDRUG(PSONVT1,2)),"^",3)'["X" Q "RTN","PSODDPRE",211,0) .S PSONVTIN=$P($G(^PSDRUG(PSONVT1,"I")),"^") I PSONVTIN,PSONVTIN
IOM ! W $P(X," ",I)," " "RTN","PSODEM",9,0) RE S (WT,HT)="",X="GMRVUTL" X ^%ZOSF("TEST") I $T D "RTN","PSODEM",10,0) .F GMRVSTR="WT","HT" S VM=GMRVSTR D EN6^GMRVUTL S @VM=X,$P(@VM,"^")=$E($P(@VM,"^"),4,5)_"/"_$E($P(@VM,"^"),6,7)_"/"_($E($P(@VM,"^"),1,3)+1700) "RTN","PSODEM",11,0) .S X=$P(WT,"^",8),Y=$J(X/2.2,0,2),$P(WT,"^",9)=Y,X=$P(HT,"^",8),Y=$J(2.54*X,0,2),$P(HT,"^",9)=Y "RTN","PSODEM",12,0) Q:$G(POERR) "RTN","PSODEM",13,0) W !!,"WEIGHT(Kg): " W:+$P(WT,"^",8) $P(WT,"^",9)_" ("_$P(WT,"^")_")" W ?41,"HEIGHT(cm): " W:$P(HT,"^",8) $P(HT,"^",9)_" ("_$P(HT,"^")_")" K VM,WT,HT "RTN","PSODEM",14,0) CRCL S PSOBSA=$$BSA^PSSDSAPI(DFN),PSOBSA=$P(PSOBSA,"^",3),PSOBSA=$S(PSOBSA'>0:"_______",1:$J(PSOBSA,4,2)) "RTN","PSODEM",15,0) S RSLT=$$CRCL^PSOORUT2(DFN) "RTN","PSODEM",16,0) ; RSLT -- DATE^CRCL^Serum Creatinine -- Ex. 11/25/11^68.7^1.1 "RTN","PSODEM",17,0) I $P(RSLT,"^",2)["Not Found" S ZDSPL="CrCL: "_$P(RSLT,"^",2) "RTN","PSODEM",18,0) E S ZDSPL="CrCL: "_$P($G(RSLT),"^",2)_"(est.) "_"(CREAT:"_$P($G(RSLT),"^",3)_"mg/dL "_$P($G(RSLT),"^")_")" "RTN","PSODEM",19,0) W !,ZDSPL,?40,"BSA: ",PSOBSA K PSOBSA,ZDSPL,RSLT "RTN","PSODEM",20,0) S PSLC=0 G MA:$P($G(^DPT(DFN,.17)),"^",2)'="I" "RTN","PSODEM",21,0) I '$D(VAEL(1)) D ELIG^VADPT W !!,"ELIGIBILITY: ",$P(VAEL(1),"^",2) W:+VAEL(3) ?$X+5,"SC%: "_$P(VAEL(3),"^",2) S PSLC=PSLC+2 "RTN","PSODEM",22,0) MA K SC W !,"DISABILITIES: " S PSLC=PSLC+2 "RTN","PSODEM",23,0) F I=0:0 S I=$O(^DPT(DFN,.372,I)) Q:'I S I1=$S($D(^DPT(DFN,.372,I,0)):^(0),1:"") D:+I1 "RTN","PSODEM",24,0) .S PSDIS=$S($P($G(^DIC(31,+I1,0)),"^")]""&($P($G(^(0)),"^",4)']""):$P(^(0),"^"),$P($G(^DIC(31,+I1,0)),"^",4)]"":$P(^(0),"^",4),1:""),PSCNT=$P(I1,"^",2) "RTN","PSODEM",25,0) .X:($X+$L(PSDIS)+7)>(IOM-8) "W !?14 S PSLC=PSLC+1" W PSDIS,"-",PSCNT,"% (",$S($P(I1,"^",3):"SC",1:"NSC"),"), " "RTN","PSODEM",26,0) .I $E(IOST)="C",$Y+4>IOSL,$D(PSTYPE) K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR,DTOUT W @IOF,?13 "RTN","PSODEM",27,0) X "N X S X=""GMRADPT"" X ^%ZOSF(""TEST"") Q" I $T D:'$D(PSOPTPST) GMRA "RTN","PSODEM",28,0) Q K SC,I1,VAROOT,Y,AL,I,X,Y,PSCNT,PSLC,PSDIS D:$G(PSTYPE)']"" KVA^VADPT Q "RTN","PSODEM",29,0) GMRA K ^TMP($J,"AL") S GMRA="0^0^111" D ^GMRADPT I GMRAL D "RTN","PSODEM",30,0) .F DR=0:0 S DR=$O(GMRAL(DR)) Q:'DR S ^TMP($J,"AL",$S('$P(GMRAL(DR),"^",5):1,1:2),$P(GMRAL(DR),"^",7),$P(GMRAL(DR),"^",2))="" "RTN","PSODEM",31,0) .W !!,"ALLERGIES: " S (DR,TY)="" F I=0:0 S TY=$O(^TMP($J,"AL",1,TY)) Q:TY="" F D=0:0 S DR=$O(^TMP($J,"AL",1,TY,DR)) Q:DR="" W:$X+$L(DR)+$L(", ")>IOM !?11 W DR_", " D "RTN","PSODEM",32,0) ..I $E(IOST)="C",$Y+4>IOSL,$D(PSTYPE) W ! K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR,DTOUT W @IOF,?18 "RTN","PSODEM",33,0) .W !!,"ADVERSE REACTIONS: " S (DR,TY)="" F I=0:0 S TY=$O(^TMP($J,"AL",2,TY)) Q:TY="" F D=0:0 S DR=$O(^TMP($J,"AL",2,TY,DR)) Q:DR="" W:$X+$L(DR)+$L(", ")>IOM !?19 W DR_", " D "RTN","PSODEM",34,0) ..I $E(IOST)="C",$Y+4>IOSL,$D(PSTYPE) W ! K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR,DTOUT W @IOF,?18 "RTN","PSODEM",35,0) I $G(GMRAL)']"" F AD="ALLERGIES:","ADVERSE REACTIONS:" W !!,AD I $G(PSOFROM)="" F ADL=1:1:IOM-($L(AD)+5) W "_" "RTN","PSODEM",36,0) I GMRAL=0 W !!,"ALLERGIES: NKA",!!,"ADVERSE REACTIONS:" "RTN","PSODEM",37,0) W ! K TY,D,I,GMRA,GMRAL,DR,AD,ADL,^TMP($J,"AL") Q "RTN","PSODGAL1") 0^23^B77114277^B23109209 "RTN","PSODGAL1",1,0) PSODGAL1 ;BIR/LC,SAB-enhanced DRUG ALLERGY REACTION CHECKING ;12/09/07 02:22 "RTN","PSODGAL1",2,0) ;;7.0;OUTPATIENT PHARMACY;**251,401,390**;DEC 1997;Build 86 "RTN","PSODGAL1",3,0) ;External reference to ^GMRADPT supported by DBIA 10099 "RTN","PSODGAL1",4,0) ;External reference to ORCHK^GMRAOR supported by DBIA 2378 "RTN","PSODGAL1",5,0) ;External reference to $P(^GMR(120.8,LP,3),"^",3) supp. by DBIA 2214 "RTN","PSODGAL1",6,0) ;External reference to ^PS(50.605 supported by DBIA 696 "RTN","PSODGAL1",7,0) ;External reference to EN1^GMRAOR2 supported by DBIA 2422 "RTN","PSODGAL1",8,0) ;External reference to GETDATA^GMRAOR supported by DBIA 4847 "RTN","PSODGAL1",9,0) ;External reference to ^TMP("GMRAOC" supported by DBIA 4848 "RTN","PSODGAL1",10,0) ;External reference to ^XUSEC("PSORPH" supported by DBIA 10076 "RTN","PSODGAL1",11,0) ;External reference to CLIST^PSNAPIS supported by DBIA 2574 "RTN","PSODGAL1",12,0) ;External reference to ^GMRD(120.82,D0, supported by DBIA 5690 "RTN","PSODGAL1",13,0) ;External reference to GETOC4^OROCAPI1 supported by DBIA 5729 "RTN","PSODGAL1",14,0) ;External reference to INGR^PSNNGR supported by DBIA 5728 "RTN","PSODGAL1",15,0) ;External reference to ^PS(55 supported by DBIA 2228 "RTN","PSODGAL1",16,0) ;External reference to ^PS(53.1 supported by DBIA 5793 "RTN","PSODGAL1",17,0) ; "RTN","PSODGAL1",18,0) N PSOACK,DFN,PSODAL K TRU "RTN","PSODGAL1",19,0) K ^TMP($J,"PSODRCLS"),DSPLQ,PSOMDC,^TMP("PSODAOC",$J),^TMP("GMRAOC",$J) S DFN=PSODFN "RTN","PSODGAL1",20,0) I $D(PSODRUG("NDF")) S NDF=$P(PSODRUG("NDF"),"A"),TYP=$P(PSODRUG("NDF"),"A",2),PTR=NDF_"."_TYP "RTN","PSODGAL1",21,0) I $G(NDF) D CHK "RTN","PSODGAL1",22,0) S NDF=$P(PSODRUG("NDF"),"A") "RTN","PSODGAL1",23,0) I '$G(NDF) D CHK1 "RTN","PSODGAL1",24,0) I $D(PSODRUG("VA CLASS")),$G(TRU) D CLASS "RTN","PSODGAL1",25,0) I $G(^TMP($J,"PSODRCLS",0))!$G(TRU) D "RTN","PSODGAL1",26,0) .I '$D(^XUSEC("PSORPH",DUZ)),'$D(PSOMDC) K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to continue" D ^DIR K DIR,DUOUT,DIRUT Q "RTN","PSODGAL1",27,0) .I $D(PSJDGCK)!$D(PSODGCK) K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to continue" D ^DIR K DIR,DUOUT,DIRUT W @IOF Q "RTN","PSODGAL1",28,0) .S DIR("?",1)="Answer 'YES' if you DO want to enter a intervention for this medication," "RTN","PSODGAL1",29,0) .S DIR("?")=" 'NO' if you DON'T want to enter a intervention for this medication," "RTN","PSODGAL1",30,0) .S DIR(0)="SA^1:YES;0:NO",DIR("A")="Do you want to Intervene? ",DIR("B")="YES" D ^DIR "RTN","PSODGAL1",31,0) .Q:'Y S PSODAL=1 "RTN","PSODGAL1",32,0) .D ^PSORXI I $G(PSODAL("DA")) S $P(^TMP("PSODAOC",$J,1,0),"^",5)=PSODAL("DA") "RTN","PSODGAL1",33,0) EX K DIR,DTOUT,DIRUT,DIROUT,DUOUT,Y,DSPLQ,PSJAOC,PSOMDC "RTN","PSODGAL1",34,0) K PSOACK,GMRAING,I,APTR,GMRA,GMRAL,LP,^TMP($J,"PSODRCLS"),^TMP("GMRAOC",$J) "RTN","PSODGAL1",35,0) I $D(PSJDGCK)!$D(PSODGCK) K ^TMP("PSODAOC",$J) "RTN","PSODGAL1",36,0) Q "RTN","PSODGAL1",37,0) ; "RTN","PSODGAL1",38,0) CHK ;matched to ndf "RTN","PSODGAL1",39,0) K ^TMP("PSODAI",$J) S PSOACK=$$ORCHK^GMRAOR(DFN,"DR",PTR) D:$G(PSOACK)=1 "RTN","PSODGAL1",40,0) .S ^TMP("PSODAI",$J,0)=1 "RTN","PSODGAL1",41,0) .S I=0 F S I=$O(GMRAING(I)) Q:'I S ^TMP("PSODAI",$J,I,0)=GMRAING(I) "RTN","PSODGAL1",42,0) D SYM "RTN","PSODGAL1",43,0) D:$G(PSOACK)!($G(TRU)) DSPLY "RTN","PSODGAL1",44,0) Q "RTN","PSODGAL1",45,0) CHK1 ;not matched to ndf "RTN","PSODGAL1",46,0) K ^TMP("PSODAI",$J) "RTN","PSODGAL1",47,0) S GMRA="0^0^001" D EN1^GMRADPT F LP=0:0 S LP=$O(GMRAL(LP)) Q:'LP!($G(PSOACK)) D:$D(^GMR(120.8,LP,0)) "RTN","PSODGAL1",48,0) .S:'$G(PSOACK) APTR=$P(^GMR(120.8,LP,0),"^",3) "RTN","PSODGAL1",49,0) .I $P(APTR,";",2)="PSDRUG(",$P(APTR,";")=PSODRUG("IEN") S PSOACK=1 "RTN","PSODGAL1",50,0) .Q:$D(^XUSEC("PSORPH",DUZ)) S:$G(PSOACK)=1 ^TMP("PSODAI",$J,0)=1 "RTN","PSODGAL1",51,0) D SYM "RTN","PSODGAL1",52,0) D:$G(PSOACK)!($G(TRU)) DSPLY "RTN","PSODGAL1",53,0) Q "RTN","PSODGAL1",54,0) DSPLY ; "RTN","PSODGAL1",55,0) Q:'$G(TRU) "RTN","PSODGAL1",56,0) D FULL^VALM1 "RTN","PSODGAL1",57,0) N AGNL,SEV,SEVT,SEVN D EN1^GMRAOR2(TRU,"AGNL") "RTN","PSODGAL1",58,0) S ^TMP("PSODAOC",$J,1,0)=PSODRUG("IEN")_"^"_"L"_"^"_$S($G(TRU):$P(GMRAL(TRU),"^",9),1:"None Found")_"^^^V^"_$E($P($G(AGNL),"^",5)) "RTN","PSODGAL1",59,0) I $O(AGNL("O",0)) S SEV=0 D "RTN","PSODGAL1",60,0) .F I=1:1 S SEV=$O(AGNL("O",SEV)) Q:SEV<1 I $P(AGNL("O",SEV),"^",2)]"" S SEVT=$P(AGNL("O",SEV),"^",2),SEVN=$S(SEVT="MILD":1,SEVT="MODERATE":2,SEVT="SEVERE":3,1:"") "RTN","PSODGAL1",61,0) S ^TMP("PSODAOC",$J,1,0)=^TMP("PSODAOC",$J,1,0)_"^"_$S($G(SEVN):SEVN,1:"") "RTN","PSODGAL1",62,0) D "RTN","PSODGAL1",63,0) .W $C(7),!,"A Drug-Allergy Reaction exists for this medication and/or class!",! "RTN","PSODGAL1",64,0) .I '$D(PSODGCK) W !," Prospective Drug: "_PSODRUG("NAME") "RTN","PSODGAL1",65,0) .I $D(PSODGCK),'$D(PSODGCKF) W !," Prospective Drug: "_PSODRUG("NAME") "RTN","PSODGAL1",66,0) .I $D(PSODGCK),$D(PSODGCKF) W !," Profile Drug: "_PSODRUG("NAME") "RTN","PSODGAL1",67,0) .W !," Causative Agent: "_$S($G(TRU):$P(GMRAL(TRU),"^",2),1:"None Found") "RTN","PSODGAL1",68,0) .W !," Historical/Observed: "_$S($G(TRU):$P($G(AGNL),"^",5),1:"Not Entered") "RTN","PSODGAL1",69,0) .W !," Severity: "_$S($G(SEVT)]"":SEVT,1:"Not Entered"),! "RTN","PSODGAL1",70,0) .I $O(GMRAING(0)) D S DSPLQ=1 "RTN","PSODGAL1",71,0) ..W ?7," Ingredients: " "RTN","PSODGAL1",72,0) ..K ^UTILITY($J,"W") S DIWL=1,DIWR=57,DIWF="" "RTN","PSODGAL1",73,0) ..F ZX=0:0 S ZX=$O(GMRAING(ZX)) Q:'ZX S X=GMRAING(ZX)_", " D ^DIWP "RTN","PSODGAL1",74,0) ..F ZX=0:0 S ZX=$O(^UTILITY($J,"W",1,ZX)) Q:'ZX W ?22,^UTILITY($J,"W",1,ZX,0) I $O(^UTILITY($J,"W",1,ZX)) W ! "RTN","PSODGAL1",75,0) ..K ^UTILITY($J,"W"),DIWL,DIWR,DIWF,I,ZX,X W ! "RTN","PSODGAL1",76,0) ..K ^TMP("PSN",$J) "RTN","PSODGAL1",77,0) ..S PSNDA=PSODRUG("IEN"),PSNID=PSODRUG("NDF") D INGR^PSNNGR ;returns ingre ptrs "RTN","PSODGAL1",78,0) ..F I=0:0 S I=$O(^TMP("PSN",$J,I)) Q:'I S ^TMP("PSODAOC",$J,2,I)=I "RTN","PSODGAL1",79,0) ..K ^TMP("PSN",$J),PSNDA,PSNID "RTN","PSODGAL1",80,0) I $O(GMRAL(TRU,"S",0)) S ZI=TRU D SYM1 Q "RTN","PSODGAL1",81,0) E W ?3," Signs/Symptoms: None Entered",! "RTN","PSODGAL1",82,0) Q "RTN","PSODGAL1",83,0) ; "RTN","PSODGAL1",84,0) CLASS ; "RTN","PSODGAL1",85,0) N CPT,CLCHK,CT,AGNL,CC,GMRA,LEN S LEN=4 "RTN","PSODGAL1",86,0) I $E($G(PSODRUG("VA CLASS")),1,4)="CN10" S LEN=5 ;look at 5 chars if ANALGESICS "RTN","PSODGAL1",87,0) K ^TMP($J,"PSODRCLS") "RTN","PSODGAL1",88,0) I $T(GETDATA^GMRAOR)]"" G CLASS2 ; CHECK FOR EXISTENCE OF NEW ENTRY POINT BEFORE USING "RTN","PSODGAL1",89,0) S CLCHK="" "RTN","PSODGAL1",90,0) S GMRA="0^0^111" D EN1^GMRADPT F CC=0:0 S CC=$O(GMRAL(CC)) Q:'CC D "RTN","PSODGAL1",91,0) .K AGNL D EN1^GMRAOR2(CC,"AGNL") "RTN","PSODGAL1",92,0) .I $D(AGNL("V")) F CT=0:1 S CPT=$O(AGNL("V",CT)) Q:'CPT I $E($P($G(AGNL("V",CPT)),"^"),1,LEN)=$E(PSODRUG("VA CLASS"),1,LEN) D "RTN","PSODGAL1",93,0) ..S CLCHK=$G(CLCHK)+1,^TMP($J,"PSODRCLS",CLCHK)=$P($G(AGNL("V",CPT)),"^")_" "_$P($G(AGNL("V",CPT)),"^",2) "RTN","PSODGAL1",94,0) G CLASSDSP "RTN","PSODGAL1",95,0) CLASS2 ; "RTN","PSODGAL1",96,0) N RET "RTN","PSODGAL1",97,0) S RET=$$DRCL(DFN) "RTN","PSODGAL1",98,0) I '$G(RET) Q "RTN","PSODGAL1",99,0) S CLCHK="",CT="" F S CT=$O(GMRADRCL(CT)) Q:CT="" D "RTN","PSODGAL1",100,0) .I $E(PSODRUG("VA CLASS"),1,LEN)=$E(CT,1,LEN) S CLCHK=$G(CLCHK)+1,^TMP($J,"PSODRCLS",CLCHK)=CT_" "_$P(GMRADRCL(CT),"^",2) "RTN","PSODGAL1",101,0) CLASSDSP ; "RTN","PSODGAL1",102,0) I $O(^TMP($J,"PSODRCLS",0)) W ?8," Drug Class: " "RTN","PSODGAL1",103,0) K ^UTILITY($J,"W") S DIWL=1,DIWR=55,DIWF="" N ZPSODC "RTN","PSODGAL1",104,0) S CT="" F S CT=$O(^TMP($J,"PSODRCLS",CT)) Q:CT="" D "RTN","PSODGAL1",105,0) .S ZPSODC=$P(^TMP($J,"PSODRCLS",CT)," "),^TMP("PSODAOC",$J,1,CT)=$O(^PS(50.605,"B",ZPSODC,0)) "RTN","PSODGAL1",106,0) .S X=^TMP($J,"PSODRCLS",CT)_", " D ^DIWP "RTN","PSODGAL1",107,0) F ZX=0:0 S ZX=$O(^UTILITY($J,"W",1,ZX)) Q:'ZX W ?22,^UTILITY($J,"W",1,ZX,0),! "RTN","PSODGAL1",108,0) K ^UTILITY($J,"W"),DIWL,DIWR,DIWF,CT,ZX,ZPSODC "RTN","PSODGAL1",109,0) N ZORN,X K ^UTILITY($J,"W") S DIWL=1,DIWR=50,DIWF="" N Z,ZI,ZX,ZOV "RTN","PSODGAL1",110,0) I $G(ORD),'$G(HPOERR),+$G(^PS(52.41,ORD,0)) S ZORN=$P(^PS(52.41,ORD,0),"^") "RTN","PSODGAL1",111,0) I $G(PSOVRXN) S ZORN=$P(^PSRX(PSOVRXN,"OR1"),"^",2) "RTN","PSODGAL1",112,0) I $G(ZRXN) N ZORN,X S ZORN=$P(^PSRX(ZRXN,"OR1"),"^",2) "RTN","PSODGAL1",113,0) ; "RTN","PSODGAL1",114,0) I +$G(PSJORD) D "RTN","PSODGAL1",115,0) .I PSJORD["P" S ZORN=+$P(^PS(53.1,+PSJORD,0),U,21) "RTN","PSODGAL1",116,0) .I PSJORD["U" S ZORN=+$P(^PS(55,DFN,5,+PSJORD,0),U,21) "RTN","PSODGAL1",117,0) .I PSJORD["V" S ZORN=+$P(^PS(55,DFN,"IV",+PSJORD,0),U,21) "RTN","PSODGAL1",118,0) G:'$G(ZORN) NF "RTN","PSODGAL1",119,0) D GETOC4^OROCAPI1(ZORN,.RET) "RTN","PSODGAL1",120,0) F ZI=0:0 S ZI=$O(RET(ZORN,"DATA",ZI)) Q:'ZI I $P(RET(ZORN,"DATA",ZI,1),"^")=3,$G(RET(ZORN,"DATA",ZI,"OR",1,0))]"" S ZOV=$G(RET(ZORN,"DATA",ZI,"OR",1,0)) "RTN","PSODGAL1",121,0) NF W ?3,"Provider Override Reason: " S X=$S($G(ZOV)]"":ZOV,1:"N/A - Order Entered Through VistA") D ^DIWP "RTN","PSODGAL1",122,0) F ZX=0:0 S ZX=$O(^UTILITY($J,"W",1,ZX)) Q:'ZX W ?29,^UTILITY($J,"W",1,ZX,0),! "RTN","PSODGAL1",123,0) K ^UTILITY($J,"W"),DIWL,DIWR,DIWF,ZORN,RET "RTN","PSODGAL1",124,0) ;pso*7*401 "RTN","PSODGAL1",125,0) I $D(PSOMDC) D "RTN","PSODGAL1",126,0) .W !,"Warning: The following drug class does not exist in the VA DRUG CLASS" "RTN","PSODGAL1",127,0) .W !,"file (#50.605). Please do a manual Drug-Allergy order check and notify" "RTN","PSODGAL1",128,0) .W !,"the pharmacy ADPAC for follow up.",! "RTN","PSODGAL1",129,0) .S PSOMDC="" F S PSOMDC=$O(PSOMDC(PSOMDC)) Q:PSOMDC="" W !,"VA Drug Class: "_PSOMDC,! "RTN","PSODGAL1",130,0) .W ! S DIR("A")="Press Return to continue",DIR(0)="E",DIR("?")="Press Return to continue" "RTN","PSODGAL1",131,0) .D ^DIR K DIR W ! "RTN","PSODGAL1",132,0) Q "RTN","PSODGAL1",133,0) ; "RTN","PSODGAL1",134,0) DRCL(DFN) ; "RTN","PSODGAL1",135,0) N RET S RET=0 K GMRADRCL D GETDATA^GMRAOR(DFN) "RTN","PSODGAL1",136,0) Q:'$D(^TMP("GMRAOC",$J,"APC")) 0 "RTN","PSODGAL1",137,0) N GMRACL S GMRACL="" F S GMRACL=$O(^TMP("GMRAOC",$J,"APC",GMRACL)) Q:'$L(GMRACL) D "RTN","PSODGAL1",138,0) .N GMRANM,GMRALOC S GMRALOC=^TMP("GMRAOC",$J,"APC",GMRACL) "RTN","PSODGAL1",139,0) .I '$O(^PS(50.605,"B",GMRACL,0)) S PSOMDC(GMRACL)="" Q ;PSO*7*401 "RTN","PSODGAL1",140,0) .S GMRANM=$P($G(^PS(50.605,+$O(^PS(50.605,"B",GMRACL,0)),0)),U,2) "RTN","PSODGAL1",141,0) .S GMRADRCL(GMRACL)=GMRACL_U_GMRANM_" ("_GMRALOC_")",RET=RET+1 "RTN","PSODGAL1",142,0) K ^TMP("GMRAOC",$J) "RTN","PSODGAL1",143,0) Q RET "RTN","PSODGAL1",144,0) ; "RTN","PSODGAL1",145,0) SYM ;signs/symptom pso*7*390 "RTN","PSODGAL1",146,0) N NDF,ZI,PSCLASS,ZXX,ZLP,ZVAC,CT,XLP,ZLP,I,ZX,ZING S TRU=0 "RTN","PSODGAL1",147,0) S GMRA="0^0^111" D EN1^GMRADPT S NDF=$P(PSODRUG("NDF"),"A") "RTN","PSODGAL1",148,0) N LEN S LEN=4 I $E($G(PSODRUG("VA CLASS")),1,4)="CN10" S LEN=5 "RTN","PSODGAL1",149,0) ; "RTN","PSODGAL1",150,0) F ZI=0:0 S ZI=$O(GMRAL(ZI)) Q:'ZI!($G(TRU)) I $P(GMRAL(ZI),"^",2)=$G(PSODRUG("OIN")) S TRU=ZI "RTN","PSODGAL1",151,0) Q:$G(TRU) "RTN","PSODGAL1",152,0) I $G(PSODRUG("VA CLASS"))]"" S ZI=+$O(^GMR(120.8,"APC",DFN,PSODRUG("VA CLASS"),0)) I ZI S TRU=ZI "RTN","PSODGAL1",153,0) Q:$G(TRU) "RTN","PSODGAL1",154,0) S ZVAC=$E($G(PSODRUG("VA CLASS")),1,LEN) "RTN","PSODGAL1",155,0) S ZDC="" F S ZDC=$O(^GMR(120.8,"APC",DFN,ZDC)) Q:ZDC=""!($G(TRU)) D "RTN","PSODGAL1",156,0) .I $E(ZDC,1,LEN)=ZVAC S TRU=$O(^GMR(120.8,"APC",DFN,ZDC,0)) "RTN","PSODGAL1",157,0) Q:$G(TRU) "RTN","PSODGAL1",158,0) K ZAGNL,^TMP("PSN",$J) N ZIN,ZIIN,ZI "RTN","PSODGAL1",159,0) S PSNDA=PSODRUG("IEN"),PSNID=PSODRUG("NDF") D INGR^PSNNGR "RTN","PSODGAL1",160,0) F ZI=0:0 S ZI=$O(GMRAL(ZI)) Q:'ZI!($G(TRU)) D EN1^GMRAOR2(ZI,"ZAGNL") D "RTN","PSODGAL1",161,0) .F ZIN=0:0 S ZIN=$O(ZAGNL("I",ZIN)) Q:'ZIN!($G(TRU)) F ZIIN=0:0 S ZIIN=$O(^TMP("PSN",$J,ZIIN)) Q:'ZIIN!($G(TRU)) D "RTN","PSODGAL1",162,0) ..I ZAGNL("I",ZIN)=^TMP("PSN",$J,ZIIN) S TRU=ZI "RTN","PSODGAL1",163,0) K ZAGNL,^TMP("PSN",$J) "RTN","PSODGAL1",164,0) Q:$G(TRU) "RTN","PSODGAL1",165,0) F ZI=0:0 S ZI=$O(GMRAL(ZI)) Q:'ZI!($G(TRU)) S ZLP=$P(GMRAL(ZI),"^",9) I $P(ZLP,";")=NDF,$P(ZLP,";",2)="PSNDF(50.6," S TRU=ZI "RTN","PSODGAL1",166,0) Q:$G(TRU) "RTN","PSODGAL1",167,0) S ZVAC=$E($G(PSODRUG("VA CLASS")),1,LEN) "RTN","PSODGAL1",168,0) F ZI=0:0 S ZI=$O(GMRAL(ZI)) Q:'ZI!($G(TRU)) S ZLP=$P(GMRAL(ZI),"^",9) I $P(ZLP,";",2)="PSNDF(50.6," D "RTN","PSODGAL1",169,0) .S CT=$$CLIST^PSNAPIS($P(ZLP,";"),.PSCLASS) "RTN","PSODGAL1",170,0) .F ZXX=0:0 S ZXX=$O(PSCLASS(ZXX)) Q:'ZXX!($G(TRU)) I $E($P(PSCLASS(ZXX),"^",2),1,LEN)=ZVAC S TRU=ZI "RTN","PSODGAL1",171,0) Q:$G(TRU) "RTN","PSODGAL1",172,0) N ZI,ZLP,ZVAC,ZXX,AVAC,ZING,ZXP "RTN","PSODGAL1",173,0) F ZI=0:0 S ZI=$O(GMRAL(ZI)) Q:'ZI!($G(TRU)) S ZLP=$P(GMRAL(ZI),"^",9) I $P(ZLP,";",2)="PS(50.416," D "RTN","PSODGAL1",174,0) .F ZXP=0:0 S ZXP=$O(^PS(50.416,$P(ZLP,";"),1,ZXP)) Q:'ZXP I $P(^PS(50.416,$P(ZLP,";"),1,ZXP,0),"A")=TYP S TRU=ZI "RTN","PSODGAL1",175,0) Q:$G(TRU) "RTN","PSODGAL1",176,0) K ZAGNL N ZIN,ZIIN,ZVAC S ZVAC=$E($G(PSODRUG("VA CLASS")),1,LEN) "RTN","PSODGAL1",177,0) F ZI=0:0 S ZI=$O(GMRAL(ZI)) Q:'ZI!($G(TRU)) D "RTN","PSODGAL1",178,0) .K ZAGNL D EN1^GMRAOR2(ZI,"ZAGNL") K ZIN "RTN","PSODGAL1",179,0) .F ZIN=0:0 S ZIN=$O(ZAGNL("V",ZIN)) Q:'ZIN!($G(TRU)) S ZIIN=$P(ZAGNL("V",ZIN),"^") I $E(ZIIN,1,LEN)=ZVAC S TRU=ZI "RTN","PSODGAL1",180,0) K ZAGNL "RTN","PSODGAL1",181,0) Q "RTN","PSODGAL1",182,0) ; "RTN","PSODGAL1",183,0) SYM1 ;format signs/symptoms "RTN","PSODGAL1",184,0) K ^UTILITY($J,"W"),X S DIWL=1,DIWR=51,DIWF="" "RTN","PSODGAL1",185,0) F ZX=0:0 S ZX=$O(GMRAL(ZI,"S",ZX)) Q:'ZX D "RTN","PSODGAL1",186,0) .S ^TMP("PSODAOC",$J,3,ZX)=$P(GMRAL(ZI,"S",ZX),";",2),X=$P(GMRAL(ZI,"S",ZX),";")_", " D ^DIWP "RTN","PSODGAL1",187,0) W ?4," Signs/Symptoms: " "RTN","PSODGAL1",188,0) F ZX=0:0 S ZX=$O(^UTILITY($J,"W",1,ZX)) Q:'ZX W ?22,^UTILITY($J,"W",1,ZX,0),! "RTN","PSODGAL1",189,0) K ^UTILITY($J,"W"),DIWL,DIWR,DIWF,I,ZX "RTN","PSODGAL1",190,0) Q "RTN","PSODGAL2") 0^24^B20866110^n/a "RTN","PSODGAL2",1,0) PSODGAL2 ;BIR/SAB-displays stored DRUG ALLERGY w/sign/symptoms ;10/27/11 02:22 "RTN","PSODGAL2",2,0) ;;7.0;OUTPATIENT PHARMACY;**390**;DEC 1997;Build 86 "RTN","PSODGAL2",3,0) ;External reference to ^PS(50.605, supported by DBIA 696 "RTN","PSODGAL2",4,0) ;External reference to GETOC4^OROCAPI1 supported by DBIA 5729 "RTN","PSODGAL2",5,0) ;External reference to ^ORD(100.05 supported by DBIA 5731 "RTN","PSODGAL2",6,0) ;External reference to ^GMRD(120.83 supported by DBIA 5767 "RTN","PSODGAL2",7,0) ;External reference to ^VA(200 supported by DBIA 10060 "RTN","PSODGAL2",8,0) ; "RTN","PSODGAL2",9,0) W @IOF "RTN","PSODGAL2",10,0) N ZORN,X,RET,DA,ZCNT,ZCNTT,XXI,ZZQ,DA,ZI,IT,SEVT,SEVN,ZFND S (ZCNT,ZCNTT,ZFND)=0 "RTN","PSODGAL2",11,0) S DA=$P(PSOLST(ORN),"^",2),ZORN=$P(^PSRX(DA,"OR1"),"^",2) "RTN","PSODGAL2",12,0) I 'ZORN W !,"NO Drug Allergy Order Checks found for Rx#: "_$P(^PSRX(DA,0),"^") G EXT "RTN","PSODGAL2",13,0) K ^TMP("PSODAOCD",$J) D GETOC4^OROCAPI1(ZORN,.RET) "RTN","PSODGAL2",14,0) I $O(RET(ZORN,"DATA",""))="" W !,"NO Drug Allergy Order Checks found for Rx#: "_$P(^PSRX(DA,0),"^") G EXT "RTN","PSODGAL2",15,0) F ZI=0:0 S ZI=$O(RET(ZORN,"DATA",ZI)) Q:'ZI I $P(RET(ZORN,"DATA",ZI,1),"^")=3 S ZCNTT=1 "RTN","PSODGAL2",16,0) I 'ZCNTT W !,"NO Drug Allergy Order Checks found for Rx#: "_$P(^PSRX(DA,0),"^") G EXT "RTN","PSODGAL2",17,0) F ZI=0:0 S ZI=$O(RET(ZORN,"DATA",ZI)) Q:'ZI I $P(RET(ZORN,"DATA",ZI,1),"^")=3 D "RTN","PSODGAL2",18,0) .S ZCNT=ZCNT+1,^TMP("PSODAOCD",$J,"AOC",ZCNT,0)=$P(RET(ZORN,"DATA",ZI,0),"^",3)_"^"_$P(^VA(200,$P(RET(ZORN,"DATA",ZI,0),"^",4),0),"^") "RTN","PSODGAL2",19,0) .I $G(RET(ZORN,"DATA",ZI,"OR",1,0))]"" S ^TMP("PSODAOCD",$J,"AOR",$G(RET(ZORN,"DATA",ZI,"OR",1,0)))="" "RTN","PSODGAL2",20,0) .; "RTN","PSODGAL2",21,0) .F XXI=0:0 S XXI=$O(^ORD(100.05,ZI,4,XXI)) Q:'XXI D:$P($G(^ORD(100.05,ZI,4,XXI,0)),"^",3)]"" "RTN","PSODGAL2",22,0) ..S ZFND=1,^TMP("PSODAOCD",$J,"CA",$P(^ORD(100.05,ZI,4,XXI,0),"^",3))="",^TMP("PSODAOCD",$J,"OH")=$P(^ORD(100.05,ZI,4,XXI,0),"^",7) "RTN","PSODGAL2",23,0) ..S IT=+$P(^ORD(100.05,ZI,4,XXI,0),"^",5) "RTN","PSODGAL2",24,0) ..S SEVT=$P(^ORD(100.05,ZI,4,XXI,0),"^",8),SEVN=$S(SEVT=1:"MILD",SEVT=2:"MODERATE",SEVT=3:"SEVERE",1:"Not Entered") "RTN","PSODGAL2",25,0) ..F ZZQ=0:0 S ZZQ=$O(^ORD(100.05,ZI,4,XXI,1,ZZQ)) Q:'ZZQ S ^TMP("PSODAOCD",$J,"DC",$P(^ORD(100.05,ZI,4,XXI,1,ZZQ,0),"^"))=$P(^PS(50.605,$P(^ORD(100.05,ZI,4,XXI,1,ZZQ,0),"^"),0),"^")_" "_$P(^(0),"^",2) "RTN","PSODGAL2",26,0) ..F ZZQ=0:0 S ZZQ=$O(^ORD(100.05,ZI,4,XXI,2,ZZQ)) Q:'ZZQ S ^TMP("PSODAOCD",$J,"DI",$P(^PS(50.416,$P(^ORD(100.05,ZI,4,XXI,2,ZZQ,0),"^"),0),"^"))="" "RTN","PSODGAL2",27,0) ..F ZZQ=0:0 S ZZQ=$O(^ORD(100.05,ZI,4,XXI,3,ZZQ)) Q:'ZZQ S ^TMP("PSODAOCD",$J,"SS",$P(^GMRD(120.83,$P(^ORD(100.05,ZI,4,XXI,3,ZZQ,0),"^"),0),"^"))="" "RTN","PSODGAL2",28,0) I 'ZFND W !,"NO Drug Allergy Order Checks found for Rx#: "_$P(^PSRX(DA,0),"^") G EXT "RTN","PSODGAL2",29,0) K ^UTILITY($J,"W") S DIWL=1,DIWR=55,DIWF="" N Z,ZI,ZX "RTN","PSODGAL2",30,0) D FULL^VALM1 N ING,SS,DC,CA,OH,CAG S (ING,SS,DC,CA)="" "RTN","PSODGAL2",31,0) S CA=$O(^TMP("PSODAOCD",$J,"CA","")) "RTN","PSODGAL2",32,0) W !,"Drug Allergy Occurrence Event for Rx#: "_$P(^PSRX(DA,0),"^"),! "RTN","PSODGAL2",33,0) S CAG="^"_$P(CA,";",2)_$P(CA,";")_",0)" "RTN","PSODGAL2",34,0) W !," Causative Agent: "_$S(CA="None Found":CA,1:$P(@(CAG),"^")) "RTN","PSODGAL2",35,0) S OH=$G(^TMP("PSODAOCD",$J,"OH")) W !,"Historical/Observed: "_$S(OH="H":"HISTORICAL",OH="O":"OBSERVED",1:"Not Entered") "RTN","PSODGAL2",36,0) W !," Severity: "_SEVN "RTN","PSODGAL2",37,0) W !," Ingredient: " I $O(^TMP("PSODAOCD",$J,"DI",""))]"" D "RTN","PSODGAL2",38,0) .F S ING=$O(^TMP("PSODAOCD",$J,"DI",ING)) Q:ING="" S X=ING_", " D ^DIWP "RTN","PSODGAL2",39,0) .F ZX=0:0 S ZX=$O(^UTILITY($J,"W",1,ZX)) Q:'ZX W ?21,^UTILITY($J,"W",1,ZX,0),! "RTN","PSODGAL2",40,0) .K ^UTILITY($J,"W") S DIWL=1,DIWR=55,DIWF="" N Z,ZI,ZX "RTN","PSODGAL2",41,0) E W "None Entered",! "RTN","PSODGAL2",42,0) ; "RTN","PSODGAL2",43,0) W " Signs/Symptoms: " I $O(^TMP("PSODAOCD",$J,"SS",""))]"" D "RTN","PSODGAL2",44,0) .F S SS=$O(^TMP("PSODAOCD",$J,"SS",SS)) Q:SS="" S X=SS_", " D ^DIWP "RTN","PSODGAL2",45,0) .F ZX=0:0 S ZX=$O(^UTILITY($J,"W",1,ZX)) Q:'ZX W ?21,^UTILITY($J,"W",1,ZX,0),! "RTN","PSODGAL2",46,0) .K ^UTILITY($J,"W") S DIWL=1,DIWR=55,DIWF="" N Z,ZI,ZX "RTN","PSODGAL2",47,0) E W "None Entered",! "RTN","PSODGAL2",48,0) ; "RTN","PSODGAL2",49,0) W " Drug Class: " I $O(^TMP("PSODAOCD",$J,"DC",0))]"" D "RTN","PSODGAL2",50,0) .F DC=0:0 S DC=$O(^TMP("PSODAOCD",$J,"DC",DC)) Q:'DC S X=^TMP("PSODAOCD",$J,"DC",DC)_", " D ^DIWP "RTN","PSODGAL2",51,0) .F ZX=0:0 S ZX=$O(^UTILITY($J,"W",1,ZX)) Q:'ZX W ?21,^UTILITY($J,"W",1,ZX,0),! "RTN","PSODGAL2",52,0) .K ^UTILITY($J,"W") S DIWL=1,DIWR=55,DIWF="" N Z,ZI,ZX "RTN","PSODGAL2",53,0) E W "None Found",! "RTN","PSODGAL2",54,0) ; "RTN","PSODGAL2",55,0) K ^UTILITY($J,"W") S DIWL=1,DIWR=55,DIWF="" N Z,ZI,ZX,OR "RTN","PSODGAL2",56,0) S OR="" W "Provider Override Reason: " I $O(^TMP("PSODAOCD",$J,"AOR",""))]"" D "RTN","PSODGAL2",57,0) .S OR=$O(^TMP("PSODAOCD",$J,"AOR","")) S X=OR D ^DIWP "RTN","PSODGAL2",58,0) .F ZX=0:0 S ZX=$O(^UTILITY($J,"W",1,ZX)) Q:'ZX W ?26,^UTILITY($J,"W",1,ZX,0),! "RTN","PSODGAL2",59,0) E W "N/A - Order Entered Through VistA",! "RTN","PSODGAL2",60,0) I $G(IT) D "RTN","PSODGAL2",61,0) .K DIC,DR,DIQ,DA,INTY S DIC=9009032.4,DA=IT,DR=".01;.03;.04;.08",DIQ="INTY" D EN^DIQ1 "RTN","PSODGAL2",62,0) .W !," Intervention Date: "_INTY(9009032.4,IT,.01) "RTN","PSODGAL2",63,0) .W !," Provider: "_INTY(9009032.4,IT,.03) "RTN","PSODGAL2",64,0) .W !," Pharmacist: "_INTY(9009032.4,IT,.04) "RTN","PSODGAL2",65,0) .W !," Recommendation: "_INTY(9009032.4,IT,.08) "RTN","PSODGAL2",66,0) .K DIC,DR,DIQ,DA,INTY "RTN","PSODGAL2",67,0) E W !," Pharmacist Intervention Not Entered" "RTN","PSODGAL2",68,0) EXT W ! "RTN","PSODGAL2",69,0) K DIR,DUOUT,DIRUT,ZFND "RTN","PSODGAL2",70,0) S DIR(0)="E",DIR("A")="Press Return to Continue",DIR("?")="Press Return to Redisplay Rx." "RTN","PSODGAL2",71,0) D ^DIR S VALMBCK="R" K DIR,DUOUT,DIRUT,^TMP("PSODAOCD",$J) "RTN","PSODRG") 0^19^B74687625^B71911727 "RTN","PSODRG",1,0) PSODRG ;IHS/DSD/JCM - ORDER ENTRY DRUG SELECTION ; 2/16/12 12:50pm "RTN","PSODRG",2,0) ;;7.0;OUTPATIENT PHARMACY;**20,23,36,53,54,46,112,139,207,148,243,268,324,251,375,387,398,390**;DEC 1997;Build 86 "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:'$D(PSODGCK) @$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) I '$D(PSODGCKX) D ^PSODGAL1 K PSORX("INTERVENE") "RTN","PSODRG",114,0) ;This is the allergy check for profile drugs "RTN","PSODRG",115,0) I $D(PSODGCK),$D(PSOSD) D PRFLP^PSOUTL "RTN","PSODRG",116,0) ;aminoglycoside "RTN","PSODRG",117,0) N AOC "RTN","PSODRG",118,0) D HD^PSODDPR2():(($Y+5)'>IOSL) "RTN","PSODRG",119,0) S AOC=$$AOC^OROCAPI(PSODFN,$P(PSODRUG("NDF"),"A",2)) I $P(AOC,"^",4)]"" D "RTN","PSODRG",120,0) .W !!,"***Aminoglycoside Ordered***",!! "RTN","PSODRG",121,0) .K ^UTILITY($J,"W") S DIWL=1,DIWR=78,DIWF="" S X=$P(AOC,"^",4) D ^DIWP "RTN","PSODRG",122,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",123,0) .K ^UTILITY($J,"W") "RTN","PSODRG",124,0) D HD^PSODDPR2():(($Y+5)'>IOSL) "RTN","PSODRG",125,0) ;dangerous meds for pat >64 "RTN","PSODRG",126,0) I $G(PSODRUG("OI")) D "RTN","PSODRG",127,0) .N OI,OIR S OI=$$OITM^ORX8(PSODRUG("OI"),"99PSP") Q:'OI "RTN","PSODRG",128,0) .S OIR=$$DOC^OROCAPI(PSODFN,OI) I $P(OIR,"^",4)]"" D "RTN","PSODRG",129,0) ..D HD^PSODDPR2():(($Y+5)'>IOSL) W !!,"***Dangerous Meds for Patient >64***",!! S DFN=PSODFN D DEM^VADPT "RTN","PSODRG",130,0) ..K ^UTILITY($J,"W") S DIWL=1,DIWR=78,DIWF="" S X=$P(OIR,"^",4) D ^DIWP "RTN","PSODRG",131,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",132,0) ..K ^UTILITY($J,"W") "RTN","PSODRG",133,0) D HD^PSODDPR2():(($Y+5)'>IOSL) "RTN","PSODRG",134,0) ;metformin lab results "RTN","PSODRG",135,0) N GOC S GOC=$$GOC^OROCAPI(PSODFN,PSODRUG("NAME")) I $P(GOC,"^",4)]"" D "RTN","PSODRG",136,0) .W !!,"***Metformin Lab Results***",!! "RTN","PSODRG",137,0) .K ^UTILITY($J,"W") S DIWL=1,DIWR=78,DIWF="" S X=$P(GOC,"^",4) D ^DIWP "RTN","PSODRG",138,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",139,0) .K ^UTILITY($J,"W") "RTN","PSODRG",140,0) D HD^PSODDPR2():(($Y+5)'>IOSL) "RTN","PSODRG",141,0) K DIWF,DIWL,DIWR,ZX,DFN "RTN","PSODRG",142,0) I $G(PSODRUG("DEA"))["S"!($E($G(PSODRUG("VA CLASS")),1,2)="XA") D G POSTX ;stops if drug is supply "RTN","PSODRG",143,0) .W !,"Now Processing Enhanced Order Checks! Please wait...",! H 1 "RTN","PSODRG",144,0) ;enhanced OC "RTN","PSODRG",145,0) D HD^PSODDPR2():(($Y+5)'>IOSL) "RTN","PSODRG",146,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",147,0) POSTX ; "RTN","PSODRG",148,0) K IT,^TMP($J,"DI"),PSORX("INTERVENE"),DA,^TMP($J,"PSODRDI"),ZDGDG,ZTHER K ^TMP($J,"DI"_PSODFN),PSZZQUIT "RTN","PSODRG",149,0) Q "RTN","PSODRG",150,0) ; "RTN","PSODRG",151,0) EOJ ; "RTN","PSODRG",152,0) K PSODRG "RTN","PSODRG",153,0) Q "RTN","PSODRG",154,0) WAIT ; "RTN","PSODRG",155,0) K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to continue..." W ! "RTN","PSODRG",156,0) D ^DIR K DIRUT,DUOUT,DIR,X,Y "RTN","PSODRG",157,0) Q "RTN","PSODRG",158,0) ; "RTN","PSODRG",159,0) CLOZ ; "RTN","PSODRG",160,0) S ANQRTN=$P(^PSDRUG(PSODRUG("IEN"),"CLOZ1"),"^"),ANQX=0 "RTN","PSODRG",161,0) S P(5)=PSODRUG("IEN"),DFN=PSODFN,X=ANQRTN "RTN","PSODRG",162,0) X ^%ZOSF("TEST") I D @("^"_ANQRTN) S:$G(ANQX) PSORX("DFLG")=1 "RTN","PSODRG",163,0) K P(5),ANQRTN,ANQX,X,DFN "RTN","PSODRG",164,0) Q "RTN","PSODRG",165,0) ; "RTN","PSODRG",166,0) EN(DRG) ;returns lab test identified for clozapine order checking "RTN","PSODRG",167,0) K LAB I $P($G(^PSDRUG(DRG,"CLOZ1")),"^")'="PSOCLO1" S LAB("NOT")=0 Q "RTN","PSODRG",168,0) I $P($G(^PSDRUG(DRG,"CLOZ1")),"^")="PSOCLO1" D "RTN","PSODRG",169,0) .S (CNT,I)=0 F S I=$O(^PSDRUG(DRG,"CLOZ2",I)) Q:'I S CNT=$G(CNT)+1 "RTN","PSODRG",170,0) .I CNT'=2 S LAB("BAD TEST")=0 K CNT Q "RTN","PSODRG",171,0) .K CNT F I=0:0 S I=$O(^PSDRUG(DRG,"CLOZ2",I)) Q:'I D "RTN","PSODRG",172,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",173,0) K LABT,I "RTN","PSODRG",174,0) Q "RTN","PSODRG",175,0) NOALRGY ; "RTN","PSODRG",176,0) D HD^PSODDPR2():(($Y+5)'>IOSL) "RTN","PSODRG",177,0) N DIR S DIR(0)="SA^1:YES;0:NO" "RTN","PSODRG",178,0) I $D(^TMP($J,"PSOINTERVENE",+PSODFN)) D Q "RTN","PSODRG",179,0) .S DIR("A")="No Allergy Assessment - Do you want to duplicate Intervention?: ",DIR("B")="Yes" "RTN","PSODRG",180,0) .D ^DIR "RTN","PSODRG",181,0) .I 'Y D Q "RTN","PSODRG",182,0) ..I Y=0 D ^PSORXI Q "RTN","PSODRG",183,0) ..S PSORX("DFLG")=1 "RTN","PSODRG",184,0) .D DUPINV^PSORXI "RTN","PSODRG",185,0) W $C(7),!,"There is no allergy assessment on file for this patient." "RTN","PSODRG",186,0) W !,"You will be prompted to intervene if you continue with this prescription" "RTN","PSODRG",187,0) I $D(PSODGCK) W ! K DIR S DIR(0)="E",DIR("A")="Press Return to Continue..." D ^DIR K DIR "RTN","PSODRG",188,0) Q:$D(PSODGCK) "RTN","PSODRG",189,0) N DUOUT,DTOUT,RXIEN,RXSTA ;*398 "RTN","PSODRG",190,0) S DIR("A")="Do you want to Continue?: ",DIR("B")="N" D ^DIR "RTN","PSODRG",191,0) I 'Y!($D(DUOUT))!($D(DTOUT)) D Q ;*398 - Exit/Timeout "RTN","PSODRG",192,0) .I $D(PSONV) S PSZZQUIT=1 Q "RTN","PSODRG",193,0) .S PSORX("DFLG")=1 "RTN","PSODRG",194,0) .I '$O(PSCAN(0)) Q ;*398 - Array has Rx IEN "RTN","PSODRG",195,0) .I $G(REA)'="R" Q ;*398 - Reinstate only "RTN","PSODRG",196,0) .S RXIEN=+$G(PSCAN(RX)) I 'RXIEN Q ;*398 - Get Rx IEN "RTN","PSODRG",197,0) .S RXSTA=$$GET1^DIQ(52,RXIEN,100,"I") ;*398 - Get status "RTN","PSODRG",198,0) .I RXSTA=12 Q ;*398 - Correct status "RTN","PSODRG",199,0) .S DIE="^PSRX(",DA=RXIEN,DR="100///12" ;*398 - Discontinued "RTN","PSODRG",200,0) .D ^DIE ;*398 - Update Rx file "RTN","PSODRG",201,0) I $D(PSONV) S PSORX("INTERVENE")=0 D EN1^PSORXI(PSONV) Q "RTN","PSODRG",202,0) D ^PSORXI "RTN","PSODRG",203,0) Q "RTN","PSOLMUTL") 0^33^B14836265^B13307787 "RTN","PSOLMUTL",1,0) PSOLMUTL ;BIR/SAB - listman utilities ;03/07/95 "RTN","PSOLMUTL",2,0) ;;7.0;OUTPATIENT PHARMACY;**19,46,84,99,131,132,148,268,225,305,386,390**;DEC 1997;Build 86 "RTN","PSOLMUTL",3,0) ;External reference FULL^VALM1 supported by dbia 10116 "RTN","PSOLMUTL",4,0) ;External reference $$SETSTR^VALM1 supported by dbia 10116 "RTN","PSOLMUTL",5,0) ;External reference EN2^GMRAPEMO supported by dbia 190 "RTN","PSOLMUTL",6,0) ;External reference to ^ORD(101 supported by DBIA 872 "RTN","PSOLMUTL",7,0) ;External reference to RE^VALM4 supported by dbia 10120 "RTN","PSOLMUTL",8,0) ; "RTN","PSOLMUTL",9,0) EN W @IOF S VALMCNT=0 "RTN","PSOLMUTL",10,0) D:'$D(PSOPAR) ^PSOLSET I '$D(PSOPAR) W $C(7),!!?5,"Site parameter must be defined!",! G INITQ "RTN","PSOLMUTL",11,0) D EN^PSOLMPI "RTN","PSOLMUTL",12,0) INITQ Q "RTN","PSOLMUTL",13,0) HDR ;patient med profile display "RTN","PSOLMUTL",14,0) K VALMHDR S HDR=^TMP("PSOHDR",$J,1,0) "RTN","PSOLMUTL",15,0) S:^TMP("PSOHDR",$J,8,0) X=IORVON_""_IORVOFF,HDR=$$SETSTR^VALM1(X,HDR,80-$L(X),80) S VALMHDR(1)=HDR "RTN","PSOLMUTL",16,0) I '(^TMP("PSOHDR",$J,8,0)) S PSONOAL="" D ALLERGY^PSOORUT2 I PSONOAL'="" D K PSONOAL "RTN","PSOLMUTL",17,0) .S X=IORVON_""_IORVOFF,HDR=$$SETSTR^VALM1(X,HDR,80-$L(X),80) S VALMHDR(1)=HDR "RTN","PSOLMUTL",18,0) S HDR=" PID: "_^TMP("PSOHDR",$J,2,0) "RTN","PSOLMUTL",19,0) S VALMHDR(2)=$$SETSTR^VALM1("Ht(cm): "_^TMP("PSOHDR",$J,7,0),HDR,52,27) "RTN","PSOLMUTL",20,0) S HDR=" DOB: "_^TMP("PSOHDR",$J,3,0)_" ("_^TMP("PSOHDR",$J,4,0)_")" "RTN","PSOLMUTL",21,0) S VALMHDR(3)=$$SETSTR^VALM1(" Wt(kg): "_^TMP("PSOHDR",$J,6,0),HDR,51,28) "RTN","PSOLMUTL",22,0) S HDR=" SEX: "_$E(^TMP("PSOHDR",$J,5,0),1,44) "RTN","PSOLMUTL",23,0) S VALMHDR(4)=HDR "RTN","PSOLMUTL",24,0) S $P(VALMHDR(4)," ",30)=" "_$E(^TMP("PSOHDR",$J,5,0),48,80) "RTN","PSOLMUTL",25,0) Q:$G(PS)="VIEW"!($G(PS)="DELETE") "RTN","PSOLMUTL",26,0) K HDR S HDR=$G(^TMP("PSOHDR",$J,13,0)) "RTN","PSOLMUTL",27,0) I $G(HDR)]"" D Q "RTN","PSOLMUTL",28,0) .S VALMHDR(5)=$$SETSTR^VALM1(" BSA (m2): "_^TMP("PSOHDR",$J,12,0),HDR,49,19) "RTN","PSOLMUTL",29,0) .S VALMHDR(6)=$G(^TMP("PSOHDR",$J,9,0)) "RTN","PSOLMUTL",30,0) .S VALMHDR(7)=$G(^TMP("PSOHDR",$J,10,0)) "RTN","PSOLMUTL",31,0) .S VALMHDR(8)=$G(^TMP("PSOHDR",$J,11,0)) "RTN","PSOLMUTL",32,0) S VALMHDR(5)=$G(^TMP("PSOHDR",$J,9,0)) "RTN","PSOLMUTL",33,0) S VALMHDR(6)=$G(^TMP("PSOHDR",$J,10,0)) "RTN","PSOLMUTL",34,0) Q "RTN","PSOLMUTL",35,0) ; "RTN","PSOLMUTL",36,0) NEWALL(DFN) ; Enter Allergy info. "RTN","PSOLMUTL",37,0) N PSOID D FULL^VALM1,EN2^GMRAPEM0,^PSOORUT2 S VALMBCK="R" "RTN","PSOLMUTL",38,0) Q "RTN","PSOLMUTL",39,0) NEWSEL ;allows order selection by number instead of action "RTN","PSOLMUTL",40,0) S Y=$P(XQORNOD(0),"=",2) N VALMCNT D NEWSEL^PSOORNE2 "RTN","PSOLMUTL",41,0) Q "RTN","PSOLMUTL",42,0) EDTSEL ;allows edit selection by number instead of action - active orders "RTN","PSOLMUTL",43,0) N VALMCNT S Y=$P(XQORNOD(0),"=",2) D EDTSEL^PSOOREDT "RTN","PSOLMUTL",44,0) Q "RTN","PSOLMUTL",45,0) SELAL ;selection of allergy by number instead of action - select allergy "RTN","PSOLMUTL",46,0) N VALMCNT S Y=$P(XQORNOD(0),"=",2) D SELAL^PSOORDA "RTN","PSOLMUTL",47,0) Q "RTN","PSOLMUTL",48,0) EDTNEW ;allows edit selection by number instead of action - new orders "RTN","PSOLMUTL",49,0) N VALMCNT S Y=$P(XQORNOD(0),"=",2) D EDTSEL^PSOORNE1 "RTN","PSOLMUTL",50,0) Q "RTN","PSOLMUTL",51,0) EDTRNEW ;allows edit selection by number instead of action - renew orders "RTN","PSOLMUTL",52,0) N VALMCNT S Y=$P(XQORNOD(0),"=",2) D EDTSEL^PSOORNE4 "RTN","PSOLMUTL",53,0) Q "RTN","PSOLMUTL",54,0) EDTPEN ;allows edit selection by number instead of action - pending orders "RTN","PSOLMUTL",55,0) N VALMCNT S Y=$P(XQORNOD(0),"=",2),SEDT=1 G EDTSEL^PSOORNEW "RTN","PSOLMUTL",56,0) Q "RTN","PSOLMUTL",57,0) HLDHDR ;keeps patient's header info "RTN","PSOLMUTL",58,0) S IOTM=VALM("TM"),IOBM=IOSL W IOSC W @IOSTBM W IORC "RTN","PSOLMUTL",59,0) Q "RTN","PSOLMUTL",60,0) ; "RTN","PSOLMUTL",61,0) BYPASS S:$G(PSOFDR) SIGOK=1 S Y=-1,VALMBCK="Q" "RTN","PSOLMUTL",62,0) Q "RTN","PSOLMUTL",63,0) ACTIONS() ;screen actions on active orders "RTN","PSOLMUTL",64,0) Q:$G(PKI1)=2 0 "RTN","PSOLMUTL",65,0) N DIC,X,Y K DIC,Y S DIC="^ORD(101,"_DA(1)_",10,",X=DA,DIC(0)="ZN" D ^DIC Q:Y<0 0 "RTN","PSOLMUTL",66,0) S Y=Y(0,0) "RTN","PSOLMUTL",67,0) I Y="PSO REFILL" Q $S(PSOACT["R":1,1:0) "RTN","PSOLMUTL",68,0) I Y="PSO RENEW" Q $S(PSOACT["N":1,1:0) "RTN","PSOLMUTL",69,0) I Y="PSO REPRINT" Q $S(PSOACT["P":1,1:0) "RTN","PSOLMUTL",70,0) I Y="PSO EDIT ORDERS" Q $S(PSOACT["E":1,1:0) "RTN","PSOLMUTL",71,0) I Y="PSO RELEASE" Q $S(PSOACT["L":1,1:0) "RTN","PSOLMUTL",72,0) I Y="PSO PARTIAL" Q $S(PSOACT["T":1,1:0) "RTN","PSOLMUTL",73,0) I Y="PSO CANCEL" Q $S(PSOACT["D":1,1:0) "RTN","PSOLMUTL",74,0) I Y="PSO HOLD" Q $S(PSOACT["H":1,1:0) "RTN","PSOLMUTL",75,0) I Y="PSO UNHOLD" Q $S(PSOACT["U":1,1:0) "RTN","PSOLMUTL",76,0) I Y="PSO LM BACKDOOR COPY" Q $S(PSOACT["C":1,1:0) "RTN","PSOLMUTL",77,0) I Y="PSO VERIFY" Q $S(PSOACT["V":1,1:0) "RTN","PSOLMUTL",78,0) I Y="PSO ACTIVITY LOGS" Q 1 "RTN","PSOLMUTL",79,0) Q 1 "RTN","PSOLMUTL",80,0) ACTIONS1() ;screen actions on pending orders "RTN","PSOLMUTL",81,0) Q:$G(PKI1)=2 0 "RTN","PSOLMUTL",82,0) N DIC,X,Y K DIC,Y S DIC="^ORD(101,"_DA(1)_",10,",X=DA,DIC(0)="ZN" D ^DIC Q:Y<0 0 "RTN","PSOLMUTL",83,0) S Y=Y(0,0) "RTN","PSOLMUTL",84,0) I Y="PSO LM DISCONTINUE" Q $S(PSOACT["D":1,1:0) "RTN","PSOLMUTL",85,0) I Y="PSO LM EDIT" Q $S(PSOACT["E":1,1:0) "RTN","PSOLMUTL",86,0) I Y="PSO LM FINISH" Q $S(PSOACT["F":1,1:0) "RTN","PSOLMUTL",87,0) I Y="PSO LM FLAG" Q $S(PSOACT["X":1,1:0) "RTN","PSOLMUTL",88,0) Q 1 "RTN","PSOLMUTL",89,0) PKIACT() ;screen actions on pending orders DEA/PKI proj. "RTN","PSOLMUTL",90,0) Q:$G(PKI1)=2 0 "RTN","PSOLMUTL",91,0) N DIC,X,Y K DIC,Y S DIC="^ORD(101,"_DA(1)_",10,",X=DA,DIC(0)="ZN" D ^DIC Q:Y<0 0 "RTN","PSOLMUTL",92,0) S Y=Y(0,0) "RTN","PSOLMUTL",93,0) I Y="PSO LM DISCONTINUE" Q $S(PSOACT["D":1,1:0) "RTN","PSOLMUTL",94,0) I Y="PSO LM RENEW EDIT" Q $S(PSOACT["E":1,1:0) "RTN","PSOLMUTL",95,0) I Y="PSO LM FLAG",'$G(PSOFDR) Q 0 "RTN","PSOLMUTL",96,0) I Y="PSO LM FLAG",$G(PSOFDR) Q $S(PSOACT["X":1,1:0) "RTN","PSOLMUTL",97,0) Q 1 "RTN","PSOLMUTL",98,0) RFDSP ;screen action to toggle display of prescriptions between LAST FILL date and LAST RELEASE Date. "RTN","PSOLMUTL",99,0) S PSORFG='$G(PSORFG) "RTN","PSOLMUTL",100,0) I '$D(PSOSD) D ^PSOBUILD "RTN","PSOLMUTL",101,0) D ^PSOORUT2,BLD^PSOORUT1 "RTN","PSOLMUTL",102,0) K VALMHDR "RTN","PSOLMUTL",103,0) D RE^VALM4 "RTN","PSOLMUTL",104,0) Q "RTN","PSON52") 0^25^B65058460^B65058460 "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,379,390**;DEC 1997;Build 86 "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 5425 "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 PSOTFIN "RTN","PSON52",101,0) I '$D(^XUSEC("PSORPH",DUZ)) S PSOTFIN="",PSOTFIN=$$TECH2^PSODGDGP(PSOX("IRXN"),PSODFN,DUZ,.PSOX) "RTN","PSON52",102,0) I '$D(^XUSEC("PSORPH",DUZ)) G FINISHP:$G(PSOTFIN)=1 G FINISHX:$G(PSOTFIN)=2 "RTN","PSON52",103,0) ; "RTN","PSON52",104,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",105,0) ; "RTN","PSON52",106,0) ; - Calling ECME for claims generation and transmission / REJECT handling "RTN","PSON52",107,0) N ACTION,PSOERX "RTN","PSON52",108,0) S PSOERX=PSOX("IRXN") "RTN","PSON52",109,0) I $$SUBMIT^PSOBPSUT(PSOERX,0) D I ACTION="Q"!(ACTION="^") Q "RTN","PSON52",110,0) . S ACTION="" D ECMESND^PSOBPSU1(PSOERX,0,"","OF") "RTN","PSON52",111,0) . ; Quit if there is an unresolved Tricare/CHAMPVA non-billable reject code, PSO*7*358 "RTN","PSON52",112,0) . I $$PSOET^PSOREJP3(PSOERX,0) S ACTION="Q" Q "RTN","PSON52",113,0) . I $$FIND^PSOREJUT(PSOERX,0) D "RTN","PSON52",114,0) . . S ACTION=$$HDLG^PSOREJU1(PSOERX,0,"79,88","OF","IOQ","Q") "RTN","PSON52",115,0) . I $$STATUS^PSOBPSUT(PSOERX,0)="E PAYABLE" D "RTN","PSON52",116,0) . . D SAVNDC^PSSNDCUT(+$$GET1^DIQ(52,PSOERX,6,"I"),$G(PSOSITE),$$GETNDC^PSONDCUT(PSOERX,0)) "RTN","PSON52",117,0) ; "RTN","PSON52",118,0) FINISHP ; "RTN","PSON52",119,0) I $G(PSORX("PSOL",1))']"" S PSORX("PSOL",1)=PSOX("IRXN")_",",RXFL(PSOX("IRXN"))=0 G FINISHX "RTN","PSON52",120,0) F PSOX1=0:0 S PSOX1=$O(PSORX("PSOL",PSOX1)) Q:'PSOX1 S PSOX2=PSOX1 "RTN","PSON52",121,0) I $L(PSORX("PSOL",PSOX2))+$L(PSOX("IRXN"))<220 S PSORX("PSOL",PSOX2)=PSORX("PSOL",PSOX2)_PSOX("IRXN")_"," "RTN","PSON52",122,0) E S PSORX("PSOL",PSOX2+1)=PSOX("IRXN")_"," "RTN","PSON52",123,0) S RXFL(PSOX("IRXN"))=0 "RTN","PSON52",124,0) FINISHX ;call to build Rx array for bingo board "RTN","PSON52",125,0) I $G(PSORX("MAIL/WINDOW"))["W" S BINGCRT=1,BINGRTE="W",BBFLG=1 D BBRX^PSORN52C "RTN","PSON52",126,0) K PSOX1,PSOX2 "RTN","PSON52",127,0) K ^TMP("PSODGI",$J),^TMP("PSOSER",$J),^TMP("PSOSERS",$J),^TMP("PSODGS",$J),^TMP("PSOTDD",$J),^TMP("PSODOSF",$J) "RTN","PSON52",128,0) Q "RTN","PSON52",129,0) EOJ ; "RTN","PSON52",130,0) ;B xref locked in routine PSONRXN "RTN","PSON52",131,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",132,0) D PSOUL^PSSLOCK(PSOX("IRXN")) "RTN","PSON52",133,0) Q "RTN","PSON52",134,0) ; "RTN","PSON52",135,0) ;;PSOX("SIG");;SIG;;1 "RTN","PSON52",136,0) DD ;;PSOX("RX #");;0;;1 "RTN","PSON52",137,0) ;;PSOX("ISSUE DATE");;0;;13 "RTN","PSON52",138,0) ;;PSODFN;;0;;2 "RTN","PSON52",139,0) ;;PSOX("PATIENT STATUS");;0;;3 "RTN","PSON52",140,0) ;;PSOX("PROVIDER");;0;;4 "RTN","PSON52",141,0) ;;PSOX("CLINIC");;0;;5 "RTN","PSON52",142,0) ;;PSODRUG("IEN");;0;;6 "RTN","PSON52",143,0) ;;PSODRUG("TRADE NAME");;TN;;1 "RTN","PSON52",144,0) ;;PSOX("QTY");;0;;7 "RTN","PSON52",145,0) ;;PSOX("DAYS SUPPLY");;0;;8 "RTN","PSON52",146,0) ;;PSOX("# OF REFILLS");;0;;9 "RTN","PSON52",147,0) ;;PSOX("COPIES");;0;;18 "RTN","PSON52",148,0) ;;PSOX("MAIL/WINDOW");;0;;11 "RTN","PSON52",149,0) ;;PSOX("REMARKS");;3;;7 "RTN","PSON52",150,0) ;;PSOX("CLERK CODE");;0;;16 "RTN","PSON52",151,0) ;;PSODRUG("COST");;0;;17 "RTN","PSON52",152,0) ;;PSOSITE;;2;;9 "RTN","PSON52",153,0) ;;PSOX("LOGIN DATE");;2;;1 "RTN","PSON52",154,0) ;;PSOX("FILL DATE");;2;;2 "RTN","PSON52",155,0) ;;PSOX("PHARMACIST");;2;;3 "RTN","PSON52",156,0) ;;PSOX("LOT #");;2;;4 "RTN","PSON52",157,0) ;;PSOX("DISPENSED DATE");;2;;5 "RTN","PSON52",158,0) ;;PSOX("STOP DATE");;2;;6 "RTN","PSON52",159,0) ;;PSODRUG("NDC");;2;;7 "RTN","PSON52",160,0) ;;PSODRUG("DAW");;EPH;;1 "RTN","PSON52",161,0) ;;PSODRUG("MANUFACTURER");;2;;8 "RTN","PSON52",162,0) ;;PSOX("EXPIRATION DATE");;2;;11 "RTN","PSON52",163,0) ;;PSOX("GENERIC PROVIDER");;2;;12 "RTN","PSON52",164,0) ;;PSOX("RELEASED DATE/TIME");;2;;13 "RTN","PSON52",165,0) ;;PSOX("METHOD OF PICK-UP");;MP;;1 "RTN","PSON52",166,0) ;;PSOX("STATUS");;STA;;1 "RTN","PSON52",167,0) ;;PSOX("LAST DISPENSED DATE");;3;;1 "RTN","PSON52",168,0) ;;PSOX("NEXT POSSIBLE REFILL");;3;;2 "RTN","PSON52",169,0) ;;PSOX("COSIGNING PROVIDER");;3;;3 "RTN","PSON52",170,0) ;;PSOX("TYPE OF RX");;TYPE;;1 "RTN","PSON52",171,0) ;;PSOX("SAND");;SAND;;1 "RTN","PSON52",172,0) ;;PSOX("POE");;POE;;1 "RTN","PSON52",173,0) ;;PSOX("INS");;INS;;1 "RTN","PSONEW") 0^26^B41741762^B28865824 "RTN","PSONEW",1,0) PSONEW ;BIR/SAB-new rx order main driver ;07/26/96 "RTN","PSONEW",2,0) ;;7.0;OUTPATIENT PHARMACY;**11,27,32,46,94,130,268,225,251,379,390**;DEC 1997;Build 86 "RTN","PSONEW",3,0) ;External references L and UL^PSSLOCK supported by DBIA 2789 "RTN","PSONEW",4,0) ;External reference to ^VA(200 supported by DBIA 224 "RTN","PSONEW",5,0) ;External reference to ^XUSEC supported by DBIA 10076 "RTN","PSONEW",6,0) ;External reference to ^ORX1 supported by DBIA 2186 "RTN","PSONEW",7,0) ;External reference to ^ORX2 supported by DBIA 867 "RTN","PSONEW",8,0) ;External reference to ^TIUEDIT supported by DBIA 2410 "RTN","PSONEW",9,0) ;External reference to SAVEOC4^OROCAPI1 supported by DBIA 5729 "RTN","PSONEW",10,0) ;External reference to ^ORD(100.05, supported by DBIA 5731 "RTN","PSONEW",11,0) ;--------------------------------------------------------------- "RTN","PSONEW",12,0) OERR ;backdoor new rx for v7 "RTN","PSONEW",13,0) K PSOREEDT,COPY,SPEED,PSOEDIT,DUR,DRET N PSOCKCON,PSODAOC "RTN","PSONEW",14,0) S PSOPLCK=$$L^PSSLOCK(PSODFN,0) I '$G(PSOPLCK) D LOCK^PSOORCPY S VALMSG=$S($P($G(PSOPLCK),"^",2)'="":$P($G(PSOPLCK),"^",2)_" is working on this patient.",1:"Another person is entering orders for this patient.") K PSOPLCK S VALMBCK="" Q "RTN","PSONEW",15,0) K PSOPLCK S X=PSODFN_";DPT(" D LK^ORX2 I 'Y S VALMSG="Another person is entering orders for this patient.",VALMBCK="" D UL^PSSLOCK(PSODFN) Q "RTN","PSONEW",16,0) AGAIN N VALMCNT K PSODRUG,PSOCOU,PSOCOUU,PSONOOR,PSORX("FN"),PSORX("DFLG"),PSOQUIT,POERR S PSORX("DFLG")=0 "RTN","PSONEW",17,0) W ! D HLDHDR^PSOLMUTL S (PSONEW("QFLG"),PSONEW("DFLG"),PSOQUIT)=0,PSOFROM="NEW",PSONOEDT=1 "RTN","PSONEW",18,0) K ORD D FULL^VALM1,^PSONEW1 ; Continue order entry "RTN","PSONEW",19,0) I PSONEW("QFLG") G END "RTN","PSONEW",20,0) I PSONEW("DFLG") W !,$C(7),"RX DELETED",! S:$G(POERR) POERR("DFLG")=1,VALMBCK="Q" G END "RTN","PSONEW",21,0) D:$P($G(PSOPAR),"^",7)=1 AUTO^PSONRXN I $P($G(PSOPAR),"^",7)'=1 S PSOX=PSONEW("RX #") D CHECK^PSONRXN "RTN","PSONEW",22,0) I PSONEW("DFLG")!PSONEW("QFLG") D DEL S:$G(POERR) POERR("DFLG")=1,VALMBCK="R" G END "RTN","PSONEW",23,0) D NOOR I PSONEW("DFLG") D DEL G END "RTN","PSONEW",24,0) D ^PSONEW2 I PSONEW("DFLG") D DEL S:$G(POERR) POERR("DFLG")=1,VALMBCK="R" G END ; Asks if correct "RTN","PSONEW",25,0) G:$G(PSORX("FN")) END "RTN","PSONEW",26,0) D EN^PSON52(.PSONEW) ; Files entry in File 52 "RTN","PSONEW",27,0) D NPSOSD^PSOUTIL(.PSONEW) ; Adds newly added rx to PSOSD array "RTN","PSONEW",28,0) S VALMBCK="R" "RTN","PSONEW",29,0) END D EOJ ; Clean up "RTN","PSONEW",30,0) I '$G(PSORX("FN")) W ! K DIR,DIRUT,DUOUT,DTOUT S DIR(0)="Y",DIR("B")="YES",DIR("A")="Another New Order for "_PSORX("NAME") D ^DIR K DIR,DIRUT,DUOUT,DTOUT I Y K PSONEW,PSDRUG,ORD G AGAIN "RTN","PSONEW",31,0) D ^PSOBUILD,BLD^PSOORUT1 S X=PSODFN_";DPT(" D ULK^ORX2 D UL^PSSLOCK(PSODFN) "RTN","PSONEW",32,0) D RV^PSOORFL "RTN","PSONEW",33,0) S VALMBCK="R" K PSORX("FN") Q "RTN","PSONEW",34,0) ;---------------------------------------------------------------- "RTN","PSONEW",35,0) DEL ; "RTN","PSONEW",36,0) W !,$C(7),"RX DELETED",! "RTN","PSONEW",37,0) I $P($G(PSOPAR),"^",7)=1 D "RTN","PSONEW",38,0) . S DIE="^PS(59,",DA=PSOSITE,PSOY=$O(PSONEW("OLD LAST RX#","")) "RTN","PSONEW",39,0) . S PSOX=PSONEW("OLD LAST RX#",PSOY) "RTN","PSONEW",40,0) . L +^PS(59,+PSOSITE,PSOY):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) "RTN","PSONEW",41,0) . S DR=$S(PSOY=8:"2003////"_PSOX,PSOY=3:"1002.1////"_PSOX,1:"2003////"_PSOX) "RTN","PSONEW",42,0) . D:PSOX<$P(^PS(59,+PSOSITE,PSOY),"^",3) ^DIE K DIE,X,Y "RTN","PSONEW",43,0) . L -^PS(59,+PSOSITE,PSOY) "RTN","PSONEW",44,0) . K PSOX,PSOY Q "RTN","PSONEW",45,0) EOJ ; "RTN","PSONEW",46,0) I $D(PSONEW("RX #")) L -^PSRX("B",PSONEW("RX #")) ; +Lock set in PSONRXN "RTN","PSONEW",47,0) K PSONOEDT,PSONEW,PSODRUG,ANQDATA,LSI,C,MAX,MIN,NDF,REF,SIG,SER,PSOFLAG,PSOHI,PSOLO,PSONOOR,PSOCOUU,PSOCOU,PSORX("EDIT") "RTN","PSONEW",48,0) D CLEAN^PSOVER1 "RTN","PSONEW",49,0) K ^TMP("PSORXDC",$J),RORD,ACOM,ACNT,CRIT,DEF,F1,GG,I1,IEN,INDT,LAST,MSG,NIEN,STA,DUR,DRET,PSOPRC "RTN","PSONEW",50,0) S (ZRXN,RXN)=$O(^TMP("PSORXN",$J,0)) I RXN D "RTN","PSONEW",51,0) .S RXN1=^TMP("PSORXN",$J,RXN) D EN^PSOHLSN1(RXN,$P(RXN1,"^"),$P(RXN1,"^",2),"",$P(RXN1,"^",3)) "RTN","PSONEW",52,0) .I $P(^PSRX(RXN,"STA"),"^")=5 D EN^PSOHLSN1(RXN,"SC","ZS","") "RTN","PSONEW",53,0) .;saves drug allergy order chks pso*7*390 "RTN","PSONEW",54,0) .I +$G(^TMP("PSODAOC",$J,1,0)) D "RTN","PSONEW",55,0) ..S RXN=ZRXN,PSODAOC="Rx Backdoor "_$S($P(^PSRX(RXN,"STA"),"^")=4:"NON-VERIFIED ",1:"")_"NEW Order Acceptance_OP" "RTN","PSONEW",56,0) ..D DAOC "RTN","PSONEW",57,0) K ZRXN,RXN,RXN1,^TMP("PSORXN",$J),^TMP("PSODAOC",$J),RET,PSODAOC "RTN","PSONEW",58,0) I $G(PSONOTE) D FULL^VALM1,MAIN^TIUEDIT(3,.TIUDA,PSODFN,"","","","",1) "RTN","PSONEW",59,0) K PSONOTE,PSOCKCON "RTN","PSONEW",60,0) ;W !! K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to Continue" D ^DIR K DIR,DTOUT,DUOUT "RTN","PSONEW",61,0) Q "RTN","PSONEW",62,0) NOOR ;asks nature of order "RTN","PSONEW",63,0) N PSONOODF "RTN","PSONEW",64,0) S PSONOODF=0 "RTN","PSONEW",65,0) I $G(OR0) D G NOORX ;front door "RTN","PSONEW",66,0) .S PSOI=$S($G(PSOSIGFL):1,$G(PSODRUG("OI"))'=$P(OR0,"^",8):1,1:0) I 'PSOI S PSONOOR="" D:$D(^XUSEC("PSORPH",DUZ)) COUN Q ;NoO $P(OR0,"^",7) "RTN","PSONEW",67,0) .S PSONOODF=1 "RTN","PSONEW",68,0) .D DIR I $D(DIRUT) S PSONEW("DFLG")=1 Q "RTN","PSONEW",69,0) .S PSONOOR=Y D:$D(^XUSEC("PSORPH",DUZ)) COUN K DIR,DTOUT,DTOUT,DIRUT "RTN","PSONEW",70,0) ;backdoor order "RTN","PSONEW",71,0) D DIR I $D(DIRUT) S PSONEW("DFLG")=1,VALMBCK="Q" Q "RTN","PSONEW",72,0) S PSONOOR=Y K DIK,DA,DIE,DR,PSOI,DIR,DUOUT,DTOUT,DIRUT "RTN","PSONEW",73,0) G:'$D(^XUSEC("PSORPH",DUZ)) NOORX "RTN","PSONEW",74,0) COUN ;patient counseling "RTN","PSONEW",75,0) G:$G(PSORX("EDIT"))&('$G(PSOSIGFL)) NOORX K DIR,DUOUT,DTOUT,DIRUT "RTN","PSONEW",76,0) S DIR("B")="NO",DIR(0)="52,41" D ^DIR S PSOCOU=$S(Y:Y,1:0) "RTN","PSONEW",77,0) I $D(DIRUT)!('PSOCOU) S PSOCOUU=0 D:'$G(SPEED) PRONTE Q "RTN","PSONEW",78,0) K:'$G(PSOCOU) PSOCOUU K DIR,DUOUT,DTOUT,DIRUT I Y S DIR(0)="52,42",DIR("B")="NO" D ^DIR S PSOCOUU=$S(Y:Y,1:0) "RTN","PSONEW",79,0) PRONTE K PSONOTE,DIR,DIRUT,DUOUT "RTN","PSONEW",80,0) I $T(MAIN^TIUEDIT)]"",'$G(SPEED) D K DIR,DIRUT,DUOUT "RTN","PSONEW",81,0) .S DIR(0)="Y",DIR("B")="No",DIR("A")="Do you want to enter a Progress Note",DIR("A",1)="" D ^DIR K DIR "RTN","PSONEW",82,0) .S PSONOTE=+Y Q ;I 'Y!($D(DIRUT)) Q "RTN","PSONEW",83,0) NOORX K X,Y,DIR,DUOUT,DTOUT,DIRUT "RTN","PSONEW",84,0) Q "RTN","PSONEW",85,0) DIR ;ask nature of order "RTN","PSONEW",86,0) K DIR,DTOUT,DTOUT,DIRUT I $T(NA^ORX1)]"" D Q "RTN","PSONEW",87,0) .S PSONOOR=$$NA^ORX1($S($G(PSONOODF)!($G(PSONOBCK)):"S",1:"W"),0,"B","Nature of Order",0,"WPSDIVR"_$S(+$G(^VA(200,DUZ,"PS")):"E",1:"")) "RTN","PSONEW",88,0) .I +PSONOOR S (Y,PSONOOR)=$P(PSONOOR,"^",3) Q "RTN","PSONEW",89,0) .S DIRUT=1 K PSONOOR "RTN","PSONEW",90,0) I $D(PSONOOR) S DF=PSONOOR,PSONODF=$S(DF="E":"PROVIDER ENTERED",DF="V":"VERBAL",DF="P":"TELEPHONE",DF="D":"DUPLICATE",DF="S":"SERVICE CORRECTED",DF="I":"POLICY",DF="R":"SERVICE REJECTED",1:"WRITTEN") "RTN","PSONEW",91,0) K DIR,DTOUT,DTOUT,DIRUT S DIR("A")="Nature of Order: ",DIR("B")=$S($D(PSONOOR):PSONODF,1:"WRITTEN") "RTN","PSONEW",92,0) S DIR(0)="SA^W:WRITTEN;V:VERBAL;P:TELEPHONE;S:SERVICE CORRECTED;D:DUPLICATE;I:POLICY;R:SERVICE REJECTED"_$S(+$G(^VA(200,DUZ,"PS")):";E:PROVIDER ENTERED",1:"") "RTN","PSONEW",93,0) D ^DIR K DF,PSONODF Q:$D(DIRUT) S PSONOOR=Y "RTN","PSONEW",94,0) DIRX Q "RTN","PSONEW",95,0) ; "RTN","PSONEW",96,0) NOORE(PSONEW) ;entry point for renew "RTN","PSONEW",97,0) D NOOR I $D(DIRUT) S PSONEW("DFLG")=1 Q "RTN","PSONEW",98,0) S PSONEW("NOO")=PSONOOR "RTN","PSONEW",99,0) Q "RTN","PSONEW",100,0) DAOC ;stores drug allergies w/sign/symptoms "RTN","PSONEW",101,0) N DA,OCCDT,ORN,ORL,Z,RET S OCCDT=$$NOW^XLFDT,ORN=$P(^PSRX(RXN,"OR1"),"^",2) "RTN","PSONEW",102,0) S ORL(1,1)=ORN_"^"_PSODAOC_"^"_DUZ_"^"_OCCDT_"^3^" "RTN","PSONEW",103,0) S ORL(1,2)="A Drug-Allergy Reaction exists for this medication and/or class" "RTN","PSONEW",104,0) D SAVEOC^OROCAPI1(.ORL,.RET) "RTN","PSONEW",105,0) S DA=$O(RET(1,0)) Q:'DA "RTN","PSONEW",106,0) S $P(^ORD(100.05,DA,0),"^",2)=6 "RTN","PSONEW",107,0) S ^ORD(100.05,DA,4,0)="100.517PA^1^1" "RTN","PSONEW",108,0) S ^ORD(100.05,DA,4,1,0)=^TMP("PSODAOC",$J,1,0) "RTN","PSONEW",109,0) S ^ORD(100.05,DA,4,"B",$P(^TMP("PSODAOC",$J,1,0),"^"),1)="" "RTN","PSONEW",110,0) ; "RTN","PSONEW",111,0) I $O(^TMP("PSODAOC",$J,1,0)) F I=0:0 S I=$O(^TMP("PSODAOC",$J,1,I)) Q:'I D "RTN","PSONEW",112,0) .S ^ORD(100.05,DA,4,1,1,0)="100.5173PA^"_I_"^"_I "RTN","PSONEW",113,0) .S ^ORD(100.05,DA,4,1,1,I,0)=^TMP("PSODAOC",$J,1,I) "RTN","PSONEW",114,0) .S ^ORD(100.05,DA,4,1,1,"B",^TMP("PSODAOC",$J,1,I),I)="" "RTN","PSONEW",115,0) ; "RTN","PSONEW",116,0) I $O(^TMP("PSODAOC",$J,2,0)) S Z=0 F I=0:0 S I=$O(^TMP("PSODAOC",$J,2,I)) Q:'I S Z=Z+1 D "RTN","PSONEW",117,0) .S ^ORD(100.05,DA,4,1,2,0)="100.5174PA^"_Z_"^"_Z "RTN","PSONEW",118,0) .S ^ORD(100.05,DA,4,1,2,Z,0)=^TMP("PSODAOC",$J,2,I) "RTN","PSONEW",119,0) .S ^ORD(100.05,DA,4,1,2,"B",^TMP("PSODAOC",$J,2,I),Z)="" "RTN","PSONEW",120,0) ; "RTN","PSONEW",121,0) I $O(^TMP("PSODAOC",$J,3,0)) F I=0:0 S I=$O(^TMP("PSODAOC",$J,3,I)) Q:'I D "RTN","PSONEW",122,0) .S ^ORD(100.05,DA,4,1,3,0)="100.5175PA^"_I_"^"_I "RTN","PSONEW",123,0) .S ^ORD(100.05,DA,4,1,3,I,0)=^TMP("PSODAOC",$J,3,I) "RTN","PSONEW",124,0) .S ^ORD(100.05,DA,4,1,3,"B",^TMP("PSODAOC",$J,3,I),I)="" "RTN","PSONEW",125,0) K ^TMP("PSODAOC",$J) "RTN","PSONEW",126,0) Q "RTN","PSOORNE4") 0^27^B85067804^B81172924 "RTN","PSOORNE4",1,0) PSOORNE4 ;BIR/SAB-display renew RXs from backdoor ;07/29/96 "RTN","PSOORNE4",2,0) ;;7.0;OUTPATIENT PHARMACY;**11,27,32,36,46,75,96,103,99,117,131,225,386,390**;DEC 1997;Build 86 "RTN","PSOORNE4",3,0) ;^SC DBIA-10040;^PS(50.7-2223;^PS(50.606-2174;^PS(50.607-2221;^PS(51.2-2226;^PSDRUG-221;^PS(55-2228 "RTN","PSOORNE4",4,0) ;External reference to EN1^ORCFLAG supported by DBIA 3620 "RTN","PSOORNE4",5,0) ; "RTN","PSOORNE4",6,0) EN(PSONEW) N FLD,LST,VALMCNT "RTN","PSOORNE4",7,0) EN1 K PSOQUIT D:$G(PSONEW("ENT"))'>0 I $G(PSORENW("POE"))=1 S PSOREEDT=1 D SV "RTN","PSOORNE4",8,0) .S PSOREEDT=1 D SV "RTN","PSOORNE4",9,0) .K PSONEW("DOSE"),PSONEW("UNITS"),PSONEW("DOSE ORDERED"),PSONEW("ROUTE") "RTN","PSOORNE4",10,0) .K PSONEW("SCHEDULE"),PSONEW("DURATION"),PSONEW("CONJUNCTION"),PSONEW("NOUN"),PSONEW("VERB"),PSOPRC,PSONEW("ODOSE") "RTN","PSOORNE4",11,0) RDD D DSPL,^PSOLMRN D:$G(PKI1)=2 DCP^PSOPKIV1 I $G(PSORX("FN")) S VALMBCK="Q" K PSOREEDT Q "RTN","PSOORNE4",12,0) G:'$G(PSOQUIT) RDD "RTN","PSOORNE4",13,0) Q "RTN","PSOORNE4",14,0) EDT D KV^PSOVER1 S DIR("A")="Select Field to Edit by number",DIR(0)="LO^1:"_$S($G(PSOREEDT):10,1:8) "RTN","PSOORNE4",15,0) D ^DIR I $D(DTOUT)!($D(DUOUT)) D KV^PSOVER1 S VALMBCK="" Q "RTN","PSOORNE4",16,0) EDTSEL S PSOLM=1,(PSONEW("DFLG"),PSONEW("FIELD"),PSONEW3)=0 "RTN","PSOORNE4",17,0) I +Y S LST=Y D HLDHDR^PSOLMUTL S PSOEDT=1 D Q:$G(PSODIR("DFLG"))!($G(PSODIR("QFLG"))) "RTN","PSOORNE4",18,0) .F FLD=1:1:$L(LST,",") Q:$P(LST,",",FLD)']"" D @(+$P(LST,",",FLD)) Q:$G(PSODIR("DFLG"))!($G(PSODIR("QFLG"))) "RTN","PSOORNE4",19,0) E S VALMBCK="" D FULL^VALM1 "RTN","PSOORNE4",20,0) Q "RTN","PSOORNE4",21,0) ACP ; Renewal Accept "RTN","PSOORNE4",22,0) N DIR,Y,DIRUT,DUOUT,DTOUT,DIR S Y=0 "RTN","PSOORNE4",23,0) I $G(ORD),+$P($G(^PS(52.41,+ORD,0)),"^",23)=1 D Q:$D(DIRUT)!'Y D EN1^ORCFLAG(+$P($G(^PS(52.41,ORD,0)),"^")) H 1 "RTN","PSOORNE4",24,0) . D FULL^VALM1 "RTN","PSOORNE4",25,0) . I '$D(^XUSEC("PSORPH",DUZ)) D S Y=0 Q "RTN","PSOORNE4",26,0) . . S DIR("A",1)="Order must be unflagged by a pharmacist before it can be finished." "RTN","PSOORNE4",27,0) . . S DIR("A",2)="" "RTN","PSOORNE4",28,0) . . S DIR(0)="E",DIR("A")="Enter RETURN to continue" W !,$C(7) D ^DIR "RTN","PSOORNE4",29,0) . . S VALMBCK="R" "RTN","PSOORNE4",30,0) . D FULL^VALM1 "RTN","PSOORNE4",31,0) . S DIR("A",1)="This Order is flagged. In order to finish it" "RTN","PSOORNE4",32,0) . S DIR("A",2)="you must unflag it first." "RTN","PSOORNE4",33,0) . S DIR("A",3)="" "RTN","PSOORNE4",34,0) . S DIR(0)="Y",DIR("A")="Unflag Order",DIR("B")="NO" "RTN","PSOORNE4",35,0) . W ! D ^DIR I $D(DIRUT)!'Y S VALMBCK="Q" "RTN","PSOORNE4",36,0) I $G(ORD),+$P($G(^PS(52.41,+ORD,0)),"^",23)=1 Q "RTN","PSOORNE4",37,0) ; "RTN","PSOORNE4",38,0) I $G(PKI1)=1 D REA^PSOPKIV1 G:$G(PSONEW("QFLG"))=1 PKI "RTN","PSOORNE4",39,0) D INST2^PSORENW S PSOFROM1=1 D:$D(^XUSEC("PSORPH",DUZ))!('$P(PSOPAR,"^",2)) VER "RTN","PSOORNE4",40,0) K PSOFROM1 "RTN","PSOORNE4",41,0) PKI I $G(PSONEW("QFLG")) S POERR("DFLG")=1,VALMBCK="R" K PSONEW2 Q "RTN","PSOORNE4",42,0) I PSONEW("ENT")>0,$G(NEWDOSE) K NEWDOSE G EN1 Q "RTN","PSOORNE4",43,0) S PSORX("FN")=1 D EN^PSORN52(.PSONEW) "RTN","PSOORNE4",44,0) ;saves drug allergy order chks pso*7*390 "RTN","PSOORNE4",45,0) I +$G(^TMP("PSODAOC",$J,1,0)) D "RTN","PSOORNE4",46,0) .I $G(PSORX("DFLG")) K ^TMP("PSODAOC",$J) Q "RTN","PSOORNE4",47,0) .S RXN=PSORENW("IRXN"),PSODAOC="Finished CPRS Rx "_$S($P(^PSRX(RXN,"STA"),"^")=4:"NON-VERIFIED ",1:"")_"RENEW Order Acceptance_OP" "RTN","PSOORNE4",48,0) .D DAOC^PSONEW "RTN","PSOORNE4",49,0) D RNPSOSD^PSOUTIL,ACP1^PSOORNE6,^PSOBUILD S VALMBCK="Q" "RTN","PSOORNE4",50,0) Q "RTN","PSOORNE4",51,0) VER1(PSONEW) ; "RTN","PSOORNE4",52,0) VER S (PSONEW("DFLG"),PSONEW("QFLG"))=0 I PSONEW("ENT")=0 D K PSOORRNW,PSOFROM1 I PSONEW("DFLG")=1 S (PSONEW("QFLG"),POERR("DFLG"))=1 Q "RTN","PSOORNE4",53,0) .S (PSOREEDT,PSOORRNW)=1 W !!,"Dosing Instruction Missing!!",! "RTN","PSOORNE4",54,0) .S PSONEW("IRXN")=PSONEW("OIRXN") K VALMSG D FULL^VALM1 W !,"Drug: "_PSODRUG("NAME") D "RTN","PSOORNE4",55,0) ..I $O(SIG(0)) D Q "RTN","PSOORNE4",56,0) ...F I=1:1 Q:$G(SIG(I))']"" W !,SIG(I) "RTN","PSOORNE4",57,0) ..I $P($G(^PSRX(PSONEW("OIRXN"),"SIG")),"^")]"" S X=$P(^PSRX(PSONEW("OIRXN"),"SIG"),"^") D SIGONE^PSOHELP W !,$E($G(INS1),2,250) "RTN","PSOORNE4",58,0) .K DIRUT W ! D DOSE^PSODIR(.PSONEW) Q:$G(PSONEW("DFLG")) D EN^PSOFSIG(.PSONEW) "RTN","PSOORNE4",59,0) .I PSONEW("ENT")>0,$O(SIG(0)) S (SIGOK,NEWDOSE)=1 "RTN","PSOORNE4",60,0) .I '$G(SPEED),PSONEW("DFLG")=1 S VALMSG="Renewal Request Cancelled!" W:$G(SPEED) !,"Renewal Request Cancelled!" Q:$G(PSONEW("DFLG")) "RTN","PSOORNE4",61,0) .I +$G(PSONEW("ENT"))'>0 K DIRUT Q "RTN","PSOORNE4",62,0) .D INS^PSODIR(.PSONEW),EN^PSOFSIG(.PSONEW),SINS^PSODIR(.PSONEW):$G(^PS(55,PSODFN,"LAN")) "RTN","PSOORNE4",63,0) .S:'$G(SPEED)&(PSONEW("DFLG")=1) VALMSG="Renewal Request Cancelled!" W:$G(SPEED)&(PSONEW("DFLG")=1) !,"Renewal Request Cancelled!" "RTN","PSOORNE4",64,0) .I $G(SPEED),'$G(PSONEW("DFLG")) D KV^PSOVER1 S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR,KV^PSOVER1 K X,Y "RTN","PSOORNE4",65,0) I +$G(PSONEW("ENT"))'>0 G VER "RTN","PSOORNE4",66,0) D STOP^PSORENW1 I +$G(PSEXDT) D S PSORENW("QFLG")=1 "RTN","PSOORNE4",67,0) .S Y=PSORENW("FILL DATE") X ^DD("DD") S VALMSG=Y_" fill date is past expiration date " "RTN","PSOORNE4",68,0) .S Y=$P(PSEXDT,"^",2) X ^DD("DD") S VALMSG=VALMSG_Y_"." "RTN","PSOORNE4",69,0) Q "RTN","PSOORNE4",70,0) DSPL G:$G(PSONEW("ENT"))>0 DSP "RTN","PSOORNE4",71,0) S PSONEW("ENT")=0 F I=0:0 S I=$O(^PSRX(PSONEW("OIRXN"),6,I)) Q:'I S DOSE=^PSRX(PSONEW("OIRXN"),6,I,0) D "RTN","PSOORNE4",72,0) .S PSONEW("ENT")=PSONEW("ENT")+1,PSONEW("DOSE",PSONEW("ENT"))=$P(DOSE,"^") "RTN","PSOORNE4",73,0) .S PSONEW("UNITS",PSONEW("ENT"))=$P(DOSE,"^",3),PSONEW("DOSE ORDERED",PSONEW("ENT"))=$P(DOSE,"^",2),PSONEW("ROUTE",PSONEW("ENT"))=$P(DOSE,"^",7) "RTN","PSOORNE4",74,0) .S PSONEW("SCHEDULE",PSONEW("ENT"))=$P(DOSE,"^",8),PSONEW("DURATION",PSONEW("ENT"))=$P(DOSE,"^",5),PSONEW("CONJUNCTION",PSONEW("ENT"))=$P(DOSE,"^",6) "RTN","PSOORNE4",75,0) .S PSONEW("NOUN",PSONEW("ENT"))=$P(DOSE,"^",4),PSONEW("VERB",PSONEW("ENT"))=$P(DOSE,"^",9) "RTN","PSOORNE4",76,0) .I $G(^PSRX(PSONEW("OIRXN"),6,I,1))]"" S PSONEW("ODOSE",PSONEW("ENT"))=^PSRX(PSONEW("OIRXN"),6,I,1) "RTN","PSOORNE4",77,0) .K DOSE "RTN","PSOORNE4",78,0) DSP D ^PSOORUT2 K ^TMP("PSOPO",$J) S IEN=0 "RTN","PSOORNE4",79,0) D:$G(PSONEW("PENDING ORDER")) LMDISP^PSOORFI5(+PSONEW("PENDING ORDER")) "RTN","PSOORNE4",80,0) D:$G(PKI1) L1^PSOPKIV1 "RTN","PSOORNE4",81,0) D DIN^PSONFI(PSODRUG("OI"),$S($G(PSODRUG("IEN")):PSODRUG("IEN"),1:"")) "RTN","PSOORNE4",82,0) S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Rx#: "_PSONEW("NRX #") "RTN","PSOORNE4",83,0) I +$G(PSODRUG("OI")) D "RTN","PSOORNE4",84,0) .S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Orderable Item: "_$P(^PS(50.7,+$G(PSODRUG("OI")),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^")_NFIO "RTN","PSOORNE4",85,0) .S:NFIO["" NFIO=IEN_","_($L(^TMP("PSOPO",$J,IEN,0))-4) "RTN","PSOORNE4",86,0) S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" "_$S($D(^PSDRUG("AQ",PSODRUG("IEN"))):" CMOP ",1:" ")_"Drug: "_PSODRUG("NAME")_NFID "RTN","PSOORNE4",87,0) S:NFID["" NFID=IEN_","_($L(^TMP("PSOPO",$J,IEN,0))-4) "RTN","PSOORNE4",88,0) S:$G(PSONEW("TN"))]"" IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Trade Name: "_$G(PSONEW("TN")) "RTN","PSOORNE4",89,0) S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Patient Status: "_$P(PSONEW("PTST NODE"),"^"),PSONEW("PATIENT STATUS")=$P(PSONEW("PTST NODE"),"^") "RTN","PSOORNE4",90,0) S (PSOID,Y)=PSONEW("ISSUE DATE") X ^DD("DD") S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (1) Issue Date: "_Y "RTN","PSOORNE4",91,0) S Y=PSONEW("FILL DATE") X ^DD("DD") S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (2) Fill Date: "_Y "RTN","PSOORNE4",92,0) I PSONEW("ENT")=0 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=$S($G(PSOREEDT):" (9)",1:" ")_" Dosage:" G PAT "RTN","PSOORNE4",93,0) F I=1:1:PSONEW("ENT") D "RTN","PSOORNE4",94,0) .I '$G(PSONEW("DOSE ORDERED",I)),$G(PSONEW("VERB",I))]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Verb: "_$G(PSONEW("VERB",I)) "RTN","PSOORNE4",95,0) .S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=$S($G(PSOREEDT)&(I'>1):" (9)",1:" ")_" Dosage: "_$S($E(PSONEW("DOSE",I),1)="."&($G(PSONEW("DOSE ORDERED",I))):"0",1:"")_PSONEW("DOSE",I) "RTN","PSOORNE4",96,0) .S ^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_$S($G(PSONEW("UNITS",I))]"":" ("_$P(^PS(50.607,PSONEW("UNITS",I),0),"^")_")",1:"") "RTN","PSOORNE4",97,0) .I $P($G(^PS(55,PSODFN,"LAN")),"^"),'$G(PSONEW("DOSE ORDERED",I)) D "RTN","PSOORNE4",98,0) ..S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Oth. Lang. Dosage: "_$G(PSONEW("ODOSE",I)) "RTN","PSOORNE4",99,0) .I $G(PSONEW("DOSE ORDERED",I)),$G(PSONEW("VERB",I))]"" D "RTN","PSOORNE4",100,0) ..S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Verb: "_$G(PSONEW("VERB",I)) "RTN","PSOORNE4",101,0) ..S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Dispense Units: "_$S($E($G(PSONEW("DOSE ORDERED",I)),1)=".":"0",1:"")_$G(PSONEW("DOSE ORDERED",I)) "RTN","PSOORNE4",102,0) ..S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Noun: "_$G(PSONEW("NOUN",I)) "RTN","PSOORNE4",103,0) .I $G(PSONEW("ROUTE",I)) S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Route: "_$P(^PS(51.2,PSONEW("ROUTE",I),0),"^") "RTN","PSOORNE4",104,0) .S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Schedule: "_PSONEW("SCHEDULE",I) "RTN","PSOORNE4",105,0) .I $G(PSONEW("DURATION",I))]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" *Duration: "_$G(PSONEW("DURATION",I)) "RTN","PSOORNE4",106,0) .I $G(PSONEW("CONJUNCTION",I))]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Conjunction: "_$S($G(PSONEW("CONJUNCTION",I))="A":"AND",$G(PSONEW("CONJUNCTION",I))="T":"THEN",$G(PSONEW("CONJUNCTION",I))="X":"EXCEPT",1:"") "RTN","PSOORNE4",107,0) PAT S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=$S($G(PSOREEDT):" (10)",1:" ")_"Pat Instruction:" D INS2^PSOBKDED "RTN","PSOORNE4",108,0) S RXN=PSONEW("OIRXN") D INST1^PSORENW "RTN","PSOORNE4",109,0) ;I $O(PRC(0)) D PC1^PSOORNE5 "RTN","PSOORNE4",110,0) K RXN S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" SIG:" "RTN","PSOORNE4",111,0) I $G(SIGOK),$O(SIG(0)) D K SG,MIG "RTN","PSOORNE4",112,0) .F I=0:0 S I=$O(SIG(I)) Q:'I F SG=1:1:$L(SIG(I)) D "RTN","PSOORNE4",113,0) ..S:$L(^TMP("PSOPO",$J,IEN,0)_" "_$P(SIG(I)," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOPO",$J,IEN,0)," ",21)=" " "RTN","PSOORNE4",114,0) ..S:$P(SIG(I)," ",SG)'="" ^TMP("PSOPO",$J,IEN,0)=$G(^TMP("PSOPO",$J,IEN,0))_" "_$P(SIG(I)," ",SG) "RTN","PSOORNE4",115,0) E D "RTN","PSOORNE4",116,0) .S X=$S($G(PSONEW("SIG"))]"":PSONEW("SIG"),1:$P($G(^PSRX(PSONEW("OIRXN"),"SIG")),"^")) D SIGONE^PSOHELP S SIG=$E($G(INS1),2,250) "RTN","PSOORNE4",117,0) .F SG=1:1:$L(SIG) S:$L(^TMP("PSOPO",$J,IEN,0)_" "_$P(SIG," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOPO",$J,IEN,0)," ",21)=" " S:$P(SIG," ",SG)'="" ^TMP("PSOPO",$J,IEN,0)=$G(^TMP("PSOPO",$J,IEN,0))_" "_$P(SIG," ",SG) "RTN","PSOORNE4",118,0) S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Days Supply: "_PSONEW("DAYS SUPPLY")_$S($L(PSONEW("DAYS SUPPLY"))=1:" ",1:"") "RTN","PSOORNE4",119,0) S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" QTY"_$S($G(PSODRUG("UNIT"))]"":" ("_PSODRUG("UNIT")_")",1:" ( )")_": "_PSONEW("QTY") "RTN","PSOORNE4",120,0) I $D(^PSDRUG("AQ",PSODRUG("IEN"))),$P($G(^PSDRUG(PSODRUG("IEN"),5)),"^")]"" D "RTN","PSOORNE4",121,0) .S $P(RN," ",79)=" ",IEN=IEN+1 "RTN","PSOORNE4",122,0) .S ^TMP("PSOPO",$J,IEN,0)=" QTY DSP MSG: "_$P(^PSDRUG(PSODRUG("IEN"),5),"^") "RTN","PSOORNE4",123,0) S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (3) # of Refills: "_PSONEW("# OF REFILLS")_$S($L(PSONEW("# OF REFILLS"))=1:" ",1:"") "RTN","PSOORNE4",124,0) S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (4) Routing: "_$S($G(PSORENW("MAIL/WINDOW"))["W":"WINDOW",1:"MAIL") "RTN","PSOORNE4",125,0) S:$G(PSONEW("METHOD OF PICK-UP"))]""&($P(PSOPAR,"^",12)) IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Method of Pickup: "_PSONEW("METHOD OF PICK-UP") "RTN","PSOORNE4",126,0) S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (5) Clinic: "_$S($G(PSONEW("CLINIC")):$P(^SC(PSONEW("CLINIC"),0),"^"),1:"") "RTN","PSOORNE4",127,0) S $P(RN," ",31)=" ",IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (6) Provider: "_PSONEW("PROVIDER NAME")_$E(RN,$L(PSONEW("PROVIDER NAME"))+1,31) K RN "RTN","PSOORNE4",128,0) I $G(PSONEW("COSIGNING PROVIDER"))]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Cos-Provider: "_$P(^VA(200,PSONEW("COSIGNING PROVIDER"),0),"^") "RTN","PSOORNE4",129,0) S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (7) Copies: "_$S($G(PSONEW("COPIES")):PSONEW("COPIES"),1:1) "RTN","PSOORNE4",130,0) RMK S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (8) Remarks: "_$S($G(PSONEW("REMARKS"))]"":PSONEW("REMARKS"),1:"") "RTN","PSOORNE4",131,0) S $P(RN," ",35)=" ",IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Entry By: "_$P(^VA(200,DUZ,0),"^")_$E(RN,$L($P(^VA(200,DUZ,0),"^"))+1,35) "RTN","PSOORNE4",132,0) I $G(PSOFDR) S ^TMP("PSOPO",$J,IEN,0)=" Entry By: "_$P(^VA(200,$P(OR0,"^",4),0),"^")_$E(RN,$L($P(^VA(200,$P(OR0,"^",4),0),"^"))+1,35) "RTN","PSOORNE4",133,0) D NOW^%DTC S PSONEW("LOGIN DATE")=$S($P($G(OR0),"^",6):$P($G(OR0),"^",6),1:%) K %,X S Y=PSONEW("LOGIN DATE") X ^DD("DD") "RTN","PSOORNE4",134,0) S ^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_"Entry Date: "_$P(Y,"@")_" "_$P(Y,"@",2) K RN "RTN","PSOORNE4",135,0) S (VALMCNT,PSOPF)=IEN "RTN","PSOORNE4",136,0) Q "RTN","PSOORNE4",137,0) 1 D 1^PSOBKDED Q "RTN","PSOORNE4",138,0) 2 D 2^PSOBKDED Q "RTN","PSOORNE4",139,0) 3 D 9^PSOBKDED Q "RTN","PSOORNE4",140,0) 4 D 12^PSOBKDED Q "RTN","PSOORNE4",141,0) 5 D 5^PSOBKDED Q "RTN","PSOORNE4",142,0) 6 D 4^PSOBKDED Q "RTN","PSOORNE4",143,0) 7 D 11^PSOBKDED Q "RTN","PSOORNE4",144,0) 8 D 13^PSOBKDED Q "RTN","PSOORNE4",145,0) 9 W !!,"Drug: "_PSODRUG("NAME") S PSOORRNW=1 D DOSE1^PSOORED5(.PSONEW) "RTN","PSOORNE4",146,0) I $G(PSONEW("DFLG")) S PSODIR("DFLG")=1,VALMBCK="Q" Q "RTN","PSOORNE4",147,0) D SV Q "RTN","PSOORNE4",148,0) 10 D INS^PSODIR(.PSONEW),SINS^PSODIR(.PSONEW) D SV Q "RTN","PSOORNE4",149,0) ; "RTN","PSOORNE4",150,0) SV D SV^PSOORNE5 Q "RTN","PSOORNEW") 0^28^B81591143^B78892061 "RTN","PSOORNEW",1,0) PSOORNEW ;BIR/SAB - display orders from oerr ;6/19/06 3:53pm "RTN","PSOORNEW",2,0) ;;7.0;OUTPATIENT PHARMACY;**11,23,27,32,55,46,71,90,94,106,131,133,143,237,222,258,206,225,251,386,390**;DEC 1997;Build 86 "RTN","PSOORNEW",3,0) ;^PS(50.7 -2223 "RTN","PSOORNEW",4,0) ;^PSDRUG -221 "RTN","PSOORNEW",5,0) ;^PS(50.606 -2174 "RTN","PSOORNEW",6,0) ;^PS(55 -2228 "RTN","PSOORNEW",7,0) ;EN1^ORCFLAG -3620 "RTN","PSOORNEW",8,0) ;External reference to $$DS^PSSDSAPI supported by DBIA 5424 "RTN","PSOORNEW",9,0) ; "RTN","PSOORNEW",10,0) ;PSO*237 quit Finish if Today > Issue date + 365 "RTN","PSOORNEW",11,0) ; "RTN","PSOORNEW",12,0) DSPL I $G(PSODSPL) S VALMBCK="Q" K PSODSPL,PSOANSQD Q "RTN","PSOORNEW",13,0) Q:'$D(PSOLMC) K ^TMP("PSOPO",$J) S PSOLMC=PSOLMC+1 "RTN","PSOORNEW",14,0) I $D(CLOZPAT) S PSONEW("DAYS SUPPLY")=$S($G(PSONEW("DAYS SUPPLY")):PSONEW("DAYS SUPPLY"),1:7) G OI "RTN","PSOORNEW",15,0) S PSONEW("DAYS SUPPLY")=$S($G(PSONEW("DAYS SUPPLY")):PSONEW("DAYS SUPPLY"),+$G(^PS(55,PSODFN,"PS"))&($P(^PS(53,+$G(^PS(55,PSODFN,"PS")),0),"^",3))&('$G(PSONEW("DAYS SUPPLY"))):$P(^PS(53,+$G(^PS(55,PSODFN,"PS")),0),"^",3),1:30) "RTN","PSOORNEW",16,0) OI I '$G(PSODRUG("OI")) D "RTN","PSOORNEW",17,0) .S (OI,PSODRUG("OI"))=$P(OR0,"^",8),PSODRUG("OIN")=$P(^PS(50.7,$P(OR0,"^",8),0),"^"),OID=$P(OR0,"^",9) "RTN","PSOORNEW",18,0) .I $P($G(OR0),"^",9) S POERR=1,DREN=$P(OR0,"^",9) D DRG^PSOORDRG K POERR "RTN","PSOORNEW",19,0) I '$D(CLOZPAT) I $G(PSODRUG("DEA"))["A",$G(PSODRUG("DEA"))'["B"!($G(PSODRUG("DEA"))["F") S PSONEW("# OF REFILLS")=0 "RTN","PSOORNEW",20,0) I $D(CLOZPAT) S PSONEW("# OF REFILLS")=$S($D(PSONEW("# OF REFILLS")):PSONEW("# OF REFILLS"),$G(CLOZPAT)=2&($P(OR0,"^",11)>2):3,$G(CLOZPAT)&($P(OR0,"^",11)>1):1,1:0) "RTN","PSOORNEW",21,0) S IEN=0 D OBX^PSOORFI1,DIN^PSONFI(PSODRUG("OI"),$S($G(PSODRUG("IEN")):PSODRUG("IEN"),1:"")) "RTN","PSOORNEW",22,0) D LMDISP^PSOORFI5(+$G(ORD)) ; Display Flag/Unflag Information "RTN","PSOORNEW",23,0) S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="*(1) Orderable Item: "_$P(^PS(50.7,PSODRUG("OI"),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^")_NFIO "RTN","PSOORNEW",24,0) S:NFIO["" NFIO=IEN_","_($L(^TMP("PSOPO",$J,IEN,0))-4) "RTN","PSOORNEW",25,0) K LST I $G(PSODRUG("NAME"))]"" D G PT "RTN","PSOORNEW",26,0) .S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (2)"_$S($D(^PSDRUG("AQ",PSODRUG("IEN"))):" CMOP ",1:" ")_"Drug: "_PSODRUG("NAME")_NFID "RTN","PSOORNEW",27,0) .S:NFID["" NFID=IEN_","_($L(^TMP("PSOPO",$J,IEN,0))-4) "RTN","PSOORNEW",28,0) .I $P($G(^PSDRUG(PSODRUG("IEN"),0)),"^",10)]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Drug Message:" D DRGMSG "RTN","PSOORNEW",29,0) S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (2) Drug: No Dispense Drug Selected" "RTN","PSOORNEW",30,0) PT D DOSE2^PSOORFI4 "RTN","PSOORNEW",31,0) S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (4) Pat Instruct:" D:$O(PSONEW("SIG",0)) INST^PSOORFI4 "RTN","PSOORNEW",32,0) S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Provider Comments:" S TY=3 D INST^PSOORFI1 "RTN","PSOORNEW",33,0) S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Instructions:" S TY=2 D INST^PSOORFI1 "RTN","PSOORNEW",34,0) K PSOELSE S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" SIG:" "RTN","PSOORNEW",35,0) F I=0:0 S I=$O(SIG(I)) Q:'I S SIG=SIG(I) D "RTN","PSOORNEW",36,0) .F SG=1:1:$L(SIG) S:$L(^TMP("PSOPO",$J,IEN,0)_" "_$P(SIG," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOPO",$J,IEN,0)," ",20)=" " S:$P(SIG," ",SG)'="" ^TMP("PSOPO",$J,IEN,0)=$G(^TMP("PSOPO",$J,IEN,0))_" "_$P(SIG," ",SG) "RTN","PSOORNEW",37,0) S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (5) Patient Status: "_$P($G(^PS(53,+PSONEW("PATIENT STATUS"),0)),"^") "RTN","PSOORNEW",38,0) K PSOELSE I $G(PSONEW("ISSUE DATE"))']"" S PSOELSE=1 S IEN=IEN+1,(PSOID,Y)=$E($P(OR0,"^",6),1,7) X ^DD("DD") S PSONEW("ISSUE DATE")=Y,^TMP("PSOPO",$J,IEN,0)=" (4) Issue Date: "_Y "RTN","PSOORNEW",39,0) I '$G(PSOELSE) S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (6) Issue Date: "_PSONEW("ISSUE DATE") "RTN","PSOORNEW",40,0) K PSOELSE I $G(PSORX("FILL DATE"))']"" S PSOELSE=1 D "RTN","PSOORNEW",41,0) .S (Y,PSORX("FILL DATE"))=$S($E($P(OR0,"^",6),1,7)80 IEN=IEN+1,$P(^TMP("PSOPO",$J,IEN,0)," ",20)=" " D "RTN","PSOORNEW",64,0) ..S:$P(PSONEW("REMARKS")," ",SG)'="" ^TMP("PSOPO",$J,IEN,0)=$G(^TMP("PSOPO",$J,IEN,0))_" "_$P(PSONEW("REMARKS")," ",SG) "RTN","PSOORNEW",65,0) I $G(PSOSIGFL)!(PSODRUG("OI")'=$P(OR0,"^",8)) S PSONEW("CLERK CODE")=DUZ,PSORX("CLERK CODE")=$P(^VA(200,DUZ,0),"^"),VALMSG="This change will create a new prescription!" "RTN","PSOORNEW",66,0) S $P(RN," ",35)=" ",IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Entry By: "_$P(^VA(200,PSONEW("CLERK CODE"),0),"^")_$E(RN,$L($P(^VA(200,PSONEW("CLERK CODE"),0),"^"))+1,35) "RTN","PSOORNEW",67,0) S Y=$P(OR0,"^",12) X ^DD("DD") S ^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_"Entry Date: "_$E($P(OR0,"^",12),4,5)_"/"_$E($P(OR0,"^",12),6,7)_"/"_$E($P(OR0,"^",12),2,3)_" "_$P(Y,"@",2) K RN "RTN","PSOORNEW",68,0) I PSOLMC<2 D ^PSOLMPO1 S VALMBCK="Q",PSOLMC=0 "RTN","PSOORNEW",69,0) S:PSOLMC>1 VALMBCK="R" "RTN","PSOORNEW",70,0) Q "RTN","PSOORNEW",71,0) ORCHK D PROVCOM^PSOORFI4,ORCHK^PSOORFI4 "RTN","PSOORNEW",72,0) Q "RTN","PSOORNEW",73,0) EDT D KV S DIR("A",1)="* Indicates which fields will create an new Order",DIR("A")="Select Field to Edit by number",DIR(0)="LO^1:15" D ^DIR Q:$D(DTOUT)!($D(DUOUT)) "RTN","PSOORNEW",74,0) EDTSEL N LST,FLD,OUT D KV S OUT=0 "RTN","PSOORNEW",75,0) I +Y S LST=Y D FULL^VALM1 N PSODOSE M PSODOSE=PSONEW D G DSPL "RTN","PSOORNEW",76,0) .F FLD=1:1:$L(LST,",") Q:$P(LST,",",FLD)']""!(OUT) D @(+$P(LST,",",FLD)) D:$P(LST,",",FLD)=8 REF D KV "RTN","PSOORNEW",77,0) E S VALMBCK="" Q "RTN","PSOORNEW",78,0) Q "RTN","PSOORNEW",79,0) ACP ; "RTN","PSOORNEW",80,0) N DIR,Y S Y=0 "RTN","PSOORNEW",81,0) I $G(ORD),+$P($G(^PS(52.41,+ORD,0)),"^",23)=1 D Q:$D(DIRUT)!'Y D EN1^ORCFLAG(+$P($G(^PS(52.41,ORD,0)),"^")) H 1 "RTN","PSOORNEW",82,0) . D FULL^VALM1 "RTN","PSOORNEW",83,0) . I '$D(^XUSEC("PSORPH",DUZ)) D S Y=0 Q "RTN","PSOORNEW",84,0) . . S DIR("A",1)="Order must be unflagged by a pharmacist before it can be finished." "RTN","PSOORNEW",85,0) . . S DIR("A",2)="" "RTN","PSOORNEW",86,0) . . S DIR(0)="E",DIR("A")="Enter RETURN to continue" W !,$C(7) D ^DIR "RTN","PSOORNEW",87,0) . . S VALMBCK="R" "RTN","PSOORNEW",88,0) . D KV "RTN","PSOORNEW",89,0) . S DIR("A",1)="This Order is flagged. In order to finish it" "RTN","PSOORNEW",90,0) . S DIR("A",2)="you must unflag it first." "RTN","PSOORNEW",91,0) . S DIR("A",3)="" "RTN","PSOORNEW",92,0) . S DIR(0)="Y",DIR("A")="Unflag Order",DIR("B")="NO" "RTN","PSOORNEW",93,0) . W ! D ^DIR I $D(DIRUT)!'Y S VALMBCK="Q" "RTN","PSOORNEW",94,0) I $G(ORD),+$P($G(^PS(52.41,+ORD,0)),"^",23)=1 Q "RTN","PSOORNEW",95,0) ; "RTN","PSOORNEW",96,0) I $D(CLOZPAT),+$G(PSONEW("QTY"))=0 S VALMSG="Unable to calculate the quantity, enter a quantity" G DSPL "RTN","PSOORNEW",97,0) S (PSODIR("DFLG"),PSORX("DFLG"),PSODIR("QFLD"))=0,ACP=1 D ORCHK "RTN","PSOORNEW",98,0) G:$G(PSONEW("QFLG")) DSPL "RTN","PSOORNEW",99,0) I $G(PSODIR("DFLG"))!$G(PSORX("DFLG")) Q "RTN","PSOORNEW",100,0) I $G(PSONEW("FLD"))!($G(PSODRUG("NAME"))']"")!('$O(SIG(0))) G DSPL "RTN","PSOORNEW",101,0) I $G(PSODRUG("NAME"))]"",'$G(ORCHK)!($G(ORDRG)'=PSODRUG("NAME")) D I $G(PSORX("DFLG")) D CLEAN^PSOVER1 G DSPL "RTN","PSOORNEW",102,0) . D POST^PSODRG S:'$G(PSORX("DFLG")) ORCHK=1,ORDRG=PSODRUG("NAME") "RTN","PSOORNEW",103,0) D:$$DS^PSSDSAPI&('$G(PSORX("DFLG"))) DOSCK^PSODOSUT("N") I $G(PSORX("DFLG")) D CLEAN^PSOVER1 G DSPL "RTN","PSOORNEW",104,0) I '$D(PSONEW("RX #")) S PSOFROM="NEW",RTN=$S($P($G(PSOPAR),"^",7):"AUTO^PSONRXN",1:"MANUAL^PSONRXN") D @RTN Q:PSONEW("QFLG") I '$P($G(PSOPAR),"^",7) S PSOX=PSONEW("RX #") D CHECK^PSONRXN "RTN","PSOORNEW",105,0) D RXNCHK^PSOORNE1 I $G(PSONEW("QFLG")) S PSONEW("DFLG")=1 Q "RTN","PSOORNEW",106,0) I DT>$$FMADD^XLFDT($P(OR0,"^",6),365) D EXPR^PSONEW2 G DSPL "RTN","PSOORNEW",107,0) D STOP^PSONEW2,DISPLAY^PSONEW2,^PSONEWF "RTN","PSOORNEW",108,0) I $G(PSOCPZ("DFLG")) W !!,"No action taken!",! K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to continue" D ^DIR,KV K PSOCPZ("DFLG"),DRET,PSOANSQD S VALMBCK="Q" Q "RTN","PSOORNEW",109,0) ; "RTN","PSOORNEW",110,0) K PSOCPZ("DFLG") D KV S DIR(0)="Y",DIR("A")="Are you sure you want to Accept this Order",DIR("B")="NO" D ^DIR I $D(DIRUT) D KV K DRET,PSOANSQ,PSOANSQD S VALMBCK="Q" Q "RTN","PSOORNEW",111,0) D KV I 'Y K PSOANSQ G DSPL "RTN","PSOORNEW",112,0) I $G(PSONEW("MAIL/WINDOW"))["W" D:$P($G(PSOPAR),"^",12) S BINGCRT="Y",BINGRTE="W",PSORX("MAIL/WINDOW")="WINDOW" K RTN "RTN","PSOORNEW",113,0) .W ! K DIR,DIRUT S DIR(0)="52,35O" "RTN","PSOORNEW",114,0) .S:$G(PSORX("METHOD OF PICK-UP"))]"" DIR("B")=PSORX("METHOD OF PICK-UP") D ^DIR I $D(DIRUT) K DIR,DIRUT Q "RTN","PSOORNEW",115,0) .S (PSONEW("METHOD OF PICK-UP"),PSORX("METHOD OF PICK-UP"))=Y K X,Y "RTN","PSOORNEW",116,0) S PSONEW("POE")=1 D EN^PSON52(.PSONEW) G:$G(PSONEW("DFLG")) ABORT D DCORD^PSONEW2 "RTN","PSOORNEW",117,0) ;saves drug allergy order chks pso*7*390 "RTN","PSOORNEW",118,0) I +$G(^TMP("PSODAOC",$J,1,0)) D "RTN","PSOORNEW",119,0) .I $G(PSORX("DFLG")) K ^TMP("PSODAOC",$J) Q "RTN","PSOORNEW",120,0) .S RXN=PSONEW("IRXN"),PSODAOC="Finished CPRS Rx "_$S($P(^PSRX(RXN,"STA"),"^")=4:"NON-VERIFIED ",1:"")_"Order Acceptance_OP" "RTN","PSOORNEW",121,0) .D DAOC^PSONEW "RTN","PSOORNEW",122,0) D NPSOSD^PSOUTIL(.PSONEW),FULL^VALM1 K PSORX("MAIL/WINDOW") "RTN","PSOORNEW",123,0) D EOJ^PSONEW "RTN","PSOORNEW",124,0) ABORT S VALMBCK="Q",DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to Continue" D ^DIR,CLEAN^PSOVER1,KV "RTN","PSOORNEW",125,0) Q "RTN","PSOORNEW",126,0) KV K DIRUT,DUOUT,DTOUT,DIR "RTN","PSOORNEW",127,0) Q "RTN","PSOORNEW",128,0) REF D REF^PSOORFI4 "RTN","PSOORNEW",129,0) Q "RTN","PSOORNEW",130,0) 1 N PSOBDR,PSOBDRG S PSOBDRG=1 D 1^PSOORNW2 Q ;oi "RTN","PSOORNEW",131,0) ; "RTN","PSOORNEW",132,0) 4 D INS^PSOORNW2 Q "RTN","PSOORNEW",133,0) ; "RTN","PSOORNEW",134,0) 3 D DOSE^PSOORED4(.PSONEW) Q "RTN","PSOORNEW",135,0) ; "RTN","PSOORNEW",136,0) 6 D 4^PSOORNW2 Q ;idt "RTN","PSOORNEW",137,0) ; "RTN","PSOORNEW",138,0) 7 D 5^PSOORNW2 Q ;fdt "RTN","PSOORNEW",139,0) ; "RTN","PSOORNEW",140,0) 5 D 3^PSOORNW2 Q ;pstat "RTN","PSOORNEW",141,0) ; "RTN","PSOORNEW",142,0) 13 D 12^PSOORNW2 Q ;doc "RTN","PSOORNEW",143,0) ; "RTN","PSOORNEW",144,0) 12 D 11^PSOORNW2 Q ;cli "RTN","PSOORNEW",145,0) ; "RTN","PSOORNEW",146,0) 2 N PSOCSIG I '$G(PSOBDRG) N PSOBDR,PSOBDRG S PSOBDRG=1 "RTN","PSOORNEW",147,0) D 2^PSOORNW1 Q:$G(PSOQFLG) D EN^PSODIAG ;drg/ICD "RTN","PSOORNEW",148,0) I $G(PSOCSIG) K PSOCSIG G 3 "RTN","PSOORNEW",149,0) Q "RTN","PSOORNEW",150,0) ; "RTN","PSOORNEW",151,0) 9 D 8^PSOORNW2 Q ;qty "RTN","PSOORNEW",152,0) ; "RTN","PSOORNEW",153,0) 8 D 7^PSOORNW2 Q ;ds "RTN","PSOORNEW",154,0) ; "RTN","PSOORNEW",155,0) 10 D 9^PSOORNW2 Q ;#rfs "RTN","PSOORNEW",156,0) ; "RTN","PSOORNEW",157,0) 14 D 13^PSOORNW2 Q ;cop "RTN","PSOORNEW",158,0) ; "RTN","PSOORNEW",159,0) 11 D 10^PSOORNW2 Q ;m/w "RTN","PSOORNEW",160,0) ; "RTN","PSOORNEW",161,0) 15 D 14^PSOORNW2 Q ;rem "RTN","PSOORNEW",162,0) ; "RTN","PSOORNEW",163,0) DRGMSG ; "RTN","PSOORNEW",164,0) F SG=1:1:$L($P(^PSDRUG(PSODRUG("IEN"),0),"^",10)) S:$L(^TMP("PSOPO",$J,IEN,0)_" "_$P($P(^PSDRUG(PSODRUG("IEN"),0),"^",10)," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOPO",$J,IEN,0)," ",20)=" " D "RTN","PSOORNEW",165,0) .S:$P($P(^PSDRUG(PSODRUG("IEN"),0),"^",10)," ",SG)'="" ^TMP("PSOPO",$J,IEN,0)=$G(^TMP("PSOPO",$J,IEN,0))_" "_$P($P(^PSDRUG(PSODRUG("IEN"),0),"^",10)," ",SG) "RTN","PSOORNEW",166,0) K SG "RTN","PSOORNEW",167,0) Q "RTN","PSOORNEW",168,0) ; "RTN","PSOORUT2") 0^17^B95782995^B65940792 "RTN","PSOORUT2",1,0) PSOORUT2 ;ISC BHAM/SAB - build listman screen ; 3/20/07 9:47am "RTN","PSOORUT2",2,0) ;;7.0;OUTPATIENT PHARMACY;**11,146,132,182,233,243,261,268,264,305,390**;DEC 1997;Build 86 "RTN","PSOORUT2",3,0) ;External reference to SDPHARM1 supported by DBIA 4196 "RTN","PSOORUT2",4,0) ;External reference ^PS(55 supported by DBIA 2228 "RTN","PSOORUT2",5,0) ;External reference ^DIC(31 supported by DBIA 658 "RTN","PSOORUT2",6,0) ;External reference ^DPT(D0,.372 supported by DBIA 1476 "RTN","PSOORUT2",7,0) ;External references to ^ORRDI1 supported by DBIA 4659 "RTN","PSOORUT2",8,0) ;External references to ^XTMP("ORRDI" supported by DBIA 4660 "RTN","PSOORUT2",9,0) ;External reference to ^GMRADPT supported by DBIA 190 "RTN","PSOORUT2",10,0) ;External reference to $$TERMLKUP^ORB31 supported by DBIA 5140 "RTN","PSOORUT2",11,0) ;External reference to $$BSA^PSSDSAPI supported by DBIA 5425 "RTN","PSOORUT2",12,0) ;External reference to ^ORQQVI supported by DBIA 5770 "RTN","PSOORUT2",13,0) ;External reference to ^ORQPTQ4 supported by DBIA 5785 "RTN","PSOORUT2",14,0) ;External reference to ^ORQQLR1 supported by DBIA 5787 "RTN","PSOORUT2",15,0) ; "RTN","PSOORUT2",16,0) K ^TMP("PSOHDR",$J),^TMP("PSOPI",$J) S DFN=PSODFN D ^VADPT,ADD^VADPT "RTN","PSOORUT2",17,0) S ^TMP("PSOHDR",$J,1,0)=VADM(1),^TMP("PSOHDR",$J,2,0)=$P(VADM(2),"^",2) "RTN","PSOORUT2",18,0) S ^TMP("PSOHDR",$J,3,0)=$P(VADM(3),"^",2),^TMP("PSOHDR",$J,4,0)=VADM(4),^TMP("PSOHDR",$J,5,0)=$P(VADM(5),"^",2) "RTN","PSOORUT2",19,0) D NVA "RTN","PSOORUT2",20,0) S POERR=1 D RE^PSODEM K POERR "RTN","PSOORUT2",21,0) S ^TMP("PSOHDR",$J,6,0)=$S($P(WT,"^",8):$P(WT,"^",9)_" ("_$P(WT,"^")_")",1:"_______ (______)") "RTN","PSOORUT2",22,0) S ^TMP("PSOHDR",$J,7,0)=$S($P(HT,"^",8):$P(HT,"^",9)_" ("_$P(HT,"^")_")",1:"_______ (______)") K VM,WT,HT S PSOHD=7 "RTN","PSOORUT2",23,0) S GMRA="0^0^111" D ^GMRADPT S ^TMP("PSOHDR",$J,8,0)=+$G(GMRAL) "RTN","PSOORUT2",24,0) S $P(^TMP("PSOHDR",$J,9,0)," ",62)="ISSUE LAST REF DAY" "RTN","PSOORUT2",25,0) S ^TMP("PSOHDR",$J,10,0)=" # RX # DRUG QTY ST DATE "_$S($G(PSORFG):"RELD",1:"FILL")_" REM SUP" "RTN","PSOORUT2",26,0) S PSOBSA=$$BSA^PSSDSAPI(DFN),PSOBSA=$P(PSOBSA,"^",3),PSOBSA=$S(PSOBSA'>0:"_______",1:$J(PSOBSA,4,2)) S ^TMP("PSOHDR",$J,12,0)=PSOBSA "RTN","PSOORUT2",27,0) S RSLT=$$CRCL(DFN) "RTN","PSOORUT2",28,0) ; RSLT -- DATE^CRCL^Serum Creatinine -- Ex. 11/25/11^68.7^1.1 "RTN","PSOORUT2",29,0) I $P(RSLT,"^",2)["Not Found" S ZDSPL=" CrCL: "_$P(RSLT,"^",2) "RTN","PSOORUT2",30,0) E S ZDSPL=" CrCL: "_$P($G(RSLT),"^",2)_"(est.) "_"(CREAT:"_$P($G(RSLT),"^",3)_"mg/dL "_$P($G(RSLT),"^")_")" "RTN","PSOORUT2",31,0) S ^TMP("PSOHDR",$J,13,0)=ZDSPL "RTN","PSOORUT2",32,0) D ELIG^VADPT S IEN=1,^TMP("PSOPI",$J,IEN,0)="Eligibility: "_$P(VAEL(1),"^",2)_$S(+VAEL(3):" SC%: "_$P(VAEL(3),"^",2),1:""),IEN=IEN+1 "RTN","PSOORUT2",33,0) S N=0 F S N=$O(VAEL(1,N)) Q:'N S $P(^TMP("PSOPI",$J,IEN,0)," ",14)=$P(VAEL(1,N),"^",2),IEN=IEN+1 "RTN","PSOORUT2",34,0) S ^TMP("PSOPI",$J,IEN,0)="",^TMP("PSOPI",$J,IEN,0)="RX PATIENT STATUS: "_$$GET1^DIQ(55,PSODFN,3),IEN=IEN+1 "RTN","PSOORUT2",35,0) S ^TMP("PSOPI",$J,IEN,0)=" ",IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)="Disabilities: " "RTN","PSOORUT2",36,0) F I=0:0 S I=$O(^DPT(DFN,.372,I)) Q:'I S I1=$S($D(^DPT(DFN,.372,I,0)):^(0),1:"") D:+I1 "RTN","PSOORUT2",37,0) .S PSDIS=$S($P($G(^DIC(31,+I1,0)),"^")]""&($P($G(^(0)),"^",4)']""):$P(^(0),"^"),$P($G(^DIC(31,+I1,0)),"^",4)]"":$P(^(0),"^",4),1:""),PSCNT=$P(I1,"^",2) "RTN","PSOORUT2",38,0) .S:$L(^TMP("PSOPI",$J,IEN,0)_PSDIS_"-"_PSCNT_"% ("_$S($P(I1,"^",3):"SC",1:"NSC")_"), ")>80 IEN=IEN+1,$P(^TMP("PSOPI",$J,IEN,0)," ",14)=" " "RTN","PSOORUT2",39,0) .S ^TMP("PSOPI",$J,IEN,0)=$G(^TMP("PSOPI",$J,IEN,0))_PSDIS_"-"_PSCNT_"% ("_$S($P(I1,"^",3):"SC",1:"NSC")_"), " "RTN","PSOORUT2",40,0) S IEN=IEN+1 S ^TMP("PSOPI",$J,IEN,0)=" ",IEN=IEN+1 "RTN","PSOORUT2",41,0) I +VAPA(9) S ^TMP("PSOPI",$J,IEN,0)=" (Temp Address from "_$P(VAPA(9),"^",2)_" till "_$S($P(VAPA(10),"^",2)]"":$P(VAPA(10),"^",2),1:"(no end date)")_")",IEN=IEN+1 "RTN","PSOORUT2",42,0) S ^TMP("PSOPI",$J,IEN,0)=VAPA(1) S:VAPA(2)]"" IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)=VAPA(2) S IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)=VAPA(3) "RTN","PSOORUT2",43,0) S ^TMP("PSOPI",$J,IEN,0)=^TMP("PSOPI",$J,IEN,0)_$J("",50-$L(VAPA(3)))_"HOME PHONE: "_VAPA(8) "RTN","PSOORUT2",44,0) S PSOTEL=$G(^DPT(DFN,.13)) "RTN","PSOORUT2",45,0) S IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)=VAPA(4),^TMP("PSOPI",$J,IEN,0)=^TMP("PSOPI",$J,IEN,0)_$J("",50-$L(VAPA(4)))_"CELL PHONE: "_$P(PSOTEL,"^",4) "RTN","PSOORUT2",46,0) S PSOTMP=$P(VAPA(5),"^",2)_" "_$S(VAPA(11)]"":$P(VAPA(11),"^",2),1:VAPA(6)),IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)=PSOTMP "RTN","PSOORUT2",47,0) S ^TMP("PSOPI",$J,IEN,0)=^TMP("PSOPI",$J,IEN,0)_$J("",50-$L(PSOTMP))_"WORK PHONE: "_$P(PSOTEL,"^",2) "RTN","PSOORUT2",48,0) S MAILD=+$P($G(^PS(55,DFN,0)),"^",3) D K MAILD "RTN","PSOORUT2",49,0) .S PSOTMP="Prescription Mail Delivery: "_$S(MAILD=1:"Certified Mail",MAILD=2:"DO NOT MAIL",MAILD=3:"Local - Regular Mail",MAILD=4:"Local - Certified Mail",1:"Regular Mail") S IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)=PSOTMP "RTN","PSOORUT2",50,0) .I MAILD<2!(MAILD>4) Q ;ONLY FOR MAIL DELIVERIES 2,3,4 "RTN","PSOORUT2",51,0) .N PSOMDEXP,Y "RTN","PSOORUT2",52,0) .S Y=$P($G(^PS(55,DFN,0)),"^",5) "RTN","PSOORUT2",53,0) .I Y,Y'>DT D "RTN","PSOORUT2",54,0) ..D DD^%DT S PSOMDEXP=Y "RTN","PSOORUT2",55,0) ..S ^TMP("PSOPI",$J,IEN,0)=^TMP("PSOPI",$J,IEN,0)_" Expire Date: "_PSOMDEXP "RTN","PSOORUT2",56,0) S IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)=$S($P($G(^PS(55,DFN,0)),"^",2):"Cannot use safety caps.",1:"") S $P(^TMP("PSOPI",$J,IEN,0)," ",40)=$S($P($G(^PS(55,DFN,0)),"^",4):"Dialysis Patient.",1:"") "RTN","PSOORUT2",57,0) I $G(^PS(55,DFN,1))]"" S PSON=^(1),IEN=IEN+1 D "RTN","PSOORUT2",58,0) .S ^TMP("PSOPI",$J,IEN,0)=" ",IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)=" Outpatient Narrative: " "RTN","PSOORUT2",59,0) .F I=1:1 Q:$P(PSON," ",I,99)="" S:$L(^TMP("PSOPI",$J,IEN,0)_$P(PSON," ",I)_" ")>80 IEN=IEN+1 S ^TMP("PSOPI",$J,IEN,0)=$G(^TMP("PSOPI",$J,IEN,0))_$P(PSON," ",I)_" " "RTN","PSOORUT2",60,0) S IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)=" " "RTN","PSOORUT2",61,0) I $D(^PS(52.91,DFN,0)) I '$P(^(0),"^",3)!($P(^(0),"^",3)>DT) D "RTN","PSOORUT2",62,0) .S IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)="Primary Care Appointment: "_$$PRIAPT^SDPHARM1(DFN) "RTN","PSOORUT2",63,0) .S IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)=" " "RTN","PSOORUT2",64,0) I 'GMRAL D "RTN","PSOORUT2",65,0) .S IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)="Allergies: "_$S(GMRAL=0:"NKA",1:"") "RTN","PSOORUT2",66,0) .I GMRAL'=0 S PSONOAL="" D ALLERGY I PSONOAL'="" S ^TMP("PSOPI",$J,IEN,0)="Allergies: "_PSONOAL K PSONOAL "RTN","PSOORUT2",67,0) .S IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)=" " "RTN","PSOORUT2",68,0) .D REMOTE "RTN","PSOORUT2",69,0) .S IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)="Adverse Reactions:" "RTN","PSOORUT2",70,0) D:$G(GMRAL) ^PSOORUT3 "RTN","PSOORUT2",71,0) K ^UTILITY("VASD",$J),VASD S DFN=PSODFN,VASD("F")=DT,VASD("T")=9999999,VASD("W")="123456789" D SDA^VADPT K VASD I $D(^UTILITY("VASD",$J)) D "RTN","PSOORUT2",72,0) .S IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)=" ",IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)="Pending Clinic Appointments:" "RTN","PSOORUT2",73,0) .F PSOAPP=0:0 S PSOAPP=$O(^UTILITY("VASD",$J,PSOAPP)) Q:'PSOAPP S PSOAPPE=$G(^UTILITY("VASD",$J,PSOAPP,"E")),PSOAPPI=$G(^("I")) D "RTN","PSOORUT2",74,0) ..K X S X2=DT,X1=$P($P($G(PSOAPPI),"^"),".") I $G(X1) D ^%DTC "RTN","PSOORUT2",75,0) ..S IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)=" "_$P(PSOAPPE,"^")_" "_$P(PSOAPPE,"^",2)_$S($P(PSOAPPI,"^",3)["C":" *** Canceled ***",1:" ("_$G(X)_" days)") "RTN","PSOORUT2",76,0) K ^UTILITY("VASD",$J),X,PSOAPPI,PSOAPPE,PSOAPP,N,PSOBSA,ZDSPL "RTN","PSOORUT2",77,0) S PSOPI=IEN K IEN "RTN","PSOORUT2",78,0) Q "RTN","PSOORUT2",79,0) NVA ; "RTN","PSOORUT2",80,0) Q:'$O(^PS(55,PSODFN,"NVA",0)) "RTN","PSOORUT2",81,0) K LSTDT F I=0:0 S I=$O(^PS(55,PSODFN,"NVA",I)) Q:'I D "RTN","PSOORUT2",82,0) .Q:$P(^PS(55,PSODFN,"NVA",I,0),"^",7) Q:'$P(^PS(55,PSODFN,"NVA",I,0),"^") "RTN","PSOORUT2",83,0) .I $P(^PS(55,PSODFN,"NVA",I,0),"^",10)>+$G(LSTDT) S LSTDT=$P(^(0),"^",10) "RTN","PSOORUT2",84,0) I $G(LSTDT)]"" D "RTN","PSOORUT2",85,0) .S LSTDT="Non-VA Meds on File - Last entry on "_$E(LSTDT,4,5)_"/"_$E(LSTDT,6,7)_"/"_$E(LSTDT,2,3) "RTN","PSOORUT2",86,0) .I $G(^TMP("PSOHDR",$J,5,0))="MALE" S $P(^TMP("PSOHDR",$J,5,0)," ",22)=LSTDT K LSTDT Q "RTN","PSOORUT2",87,0) .S $P(^TMP("PSOHDR",$J,5,0)," ",20)=LSTDT K LSTDT "RTN","PSOORUT2",88,0) K I "RTN","PSOORUT2",89,0) Q "RTN","PSOORUT2",90,0) REMOTE ; "RTN","PSOORUT2",91,0) I $T(HAVEHDR^ORRDI1)']"" Q "RTN","PSOORUT2",92,0) I '$$HAVEHDR^ORRDI1 Q "RTN","PSOORUT2",93,0) N PSORALG,REAC,S1,A,FILE,LEN,I "RTN","PSOORUT2",94,0) K ^TMP($J,"PSOART") "RTN","PSOORUT2",95,0) S PSORALG=1,PSORALG(1)="No remote data available" "RTN","PSOORUT2",96,0) I $D(^XTMP("ORRDI","OUTAGE INFO","DOWN")) G REMOTE2 "RTN","PSOORUT2",97,0) I $T(GET^ORRDI1)]"" S PSOSIEN=$G(IEN) D GET^ORRDI1(DFN,"ART") S IEN=PSOSIEN K PSOSIEN D "RTN","PSOORUT2",98,0) .I $P($G(^XTMP("ORRDI","ART",DFN,0)),"^",3)=0 S PSORALG(1)="No remote allergies" "RTN","PSOORUT2",99,0) .S S1=0,LEN=65,PSORALG=1,PSORALG(1)="" F S S1=$O(^XTMP("ORRDI","ART",DFN,S1)) Q:'S1 D "RTN","PSOORUT2",100,0) ..S A=$G(^XTMP("ORRDI","ART",DFN,S1,"REACTANT",0)),REAC=$P(A,"^",2),FILE=$P($P(A,"^",3),"99VA",2) "RTN","PSOORUT2",101,0) ..I FILE'=50.6,FILE'=120.82,FILE'=50.605,FILE'=50.416 Q "RTN","PSOORUT2",102,0) ..S ^TMP($J,"PSOART",REAC)="" "RTN","PSOORUT2",103,0) .S REAC="" F S REAC=$O(^TMP($J,"PSOART",REAC)) Q:REAC="" D "RTN","PSOORUT2",104,0) ..I $L(PSORALG(PSORALG))+$L(REAC)$P(PSCR,U,7) S PSCR=SCR "RTN","PSOORUT2",171,0) S SCR=PSCR,SCRV=$P(SCR,U,3) Q:+$G(SCRV)<.01 RSLT "RTN","PSOORUT2",172,0) S SCRD=$P(SCR,U,7) Q:'$L(SCRD) RSLT "RTN","PSOORUT2",173,0) ; "RTN","PSOORUT2",174,0) S HTGT60=$S(ZHT>60:(ZHT-60)*2.3,1:0) ;if ht > 60 inches "RTN","PSOORUT2",175,0) I HTGT60>0 D "RTN","PSOORUT2",176,0) .S IBW=$S(SEX="M":50+HTGT60,1:45.5+HTGT60) ;Ideal Body Weight "RTN","PSOORUT2",177,0) .S BWRATIO=(ABW/IBW) ;body weight ratio "RTN","PSOORUT2",178,0) .S BWDIFF=$S(ABW>IBW:ABW-IBW,1:0) "RTN","PSOORUT2",179,0) .S LOWBW=$S(IBW1.3,(BWDIFF>0) S ADJBW=((0.3*BWDIFF)+IBW) "RTN","PSOORUT2",181,0) .E S ADJBW=LOWBW "RTN","PSOORUT2",182,0) I +$G(ADJBW)<1 D "RTN","PSOORUT2",183,0) .S ADJBW=ABW "RTN","PSOORUT2",184,0) S CRCL=(((140-ZAGE)*ADJBW)/(SCRV*72)) "RTN","PSOORUT2",185,0) ; "RTN","PSOORUT2",186,0) S:SEX="M" RSLT=SCRD_U_$J(CRCL,1,1) "RTN","PSOORUT2",187,0) S:SEX="F" RSLT=SCRD_U_$J((CRCL*.85),1,1) "RTN","PSOORUT2",188,0) S X1=$P(RSLT,"^"),X2=$$FMTE^XLFDT(X1,"2M"),$P(RSLT,"^")=$P(X2,"@") K X1,X2 "RTN","PSOORUT2",189,0) S $P(RSLT,"^",3)=$P($G(SCR),"^",3) "RTN","PSOORUT2",190,0) K HTGT60,ABW,IBW,BWRATIO,BWDIFF,LOWBW,ADJBW,X1,X2,PSCR,PSRW,ABW,ZHT,PSRH,ZAGE,PSCXTL,PSCXTLS,SCR,OCXT,OCXTS,SCRV,CRCL "RTN","PSOORUT2",191,0) Q RSLT "RTN","PSORENW") 0^36^B38420531^B35245788 "RTN","PSORENW",1,0) PSORENW ;BIR/SAB-renew main driver ;4/25/07 8:42am "RTN","PSORENW",2,0) ;;7.0;OUTPATIENT PHARMACY;**11,27,30,46,71,96,100,130,148,206,390**;DEC 1997;Build 86 "RTN","PSORENW",3,0) ;External reference to ^PSDRUG supported by DBIA 221 "RTN","PSORENW",4,0) ;External references L, UL, PSOL, and PSOUL^PSSLOCK supported by DBIA 2789 "RTN","PSORENW",5,0) ;External reference to LK^ORX2 and ULK^ORX2 supported by DBIA 867 "RTN","PSORENW",6,0) ;External reference to ^PS(50.7 supported by DBIA 2223 "RTN","PSORENW",7,0) ;External reference to MAIN^TIUEDIT supported by DBIA 2410 "RTN","PSORENW",8,0) ; "RTN","PSORENW",9,0) ASK ; "RTN","PSORENW",10,0) K PSORENW("FILL DATE") D FILLDT^PSODIR2(.PSORENW) S:$G(PSORENW("DFLG")) VALMSG="Renew Rx request canceled",VALMBCK="R" "RTN","PSORENW",11,0) I PSORENW("DFLG")!('$D(PSORENW("FILL DATE"))) S PSORENW("QFLG")=1,PSORENW("DFLG")=0 G ASKX "RTN","PSORENW",12,0) S PSORNW("FILL DATE")=PSORENW("FILL DATE") "RTN","PSORENW",13,0) D MW^PSOCMOPA(.PSORENW) "RTN","PSORENW",14,0) I PSORENW("DFLG") S PSORENW("QFLG")=1,PSORENW("DFLG")=0 G ASKX "RTN","PSORENW",15,0) S PSORNW("MAIL/WINDOW")=PSORENW("MAIL/WINDOW") S PSORX("MAIL/WINDOW")=$S(PSORENW("MAIL/WINDOW")="M":"MAIL",1:"WINDOW") "RTN","PSORENW",16,0) D NOORE^PSONEW(.PSORENW) S:$G(PSORENW("DFLG")) VALMSG="Renew Rx request canceled",VALMBCK="R" "RTN","PSORENW",17,0) I PSORENW("DFLG")!('$D(PSORENW("FILL DATE"))) S PSORENW("QFLG")=1,PSORENW("DFLG")=0 "RTN","PSORENW",18,0) ASKX Q "RTN","PSORENW",19,0) ; "RTN","PSORENW",20,0) EOJ ; "RTN","PSORENW",21,0) K VERB,RTE,DRET,PSOMSG,PSORNW,PSOLIST,PSORENW,PSORX("BAR CODE"),PSORX("FILL DATE"),PSODIR,PSOID,PSONOOR,PSOCOU,PSOCOUU,PSOID,PSOFDMX,PSODRUG,COPY,PSOBCKDR "RTN","PSORENW",22,0) N ZRXN "RTN","PSORENW",23,0) S ZRXN=$G(RXN) "RTN","PSORENW",24,0) S RXN=$O(^TMP("PSORXN",$J,0)) I RXN S ZRXN=RXN D "RTN","PSORENW",25,0) .S RXN1=^TMP("PSORXN",$J,RXN) D EN^PSOHLSN1(RXN,$P(RXN1,"^"),$P(RXN1,"^",2),"",$P(RXN1,"^",3)) "RTN","PSORENW",26,0) .I $P(^PSRX(RXN,"STA"),"^")=5 D EN^PSOHLSN1(RXN,"SC","ZS",$P(RXN1,"^",4)) "RTN","PSORENW",27,0) ;saves drug allergy order chks pso*7*390 "RTN","PSORENW",28,0) I +$G(^TMP("PSODAOC",$J,1,0)) D "RTN","PSORENW",29,0) .I $G(PSORX("DFLG")) K ^TMP("PSODAOC",$J) Q "RTN","PSORENW",30,0) .S RXN=ZRXN,PSODAOC="Rx Backdoor "_$S($P(^PSRX(RXN,"STA"),"^")=4:"NON-VERIFIED ",1:"")_"RENEW Order Acceptance_OP" "RTN","PSORENW",31,0) .D DAOC^PSONEW "RTN","PSORENW",32,0) K ZRXN,RXN,RXN1,^TMP("PSORXN",$J),^TMP("PSODAOC",$J) "RTN","PSORENW",33,0) I $G(PSONOTE) D MAIN^TIUEDIT(3,.TIUDA,PSODFN,"","","","",1) "RTN","PSORENW",34,0) K PSONOTE "RTN","PSORENW",35,0) Q "RTN","PSORENW",36,0) OERR ;entry for renew backdoor "RTN","PSORENW",37,0) I $$LMREJ^PSOREJU1($P(PSOLST(ORN),"^",2),,.VALMSG,.VALMBCK) Q "RTN","PSORENW",38,0) S PSOPLCK=$$L^PSSLOCK(PSODFN,0) I '$G(PSOPLCK) D LOCK^PSOORCPY S VALMSG=$S($P($G(PSOPLCK),"^",2)'="":$P($G(PSOPLCK),"^",2)_" is working on this patient.",1:"Another person is entering orders for this patient.") K PSOPLCK S VALMBCK="" Q "RTN","PSORENW",39,0) K PSOPLCK S X=PSODFN_";DPT(" D LK^ORX2 I 'Y S VALMSG="Another person is entering orders for this patient.",VALMBCK="" D UL^PSSLOCK(PSODFN) Q "RTN","PSORENW",40,0) K PSOID,PSOFDMX,PSORX("FILL DATE"),PSORENW("FILL DATE"),PSORX("QS"),PSORENW("QS"),PSOBARCD,COPY "RTN","PSORENW",41,0) D PSOL^PSSLOCK($P(PSOLST(ORN),"^",2)) I '$G(PSOMSG) S VALMSG=$S($P($G(PSOMSG),"^",2)'="":$P($G(PSOMSG),"^",2),1:"Another person is editing this order."),VALMBCK="" K PSOMSG D ULPAT Q "RTN","PSORENW",42,0) S PSOBCKDR=1,PSOFROM="NEW",PSORENW("OIRXN")=$P(PSOLST(ORN),"^",2),PSOOPT=3,(PSORENW("DFLG"),PSORENW("QFLG"),PSORX("DFLG"))=0 "RTN","PSORENW",43,0) S PSONEW("DAYS SUPPLY")=$P(^PSRX(PSORENW("OIRXN"),0),"^",8),PSONEW("# OF REFILLS")=$P(^(0),"^",9) "RTN","PSORENW",44,0) D FULL^VALM1,ASK D:PSORENW("QFLG") KLIB^PSORENW1 D:PSORENW("QFLG") ULPAT D:PSORENW("QFLG") PSOUL^PSSLOCK($P(PSOLST(ORN),"^",2)) G:PSORENW("QFLG") EOJ D ^PSORENW0 "RTN","PSORENW",45,0) D ULPAT,EOJ,KLIB^PSORENW1 K PSOOPT,PSONEW,PSORX("DFLG") "RTN","PSORENW",46,0) Q "RTN","PSORENW",47,0) ULPAT K PSOMSG D UL^PSSLOCK(PSODFN) S X=PSODFN_";DPT(" D ULK^ORX2 "RTN","PSORENW",48,0) Q "RTN","PSORENW",49,0) RENEW(PLACER,PSOCPDRG) ;passes flag to CPRS for front door renews "RTN","PSORENW",50,0) ;-1=couldn't find order, 0=unable to renew, 1=renewable "RTN","PSORENW",51,0) ;Placer=Pharmacy number "RTN","PSORENW",52,0) N PSOSURX,PSORFRM,PSOLC,PSODRG,PSODRUG0,RXN,ST,PSONEWOI,PSOOLDOI,PSOIFLAG,PSOINA "RTN","PSORENW",53,0) I $G(PLACER)["S"!('$G(PLACER)) Q "-1^Not a Valid Outpatient Medication Order." "RTN","PSORENW",54,0) S RXN=PLACER I '$D(^PSRX(RXN,0)) Q "-1^Not a Valid Outpatient Medication Order." "RTN","PSORENW",55,0) S RX0=^PSRX(RXN,0),PSODRG=+$P(^PSRX(RXN,0),"^",6),ST=+^("STA"),PSODRUG0=^PSDRUG(PSODRG,0) "RTN","PSORENW",56,0) S PSOIFLAG=0,PSOOLDOI=+$P($G(^PSRX(RXN,"OR1")),"^"),PSONEWOI=+$P($G(^PSDRUG(+$G(PSODRG),2)),"^") I PSONEWOI,PSONEWOI'=PSOOLDOI S PSOIFLAG=1 "RTN","PSORENW",57,0) S PSOINA=$P($G(^PS(50.7,PSONEWOI,0)),"^",4) "RTN","PSORENW",58,0) I PSOINA,DT>PSOINA Q "0^This Orderable Item has been Inactivated." "RTN","PSORENW",59,0) I ST=5 S PSOSURX=$O(^PS(52.5,"B",RXN,0)) I PSOSURX,$P($G(^PS(52.5,PSOSURX,0)),"^",7)="L" Q "0^Rx loading into a CMOP Transmission." "RTN","PSORENW",60,0) S X1=DT,X2=-120 D C^%DTC I $P($G(^PSRX(RXN,2)),"^",6)$G(^("I")) Q "0^This Drug has been Inactivated." "RTN","PSORENW",67,0) I ($P(PSODRUG0,"^",3)[1)!($P(PSODRUG0,"^",3)[2)!($P(PSODRUG0,"^",3)["W") Q "0^Non-Renewable "_$S($P(PSODRUG0,"^",3)["A":"Drug Narcotic.",1:"Drug.") "RTN","PSORENW",68,0) I $D(^PS(53,+$P(RX0,"^",3),0)),'$P(^(0),"^",5) Q "0^Non-Renewable Prescription." "RTN","PSORENW",69,0) S PSOLC=$P(RX0,"^"),PSOLC=$E(PSOLC,$L(PSOLC)) I $A(PSOLC)'<90 Q "0^Max number of renewals (26) has been reached." "RTN","PSORENW",70,0) I ST,ST'=2,ST'=5,ST'=6,ST'=11,ST'=12,ST'=14 Q "0^Prescritpion is in a Non-Renewable Status." "RTN","PSORENW",71,0) I $P($G(^PSRX(RXN,"OR1")),"^",4) Q "0^Duplicate Rx Renewal Request." "RTN","PSORENW",72,0) I $O(^PS(52.41,"AQ",RXN,0)) Q "0^Duplicate Rx Renewal Request." "RTN","PSORENW",73,0) K PSORFRM,PSOLC,PSODRG,PSODRUG0,RXN,ST "RTN","PSORENW",74,0) Q 1_$S($G(PSOIFLAG):"^"_$G(PSONEWOI),1:"") "RTN","PSORENW",75,0) ; "RTN","PSORENW",76,0) INST1 ;Set Pharmacy Instructions array "RTN","PSORENW",77,0) N PSOTZ "RTN","PSORENW",78,0) I $O(^PSRX(RXN,"PI",0)) S PHI=$G(^PSRX(RXN,"PI",0)),PSOTZ=0 D "RTN","PSORENW",79,0) .F S PSOTZ=$O(^PSRX(RXN,"PI",PSOTZ)) Q:PSOTZ="" S PHI(PSOTZ)=$G(^PSRX(RXN,"PI",PSOTZ,0)) "RTN","PSORENW",80,0) Q "RTN","PSORENW",81,0) INST2 ;Set Instructions and Comments "RTN","PSORENW",82,0) I '$G(PSORENW("OIRXN")) Q "RTN","PSORENW",83,0) I $G(PSOFDR) Q "RTN","PSORENW",84,0) N PSOPHL,PSOPRL "RTN","PSORENW",85,0) I $O(^PSRX(PSORENW("OIRXN"),"PI",0)) K PHI S PHI=$G(^PSRX(PSORENW("OIRXN"),"PI",0)),PSOPHL="" D "RTN","PSORENW",86,0) .F S PSOPHL=$O(^PSRX(PSORENW("OIRXN"),"PI",PSOPHL)) Q:PSOPHL="" S PHI(PSOPHL)=$G(^PSRX(PSORENW("OIRXN"),"PI",PSOPHL,0)) "RTN","PSORENW",87,0) I $O(^PSRX(PSORENW("OIRXN"),"PRC",0)) K PRC S PRC=$G(^PSRX(PSORENW("OIRXN"),"PRC",0)),PSOPRL="" D "RTN","PSORENW",88,0) .F S PSOPRL=$O(^PSRX(PSORENW("OIRXN"),"PRC",PSOPRL)) Q:PSOPRL="" S PRC(PSOPRL)=$G(^PSRX(PSORENW("OIRXN"),"PRC",PSOPRL,0)) "RTN","PSORENW",89,0) Q "RTN","PSORENW4") 0^29^B60124334^B56734074 "RTN","PSORENW4",1,0) PSORENW4 ;BIR/SAB - rx speed renew ; 11/13/08 8:50am "RTN","PSORENW4",2,0) ;;7.0;OUTPATIENT PHARMACY;**11,23,27,32,37,64,46,75,71,100,130,117,152,148,264,225,301,390**;DEC 1997;Build 86 "RTN","PSORENW4",3,0) ;External reference to ^PSDRUG supported by DBIA 221 "RTN","PSORENW4",4,0) ;External reference to ^PS(50.7 supported by DBIA 2223 "RTN","PSORENW4",5,0) ;External references L, UL, PSOL, and PSOUL^PSSLOCK supported by DBIA 2789 "RTN","PSORENW4",6,0) ;External reference to LK^ORX2 and ULK^ORX2 supported by DBIA 867 "RTN","PSORENW4",7,0) SEL K PSODRUG ;PSO*7*301 "RTN","PSORENW4",8,0) I $P(PSOPAR,"^",4)=0 S VALMSG="Renewing is NOT Allowed. Check Site Parameters!",VALMBCK="" Q "RTN","PSORENW4",9,0) N VALMCNT I '$G(PSOCNT) S VALMSG="This patient has no Prescriptions!",VALMBCK="" Q "RTN","PSORENW4",10,0) S PSOPLCK=$$L^PSSLOCK(PSODFN,0) I '$G(PSOPLCK) D LOCK^PSOORCPY S VALMSG=$S($P($G(PSOPLCK),"^",2)'="":$P($G(PSOPLCK),"^",2)_" is working on this patient.",1:"Another person is entering orders for this patient.") K PSOPLCK S VALMBCK="" Q "RTN","PSORENW4",11,0) K PSOPLCK S X=PSODFN_";DPT(" D LK^ORX2 I 'Y S VALMSG="Another person is entering orders for this patient.",VALMBCK="" D UL^PSSLOCK(PSODFN) Q "RTN","PSORENW4",12,0) K PRC,PHI,PSORX("EDIT"),PSOFDR,DIR,DUOUT,DIRUT,PSORNSPD S DIR("A")="Select Orders by number",DIR(0)="LO^1:"_PSOCNT D ^DIR I $D(DTOUT)!($D(DUOUT)) K DIR,DIRUT,DTOUT,DUOUT S VALMBCK="" G SELQ "RTN","PSORENW4",13,0) K DIR,DIRUT,DTOUT,PSOOELSE,DTOUT I +Y S (SPEED,PSOOELSE,PSORNSPD)=1 D FULL^VALM1 S LST=Y D "RTN","PSORENW4",14,0) .S (PSODIR("DFLG"),PSODIR("FIELD"))=0,PSOOPT=3,(PSORENW("DFLG"),PSORENW("QFLG"),PSORX("DFLG"))=0 D INIT Q:PSORENW("DFLG") "RTN","PSORENW4",15,0) .F ORD=1:1:$L(LST,",") Q:$P(LST,",",ORD)']"" S ORN=$P(LST,",",ORD) D:+PSOLST(ORN)=52 PROCESS S PSORENW("DFLG")=0 "RTN","PSORENW4",16,0) I '$G(PSOOELSE) S VALMBCK="" G SELQ "RTN","PSORENW4",17,0) S VALMBCK="R" "RTN","PSORENW4",18,0) D ^PSOBUILD,BLD^PSOORUT1 K DIR,DIRUT,DTOUT,DUOUT,LST,ORD,IEN,ORN,RPH,ST,REFL,REF,PSOACT,ORSV,PSORNW,PSORENW,PSONO,PSOCO,PSOCU,PSODIR,DSMSG,SPEED,PSORENW,PSOOELSE,PSOOPT,PSORX("FILL DATE"),PSORX("ISSUE DATE"),PSOID,PSOMSG,PSORX("DFLG"),PSOQTY "RTN","PSORENW4",19,0) SELQ K PSORNSPD,RTE,DRET,PRC,PHI S X=PSODFN_";DPT(" D ULK^ORX2,UL^PSSLOCK(PSODFN),CLEAN^PSOVER1 "RTN","PSORENW4",20,0) Q "RTN","PSORENW4",21,0) ; "RTN","PSORENW4",22,0) PROCESS ; Process one order at a time "RTN","PSORENW4",23,0) I $$LMREJ^PSOREJU1($P(PSOLST(ORN),"^",2)) W $C(7),!!,"Rx "_$$GET1^DIQ(52,$P(PSOLST(ORN),"^",2),.01)_" has OPEN/UNRESOLVED 3rd Party Payer Rejects!" K DIR,PSOMSG D PAUSE^VALM1 Q "RTN","PSORENW4",24,0) D PSOL^PSSLOCK($P(PSOLST(ORN),"^",2)) I '$G(PSOMSG) W $C(7),!!,$S($P($G(PSOMSG),"^",2)'="":$P($G(PSOMSG),"^",2),1:"Another person is editing Rx "_$P(^PSRX($P(PSOLST(ORN),"^",2),0),"^")),! K DIR,PSOMSG D PAUSE^VALM1 Q "RTN","PSORENW4",25,0) K RET,DRET,PRC,PHI S PSORENW("OIRXN")=$P(PSOLST(ORN),"^",2),PSOFROM="NEW" "RTN","PSORENW4",26,0) S PSORENW("RX0")=^PSRX(PSORENW("OIRXN"),0),PSORENW("RX2")=^(2),PSORENW("RX3")=^(3),PSORENW("STA")=^("STA"),PSORENW("TN")=$G(^("TN")),SIGOK=$P($G(^PSRX(PSORENW("OIRXN"),"SIG")),"^",2) "RTN","PSORENW4",27,0) I SIGOK F I=0:0 S I=$O(^PSRX(PSORENW("OIRXN"),"SIG1",I)) Q:'I S SIG(I)=^PSRX(PSORENW("OIRXN"),"SIG1",I,0) "RTN","PSORENW4",28,0) S PSOIBOLD=$G(PSORENW("OIRXN")) D SETIB^PSORENW1 "RTN","PSORENW4",29,0) I '$G(PSORENW("PROVIDER")) D "RTN","PSORENW4",30,0) .S PSORENW("PROVIDER")=$P(PSORENW("RX0"),"^",4) "RTN","PSORENW4",31,0) .S:$P(PSORENW("RX3"),"^",3) PSORENW("COSIGNING PROVIDER")=$P(PSORENW("RX3"),"^",3) "RTN","PSORENW4",32,0) S PSORX("PROVIDER NAME")=$P($G(^VA(200,PSORENW("PROVIDER"),0)),"^") "RTN","PSORENW4",33,0) I '$G(PSORENW("CLINIC")) S PSORENW("CLINIC")=$P(PSORENW("RX0"),"^",5) "RTN","PSORENW4",34,0) S PSORENW("REMARKS")="RENEWED FROM RX # "_$P(PSORENW("RX0"),"^") "RTN","PSORENW4",35,0) S PSORENW("SIG")=$P($G(^PSRX(PSORENW("OIRXN"),"SIG")),"^") "RTN","PSORENW4",36,0) S PSORENW("PSODFN")=$P(PSORENW("RX0"),"^",2) "RTN","PSORENW4",37,0) S PSORENW("ORX #")=$P(PSORENW("RX0"),"^") "RTN","PSORENW4",38,0) S PSORENW("DRUG IEN")=$P(PSORENW("RX0"),"^",6) "RTN","PSORENW4",39,0) S PSORENW("QTY")=$P(PSORENW("RX0"),"^",7) "RTN","PSORENW4",40,0) ;S PSORENW("DAYS SUPPLY")=$P(PSORENW("RX0"),"^",8) "RTN","PSORENW4",41,0) ;S PSORENW("# OF REFILLS")=$P(PSORENW("RX0"),"^",9) "RTN","PSORENW4",42,0) S PSORENW("INS")=$S($G(PSORENW("ENT"))]"":PSORENW("ENT"),1:$G(^PSRX(PSORENW("OIRXN"),"INS"))) "RTN","PSORENW4",43,0) S:$G(PSORENW("ENT"))']"" PSORENW("ENT")=0 "RTN","PSORENW4",44,0) F I=0:0 S I=$O(^PSRX(PSORENW("OIRXN"),6,I)) Q:'I S DOSE=^PSRX(PSORENW("OIRXN"),6,I,0) D "RTN","PSORENW4",45,0) .S PSORENW("ENT")=PSORENW("ENT")+1,PSORENW("DOSE",PSORENW("ENT"))=$P(DOSE,"^") "RTN","PSORENW4",46,0) .S PSORENW("UNITS",PSORENW("ENT"))=$P(DOSE,"^",3),PSORENW("DOSE ORDERED",PSORENW("ENT"))=$P(DOSE,"^",2),PSORENW("ROUTE",PSORENW("ENT"))=$P(DOSE,"^",7) "RTN","PSORENW4",47,0) .S PSORENW("SCHEDULE",PSORENW("ENT"))=$P(DOSE,"^",8),PSORENW("DURATION",PSORENW("ENT"))=$P(DOSE,"^",5),PSORENW("CONJUNCTION",PSORENW("ENT"))=$P(DOSE,"^",6) "RTN","PSORENW4",48,0) .S PSORENW("NOUN",PSORENW("ENT"))=$P(DOSE,"^",4),PSORENW("VERB",PSORENW("ENT"))=$P(DOSE,"^",9) "RTN","PSORENW4",49,0) .I $G(^PSRX(PSORENW("OIRXN"),6,I,1))]"" S PSORENW("ODOSE",PSORENW("ENT"))=^PSRX(PSORENW("OIRXN"),6,I,1) "RTN","PSORENW4",50,0) .K DOSE "RTN","PSORENW4",51,0) I $P($G(^PSDRUG(PSORENW("DRUG IEN"),"CLOZ1")),"^")="PSOCLO1" N PSON S PSON=0 D I PSON K PSON D POZ,KLIB^PSORENW1 D PSOUL^PSSLOCK($P(PSOLST(ORN),"^",2)) Q "RTN","PSORENW4",52,0) . I '$L($P(^VA(200,PSORENW("PROVIDER"),"PS"),"^",2)),'$L($P(^VA(200,PSORENW("PROVIDER"),"PS"),"^",3)) D Q "RTN","PSORENW4",53,0) . . S PSON=1 W $C(7),!!,"Only providers with DEA# or a VA# can write prescriptions for clozapine.",! "RTN","PSORENW4",54,0) . I '$D(^XUSEC("YSCL AUTHORIZED",PSORENW("PROVIDER"))) D "RTN","PSORENW4",55,0) . . S PSON=1 W $C(7),!!,"Provider must hold YSCL AUTHORIZED key to write prescriptions for clozapine.",! "RTN","PSORENW4",56,0) I $G(PSORNW("MAIL/WINDOW"))]"" S PSORENW("MAIL/WINDOW")=PSORNW("MAIL/WINDOW") "RTN","PSORENW4",57,0) I $O(^PSRX(PSORENW("OIRXN"),"PI",0)) D K T "RTN","PSORENW4",58,0) .S PHI=^PSRX(PSORENW("OIRXN"),"PI",0),T=0 "RTN","PSORENW4",59,0) .F S T=$O(^PSRX(PSORENW("OIRXN"),"PI",T)) Q:'T S PHI(T)=^PSRX(PSORENW("OIRXN"),"PI",T,0) "RTN","PSORENW4",60,0) ;I $O(^PSRX(PSORENW("OIRXN"),"PRC",0)) D K T "RTN","PSORENW4",61,0) ;.S PRC=^PSRX(PSORENW("OIRXN"),"PRC",0),T=0 "RTN","PSORENW4",62,0) ;.F S T=$O(^PSRX(PSORENW("OIRXN"),"PRC",T)) Q:'T S PRC(T)=^PSRX(PSORENW("OIRXN"),"PRC",T,0) "RTN","PSORENW4",63,0) W !!,"Now Renewing Rx # "_PSORENW("ORX #")_" Drug: "_$P($G(^PSDRUG(+$G(PSORENW("DRUG IEN")),0)),"^"),! "RTN","PSORENW4",64,0) I '$P($G(^PSDRUG($P(PSORENW("RX0"),"^",6),2)),"^") D G:$G(PSORENW("DFLG")) PROCESSX "RTN","PSORENW4",65,0) .I $P($G(^PSRX(PSORENW("OIRXN"),"OR1")),"^") S PSODRUG("OI")=$P(^PSRX(PSORENW("OIRXN"),"OR1"),"^"),PSODRUG("OIN")=$P(^PS(50.7,+^("OR1"),0),"^") Q "RTN","PSORENW4",66,0) .W !!,"Cannot Renew!! No Pharmacy Orderable Item!" S VALMSG="Cannot Renew!! No Pharmacy Orderable Item!",PSORX("DFLG")=1 "RTN","PSORENW4",67,0) D CHECK^PSORENW0 G:PSORENW("DFLG") PROCESSX "RTN","PSORENW4",68,0) D FILDATE^PSORENW0 "RTN","PSORENW4",69,0) D DRUG^PSORENW0 G:PSORENW("DFLG") PROCESSX "RTN","PSORENW4",70,0) D RXN^PSORENW0 G:PSORENW("DFLG") PROCESSX "RTN","PSORENW4",71,0) D STOP^PSORENW1 "RTN","PSORENW4",72,0) DSPL K PSOEDT,PSOLM S PSDY=PSORENW("DAYS SUPPLY"),PSRF=PSORENW("# OF REFILLS") "RTN","PSORENW4",73,0) F DEA=1:1 Q:$E(PSODRUG("DEA"),DEA)="" I $E(+PSODRUG("DEA"),DEA)>1,$E(+PSODRUG("DEA"),DEA)<6 S PSODIR("CS")=1 "RTN","PSORENW4",74,0) I $G(PSODIR("CS")) D "RTN","PSORENW4",75,0) .S PSORENW("# OF REFILLS")=$S(PSDY<60:5,PSDY'<60&(PSDY'>89):2,PSDY=90:1,1:0) "RTN","PSORENW4",76,0) .I PSORENW("# OF REFILLS")>PSRF S PSORENW("# OF REFILLS")=PSRF "RTN","PSORENW4",77,0) D DSPLY^PSORENW3 G:PSORENW("DFLG") PROCESSX "RTN","PSORENW4",78,0) D:$D(^XUSEC("PSORPH",DUZ))!('$P(PSOPAR,"^",2)) VER1^PSOORNE4(.PSORENW) G:PSORENW("DFLG")=1 PROCESSX "RTN","PSORENW4",79,0) I $G(PSOQTY) D QTY^PSODIR1(.PSORENW) G:PSORENW("DFLG")=1 PROCESSX "RTN","PSORENW4",80,0) D EN^PSORN52(.PSORENW) "RTN","PSORENW4",81,0) D RNPSOSD^PSOUTIL "RTN","PSORENW4",82,0) D CAN^PSORENW0,DCORD^PSONEW2 "RTN","PSORENW4",83,0) S PSORENW("# OF REFILLS")=PSRF K PSDY,PSRF,PSODIR("CS"),DEA,PSORENW("ENT") "RTN","PSORENW4",84,0) S BBRN="",BBRN1=$O(^PSRX("B",PSORENW("NRX #"),BBRN)) I $P($G(^PSRX(BBRN1,0)),"^",11)["W" S BINGCRT="Y",BINGRTE="W",BBFLG=1,BBRX(1)=$G(BBRX(1))_BBRN1_"," "RTN","PSORENW4",85,0) PROCESSX I PSORENW("DFLG") D W:'$G(POERR) !,$C(7),"Rx NOT RENEWED. RENEWED RX DELETED",! S POERR("DFLG")=1 D CLEAN^PSOVER1 "RTN","PSORENW4",86,0) .K PHI,PRC,PSODRUG,SIG,PSORXED,SIGOK "RTN","PSORENW4",87,0) .K PSORENW("DOSE"),PSORENW("DURATION"),PSORENW("DRUG IEN"),PSORENW("ENT"),PSORENW("INS"),PSORENW("NOUN"),PSORENW("ROUTE"),PSORENW("SCHEDULE"),PSORENW("SIG"),PSORENW("VERB"),PSORENW("UNITS") "RTN","PSORENW4",88,0) .D POZ "RTN","PSORENW4",89,0) K PSORDLOK I PSORENW("DFLG") S PSORDLOK=1 "RTN","PSORENW4",90,0) D:$G(PSORENW("OLD FILL DATE"))]"" SUSDATEK^PSOUTIL(.PSORENW) "RTN","PSORENW4",91,0) K BBRN,BBRN1,PSODRUG,PSORX("PROVIDER NAME"),PSORX("CLINIC") "RTN","PSORENW4",92,0) K PSOEDT,PSOLM S:$G(PSORENW("FROM"))="" (PSORENW("DFLG"),PSORENW("QFLG"))=0 "RTN","PSORENW4",93,0) I $G(PSORDLOK) D PSOUL^PSSLOCK($P(PSOLST(ORN),"^",2)) "RTN","PSORENW4",94,0) D KLIB^PSORENW1 "RTN","PSORENW4",95,0) K PSORDLOK "RTN","PSORENW4",96,0) S RXN=$O(^TMP("PSORXN",$J,0)) I RXN N ZRXN S ZRXN=RXN D "RTN","PSORENW4",97,0) .S RXN1=^TMP("PSORXN",$J,RXN) D EN^PSOHLSN1(RXN,$P(RXN1,"^"),$P(RXN1,"^",2),"",$P(RXN1,"^",3)) "RTN","PSORENW4",98,0) .I $P(^PSRX(RXN,"STA"),"^")=5 D EN^PSOHLSN1(RXN,"SC","ZS",$P(RXN1,"^",4)) "RTN","PSORENW4",99,0) .;saves drug allergy order chks pso*7*390 "RTN","PSORENW4",100,0) .I +$G(^TMP("PSODAOC",$J,1,0)) D "RTN","PSORENW4",101,0) .I $G(PSORX("DFLG"))!$G(PSORENW("DFLG")) K ^TMP("PSODAOC",$J) Q "RTN","PSORENW4",102,0) .S RXN=ZRXN,PSODAOC="Rx Backdoor "_$S($P(^PSRX(RXN,"STA"),"^")=4:"NON-VERIFIED ",1:"")_"SPEED RENEW Order Acceptance_OP" "RTN","PSORENW4",103,0) .D DAOC^PSONEW "RTN","PSORENW4",104,0) K ZRXN,RXN,RXN1,^TMP("PSORXN",$J),^TMP("PSODAOC",$J) "RTN","PSORENW4",105,0) Q "RTN","PSORENW4",106,0) INIT ; "RTN","PSORENW4",107,0) D ASK Q:PSORENW("DFLG") "RTN","PSORENW4",108,0) D NOORE^PSONEW(.PSORENW) Q:PSORENW("DFLG") "RTN","PSORENW4",109,0) Q "RTN","PSORENW4",110,0) ASK ;upfront questions "RTN","PSORENW4",111,0) W !! D ISSDT^PSODIR2(.PSORENW) Q:PSORENW("DFLG") S PSORENW("ISSUE DATE")=PSOID "RTN","PSORENW4",112,0) D FILLDT^PSODIR2(.PSORENW) K PSONEW("DAYS SUPPLY"),PSONEW("# OF REFILLS") Q:PSORENW("DFLG") "RTN","PSORENW4",113,0) S PSORNW("FILL DATE")=PSORENW("FILL DATE") "RTN","PSORENW4",114,0) D MW^PSODIR2(.PSORENW) Q:PSORENW("DFLG") "RTN","PSORENW4",115,0) D PTSTAT^PSODIR1(.PSORENW) Q:PSORENW("DFLG") "RTN","PSORENW4",116,0) D DAYS^PSODIR1(.PSORENW) Q:PSORENW("DFLG") "RTN","PSORENW4",117,0) S PSODRUG("DEA")=0 D REFILL^PSODIR1(.PSORENW) K PSODRUG("DEA") Q:PSORENW("DFLG") "RTN","PSORENW4",118,0) K DIR,DIRUT S DIR(0)="Y",DIR("B")="No",DIR("A")="Do you want to edit Renewed Rx(s) QTY " D ^DIR I $D(DIRUT) S PSORENW("DFLG")=1 K DIR,DIRUT Q "RTN","PSORENW4",119,0) S PSOQTY=Y K DIR,DIRUT "RTN","PSORENW4",120,0) D CLINIC^PSODIR2(.PSORENW) Q:PSORENW("DFLG") "RTN","PSORENW4",121,0) D PROV^PSODIR(.PSORENW) S:PSORENW("DFLG") PSORENW("DFLG")=0 "RTN","PSORENW4",122,0) Q "RTN","PSORENW4",123,0) ; "RTN","PSORENW4",124,0) POZ ; "RTN","PSORENW4",125,0) K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR,DIRUT,DTOUT "RTN","PSORENW4",126,0) Q "RTN","PSORXEDT") 0^31^B44148603^B39990451 "RTN","PSORXEDT",1,0) PSORXEDT ;BIR/SAB-edit rx routine ;10/21/98 "RTN","PSORXEDT",2,0) ;;7.0;OUTPATIENT PHARMACY;**21,23,44,71,146,185,148,253,390**;DEC 1997;Build 86 "RTN","PSORXEDT",3,0) ;Ref. ^PS(55 supp. IA 2228 "RTN","PSORXEDT",4,0) ;;External reference to $$BSA^PSSDSAPI supported by DBIA 5425 "RTN","PSORXEDT",5,0) D:'$D(PSOPAR) ^PSOLSET I '$D(PSOPAR) G EOJ Q "RTN","PSORXEDT",6,0) K PSODRUG,PSOLIST,DIR,DIRUT,DUOUT,X,Y,PSOFROM,^TMP("PSOBEDT",$J),NOPP,CLOZPST "RTN","PSORXEDT",7,0) W !! S DIR(0)="FAO^1:245",DIR("A")="Edit Rx(s) => ",DIR("?",1)="Enter Rx Number or A List of numbers Separated",DIR("?")="by Commas, e.g. 1234A,345,937002Q." "RTN","PSORXEDT",8,0) D ^DIR K DIR G:$D(DIRUT) EOJ "RTN","PSORXEDT",9,0) S END=$L(X,","),BAD=0 "RTN","PSORXEDT",10,0) F I=1:1:END S RXM=$P(X,",",I) I +RXM F J=I+1:1:END S DUP=$P(X,",",J) I DUP=RXM S $P(X,",",J)="" W !?5,$C(7),"Duplicate Rx # "_RXM_" was found in your list, ignoring it!",! S BAD=1 "RTN","PSORXEDT",11,0) S PSORLST=$P(X,",") F I=2:1:END S RXM=$P(X,",",I) S:RXM'?1.N.A BAD=1 I RXM?1.N.A S PSORLST=PSORLST_","_RXM "RTN","PSORXEDT",12,0) F I=1:1:$L(PSORLST) S RXM=$P(PSORLST,",",I) I +RXM F J=I+1:1:END S DUP=$P(PSORLST,",",J) I DUP=RXM S $P(PSORLST,",",J)="" "RTN","PSORXEDT",13,0) BAD I PSORLST D I 'Y K Y G PSORXEDT "RTN","PSORXEDT",14,0) .W !?15,"=> "_PSORLST "RTN","PSORXEDT",15,0) .K DIR,DIRUT S DIR(0)="Y",DIR("A")="Is this OKAY ",DIR("B")="Yes" "RTN","PSORXEDT",16,0) .D ^DIR K DIR "RTN","PSORXEDT",17,0) .I 'Y!$D(DIRUT) K X,PSORLST,BAD "RTN","PSORXEDT",18,0) K BAD I 'PSORLST K PSORLST G PSORXEDT "RTN","PSORXEDT",19,0) F I=1:1:$L(PSORLST,",") S RXM=$P(PSORLST,",",I) S GOOD=$D(^PSRX("B",RXM)) D "RTN","PSORXEDT",20,0) .I 'GOOD W !!?5,"Couldn't Find RX # "_RXM H 3 Q "RTN","PSORXEDT",21,0) .S RXN=$O(^PSRX("B",RXM,0)) D I $P(^PSRX(RXN,"STA"),"^")=13 W !!?5,"Rx # "_RXM_" is marked for Deletion." H 3 Q "RTN","PSORXEDT",22,0) ..I $G(RXN),$P($G(^PS(55,+$P($G(^PSRX(RXN,0)),"^",2),0)),"^",6)'=2 S PSOLOUD=1 D EN^PSOHLUP(+$P($G(^PSRX(RXN,0)),"^",2)) K PSOLOUD "RTN","PSORXEDT",23,0) .D LIST K GOOD "RTN","PSORXEDT",24,0) K GOOD,END "RTN","PSORXEDT",25,0) EPH ; - Entry for Epharmacy Rx Edit (PSOREJP1) "RTN","PSORXEDT",26,0) F PSOT1=1:1 Q:'$D(PSOLIST(PSOT1)) F PSOLST2=1:1:$L(PSOLIST(PSOT1),",") S ORN=$P(PSOLIST(PSOT1),",",PSOLST2) D:+ORN PT "RTN","PSORXEDT",27,0) ;call to add bingo board data to file 52.11 "RTN","PSORXEDT",28,0) K POP,PSOLIST,TM,TM1 G:'$O(PSORX("PSOL",0)) NX "RTN","PSORXEDT",29,0) D:$G(PSORX("PSOL",1))]"" ^PSORXL K PSORX G:$G(NOBG) NX "RTN","PSORXEDT",30,0) PRF G:'$P(PSOPAR,"^",8)!($G(NOPP)="H")!($G(NOPP)="S")!('$D(^TMP("PSOBEDT",$J))) BBG "RTN","PSORXEDT",31,0) I $O(^TMP("PSOBEDT",$J,0)),$P(PSOPAR,"^",8) S PSOFROM="NEW",PSOION=ION K RXRS "RTN","PSORXEDT",32,0) G:$D(PSOPROP)&($G(PSOPROP)'=ION) QUP "RTN","PSORXEDT",33,0) I '$D(PSOPROP)!($G(PSOPROP)=ION) D G:$G(POP)!($E(IOST)["C")!(PSOION=ION) BBG "RTN","PSORXEDT",34,0) .S PSOION=ION W !,"Profiles must be sent to Printer !!",! K IOP,%ZIS,IO("Q"),POP "RTN","PSORXEDT",35,0) .S %ZIS="MNQ",%ZIS("A")="Select Profile Device: " D ^%ZIS K %ZIS("A") "RTN","PSORXEDT",36,0) .Q:$G(POP)!($E(IOST)["C")!(PSOION=ION) S PSOPROP=ION "RTN","PSORXEDT",37,0) QUP S X1=DT,X2=-120 D C^%DTC S PSODTCUT=X,HOLDRPAS=$G(PSOPRPAS),PSOPRPAS=$P(PSOPAR,"^",13) "RTN","PSORXEDT",38,0) F DFN=0:0 S DFN=$O(^TMP("PSOBEDT",$J,DFN)) Q:'DFN S PPL=^TMP("PSOBEDT",$J,DFN,0) D "RTN","PSORXEDT",39,0) .S ZTRTN="DQ^PSOPRF",ZTIO=PSOPROP,ZTDESC="Outpatient Pharmacy Patient Profiles",ZTDTH=$H "RTN","PSORXEDT",40,0) .F G="PSOPAR","PSODTCUT","PSOPRPAS","DFN","PSOSITE","NEW1","NEW11","PSOBMST","PFIO","PPL" S:$D(@G) ZTSAVE(G)="" "RTN","PSORXEDT",41,0) .D ^%ZTLOAD "RTN","PSORXEDT",42,0) W:$D(ZTSK) !,"PROFILE(S) QUEUED to PRINT",!! K G,ZTSK D ^%ZISC "RTN","PSORXEDT",43,0) S PSOPRPAS=$G(HOLDRPAS) K:PSOPRPAS']"" PSOPRPAS K HOLDRPAS "RTN","PSORXEDT",44,0) BBG K DFN F PSODFN=0:0 S PSODFN=$O(^TMP("PSOBEDT",$J,PSODFN)) Q:'PSODFN I $G(^TMP("PSOBEDT",$J,PSODFN,1)),$D(DISGROUP) S TM=$P($G(^TMP("PSOBB",$J)),"^"),TM1=$P($G(^($J)),"^",2),PPL=^TMP("PSOBEDT",$J,PSODFN,0) D ^PSOBING1 "RTN","PSORXEDT",45,0) NX ; "RTN","PSORXEDT",46,0) K %X,%Y,ACTREF,ACTREN,D,D0,DAT,DFN,DIC,DIQ,DQ,DRG,END,FDR,PSOBEDT,TM,TM1,PSOT1,PSOLST2,NOBG,BBFLG,BINGCRT,BINGRTE,C,CC,CMOP,COM,CT,D1,DI,DREN,BBRX,PSOFROM,POP,PSORX("QFLG"),IT,PSOERR,PSOBCK,PSOBM,PPL "RTN","PSORXEDT",47,0) K ^TMP("PSOBEDT",$J),^TMP("PSOBB",$J),ZTSK,NOPP,VALMSG,VALMBCK D EOJ "RTN","PSORXEDT",48,0) END Q "RTN","PSORXEDT",49,0) ;--------------------------------------------------------- "RTN","PSORXEDT",50,0) PT ; "RTN","PSORXEDT",51,0) N PSOTXEDT,PSOTPEXT S PSOTXEDT=$P($G(^PSRX(ORN,0)),"^",2) I PSOTXEDT I $D(^PS(52.91,PSOTXEDT,0)) I '$P(^PS(52.91,PSOTXEDT,0),"^",3)!($P(^(0),"^",3)>DT) D PDIR^PSOTPCAN(PSOTXEDT) I $G(PSOTPEXT) K PSOTPEXT,PSOTXEDT D EOJ Q "RTN","PSORXEDT",52,0) K PSOTXEDT,PSOTPEXT "RTN","PSORXEDT",53,0) D NOW^%DTC S TM=$E(%,1,12),TM1=$P(TM,".",2) S ^TMP("PSOBB",$J)=TM_"^"_TM1 "RTN","PSORXEDT",54,0) S $P(PSOLST(ORN),"^",2)=ORN,(PSOBEDT)=1 "RTN","PSORXEDT",55,0) S (DFN,PSODFN)=+$P(^PSRX(ORN,0),"^",2),PSORX("NAME")=$P(^DPT(DFN,0),"^") "RTN","PSORXEDT",56,0) D ICN^PSODPT(DFN) "RTN","PSORXEDT",57,0) S RX0=^PSRX(ORN,0),RX2=$G(^(2)),RX3=$G(^(3)) "RTN","PSORXEDT",58,0) D:$G(DUZ("AG"))="V" COPAY^PSOPTPST ; Deals with copay "RTN","PSORXEDT",59,0) K ^TMP("PSOHDR",$J),^TMP("PSOPI",$J) D ^VADPT,ADD^VADPT "RTN","PSORXEDT",60,0) S ^TMP("PSOHDR",$J,1,0)=VADM(1),^TMP("PSOHDR",$J,2,0)=$P(VADM(2),"^",2) "RTN","PSORXEDT",61,0) S ^TMP("PSOHDR",$J,3,0)=$P(VADM(3),"^",2) "RTN","PSORXEDT",62,0) S ^TMP("PSOHDR",$J,4,0)=VADM(4),^TMP("PSOHDR",$J,5,0)=$P(VADM(5),"^",2) "RTN","PSORXEDT",63,0) S POERR=1 D RE^PSODEM K POERR,VALMBCK "RTN","PSORXEDT",64,0) S ^TMP("PSOHDR",$J,6,0)=$S($P(WT,"^",8):$P(WT,"^",9)_" ("_$P(WT,"^")_")",1:"_______ (______)") "RTN","PSORXEDT",65,0) S ^TMP("PSOHDR",$J,7,0)=$S($P(HT,"^",8):$P(HT,"^",9)_" ("_$P(HT,"^")_")",1:"_______ (______)") K VM,WT,HT S PSOHD=7 "RTN","PSORXEDT",66,0) S ^TMP("PSOHDR",$J,9,0)="",^TMP("PSOHDR",$J,10,0)="" "RTN","PSORXEDT",67,0) S GMRA="0^0^111" D ^GMRADPT S ^TMP("PSOHDR",$J,8,0)=+$G(GMRAL) "RTN","PSORXEDT",68,0) S PSOBSA=$$BSA^PSSDSAPI(DFN),PSOBSA=$P(PSOBSA,"^",3),PSOBSA=$S(PSOBSA'>0:"_______",1:$J(PSOBSA,4,2)) S ^TMP("PSOHDR",$J,12,0)=PSOBSA "RTN","PSORXEDT",69,0) S RSLT=$$CRCL^PSOORUT2(DFN) "RTN","PSORXEDT",70,0) I $P(RSLT,"^",2)["Not Found" S ZDSPL=" CrCL: "_$P(RSLT,"^",2) "RTN","PSORXEDT",71,0) E S ZDSPL=" CrCL: "_$P($G(RSLT),"^",2)_"(est.) "_"(CREAT:"_$P($G(RSLT),"^",3)_"mg/dL "_$P($G(RSLT),"^")_")" "RTN","PSORXEDT",72,0) S ^TMP("PSOHDR",$J,13,0)=ZDSPL "RTN","PSORXEDT",73,0) K PSOBSA,RSLT,ZDSPL "RTN","PSORXEDT",74,0) D NOW^%DTC S TM=$E(%,1,12),TM1=$P(TM,".",2) S ^TMP("PSOBB",$J)=TM_"^"_TM1 "RTN","PSORXEDT",75,0) S PSOLOUD=1 D:$P($G(^PS(55,PSODFN,0)),"^",6)'=2 EN^PSOHLUP(PSODFN) K PSOLOUD "RTN","PSORXEDT",76,0) S PSOX=$G(^PS(55,PSODFN,"PS")) I PSOX]"" S PSORX("PATIENT STATUS")=$P($G(^PS(53,PSOX,0)),"^") "RTN","PSORXEDT",77,0) D CLEAR^VALM1 "RTN","PSORXEDT",78,0) S STA="ACTIVE^NON-VERIFIED^REFILL^HOLD^NON-VERIFIED^SUSPENDED^^^^^^EXPIRED^DISCONTINUED^^DISCONTINUED^DISCONTINUED^HOLD" "RTN","PSORXEDT",79,0) S $P(PSOLST(ORN),"^",3)=$P(STA,"^",$P(^PSRX(ORN,"STA"),"^")+1),PSLST=ORN,ORD=1 "RTN","PSORXEDT",80,0) D ACT^PSOORNE2 "RTN","PSORXEDT",81,0) EOJ ; "RTN","PSORXEDT",82,0) K INS1,HDR,IK,INDT,LOG,NODE,ORN,P1,PSI,PSL,PSOLION,PSNP,PSOACT,PSOBM,PSOCLC,PSOCNT,PSODD,PSODFN,PSOHD,PSOJ,PSOLST,PSOOI,PSOPF,PSLST "RTN","PSORXEDT",83,0) K PSOIBQS,PSORLST,PSOSD,PSOSIG,PSPRXN,PSORX0,PSORX1,PTST,REFL,RF,RFD,RIFN,RLD,RPH,RTS,RX0,RX1,RX2,RX3,RXM,RXOR,SIG,SIGOK "RTN","PSORXEDT",84,0) D KVA^VADPT K SLPPL,ST,STA,^TMP("PS",$J),PSOQFLG,PSORXED,PSOEDIT,DIR,DIRUT,DUOUT,DTOUT,PSOLOUD,GMRAL,GG,FEV,ACNT "RTN","PSORXEDT",85,0) D FULL^VALM1 K ^TMP("PSOAL",$J),^TMP("PSOAO",$J),^TMP("PSOSF",$J),^TMP("PSOPF",$J),^TMP("PSOPI",$J),^TMP("PSOPO",$J),^TMP("PSOHDR",$J),PAT "RTN","PSORXEDT",86,0) K JJ,K,MM,PSDAYS,PSOAC,PSOAL,PSOCOU,PSOCOUU,PSONEW,PSODRUG,PSONOOR,PSRX0,QTY,REA,RFCNT,RFDT,RXDA,RXFL,RXREF,SUB,X,Z,ZII "RTN","PSORXEDT",87,0) K ACOM,CRIT,DA,DDH,DGI,DGS,PSONEW3,SER,SERS,ZONE,RN,RXN,PSOX,PSOERR,ORD,PSOBCK,PSOBILL,SURX,PSORX("QFLG"),PSORX("FN"),CLOZPAT "RTN","PSORXEDT",88,0) Q "RTN","PSORXEDT",89,0) LIST ; "RTN","PSORXEDT",90,0) I $G(^PSRX(RXN,0))']"" W !,$C(7),"Rx data is not on file !",! G LISTX "RTN","PSORXEDT",91,0) I $P(^PSRX(RXN,0),"^",15)=13 S PSVD=1 W !,$C(7),"Rx # "_RXM_" has been deleted." "RTN","PSORXEDT",92,0) S RXN1=RXN,RXM1=RXM D:'$G(PSVD) LST1 W "." S RXN=RXN1,RXM=RXM1 K RXN1,RXM1 "RTN","PSORXEDT",93,0) F S RXN=$O(^PSRX("B",RXM,RXN)) Q:'RXN D "RTN","PSORXEDT",94,0) .I $G(^PSRX(RXN,0))']"" Q "RTN","PSORXEDT",95,0) .I $P(^PSRX(RXN,0),"^",15)=13 Q "RTN","PSORXEDT",96,0) .D LST1 "RTN","PSORXEDT",97,0) K RXN1 G LISTX "RTN","PSORXEDT",98,0) Q "RTN","PSORXEDT",99,0) LST1 I $G(PSOLIST(1))']"" S PSOLIST(1)=RXN_"," G LISTX "RTN","PSORXEDT",100,0) F PSOX1=0:0 S PSOX1=$O(PSOLIST(PSOX1)) Q:'PSOX1 S PSOX2=PSOX1 "RTN","PSORXEDT",101,0) I $L(PSOLIST(PSOX2))+$L(RXN)<220 S:RXN_","'[PSOLIST(PSOX2) PSOLIST(PSOX2)=PSOLIST(PSOX2)_RXN_"," "RTN","PSORXEDT",102,0) E S:RXN_","'[PSOLIST(PSOX2+1) PSOLIST(PSOX2+1)=RXN_"," "RTN","PSORXEDT",103,0) LISTX K PSOX1,PSOX2,RXN,PSVD "RTN","PSORXEDT",104,0) Q "RTN","PSORXI") 0^34^B15382592^B15276698 "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,390**;DEC 1997;Build 86 "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 S:$G(PSODAL) PSODAL("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","PSOUTL") 0^18^B125518087^B96529999 "RTN","PSOUTL",1,0) PSOUTL ;BHAM ISC/SAB - pso utility routine ;4/28/09 4:14pm "RTN","PSOUTL",2,0) ;;7.0;OUTPATIENT PHARMACY;**1,21,126,174,218,259,324,390**;DEC 1997;Build 86 "RTN","PSOUTL",3,0) ;External reference SERV^IBARX1 supported by DBIA 2245 "RTN","PSOUTL",4,0) ;External reference ^PS(55, supported by DBIA 2228 "RTN","PSOUTL",5,0) ;External reference ^PSSDIUTL is supported by DBIA# 5737. "RTN","PSOUTL",6,0) ; "RTN","PSOUTL",7,0) ;*218 prevent refill from being deleted if pending processing via "RTN","PSOUTL",8,0) ; external dispense machines "RTN","PSOUTL",9,0) ;*259 reverse *218 restrictions & Add del only last refill logic. "RTN","PSOUTL",10,0) ; "RTN","PSOUTL",11,0) SUSPCAN ;dcl rx from suspense used in new, renew AND verification of Rxs "RTN","PSOUTL",12,0) S PSLAST=0 F PSI=0:0 S PSI=$O(^PSRX(PSRX,1,PSI)) Q:'PSI S PSLAST=PSI "RTN","PSOUTL",13,0) I PSLAST S PSI=^PSRX(PSRX,1,PSLAST,0) K ^PSRX(PSRX,1,PSLAST),^PSRX(PSRX,1,"B",+PSI,PSLAST) S ^(0)=$P(^PSRX(PSRX,1,0),"^",1,3)_"^"_($P(^(0),"^",4)-1) K PSLAST,PSI,SUSX,SUS1,SUS2 Q "RTN","PSOUTL",14,0) S $P(^PSRX(PSRX,3),"^",7)="DISCONTINUED FROM SUSPENSE BEFORE FILLING" K PSI,SUSX,SUS1,SUS2 Q "RTN","PSOUTL",15,0) ; "RTN","PSOUTL",16,0) ACTLOG ; "RTN","PSOUTL",17,0) F PSI=0:0 S PSI=$O(^PSRX(PSRX,"A",PSI)) I 'PSI!'$O(^(PSI)) S ^PSRX(PSRX,"A",+PSI+1,0)=DT_"^"_PSREA_"^"_PSOCLC_"^"_PSRXREF_"^"_PSMSG,^PSRX(PSRX,"A",0)="^52.3DA^"_(+PSI+1)_"^"_(+PSI+1) Q "RTN","PSOUTL",18,0) ACTOUT I PSREA="C" S PSI=$S($D(^PSRX(PSRX,2)):+$P(^(2),"^",6),1:0) K:$D(^PS(55,PSDFN,"P","A",PSI,PSRX)) ^(PSRX) S ^PS(55,PSDFN,"P","A",DT,PSRX)="" Q "RTN","PSOUTL",19,0) I PSREA="R" F PSI=0:0 S PSI=$O(^PSRX(PSRX,"A",PSI)) Q:'PSI I $D(^(PSI,0)),$P(^(0),"^",2)="C" S PSS=+^(0) "RTN","PSOUTL",20,0) I $D(PSS),PSS K:$D(^PS(55,PSDFN,"P","A",PSS,PSRX)) ^(PSRX) "RTN","PSOUTL",21,0) I PSREA="R",$D(^PSRX(PSRX,2))#2 S ^PS(55,PSDFN,"P","A",+$P(^PSRX(PSRX,2),"^",6),PSRX)="" "RTN","PSOUTL",22,0) Q "RTN","PSOUTL",23,0) ; "RTN","PSOUTL",24,0) QUES ;INSTRUCTIONS FOR RENEW AND REFILL "RTN","PSOUTL",25,0) W !?5,"Enter the item #(s) or RX #(s) you wish to ",$S(PSFROM="N":"renew ",PSFROM="R":"REFILL "),"separated by commas." "RTN","PSOUTL",26,0) W !?5,"For example: 1,2,5 or 123456,33254A,232323B." "RTN","PSOUTL",27,0) W !?5,"Do not enter the same number twice, duplicates are not allowed." "RTN","PSOUTL",28,0) Q "RTN","PSOUTL",29,0) ENDVCHK S PSOPOP=0 Q:'PSODIV Q:'$P(^PSRX(PSRX,2),"^",9)!($P(^(2),"^",9)=PSOSITE) "RTN","PSOUTL",30,0) CHK1 I '$P(PSOSYS,"^",2) W !?10,$C(7),"RX# ",$P(^PSRX(PSRX,0),"^")," is not a valid choice. (Different Division)" S PSPOP=1 Q "RTN","PSOUTL",31,0) I $P(PSOSYS,"^",3) W !?10,$C(7),"RX# ",$P(^PSRX(PSRX,0),"^")," is from another division. Continue? (Y/N) " R ANS:DTIME I ANS="^"!(ANS="") S PSPOP=1 Q "RTN","PSOUTL",32,0) I (ANS']"")!("YNyn"'[$E(ANS)) W !?10,$C(7),"Answer 'YES' or 'NO'." G CHK1 "RTN","PSOUTL",33,0) S:$E(ANS)["Nn" PSPOP=1 Q "RTN","PSOUTL",34,0) ;PSO*7*259; SET VAR PSOSFN TO CHECK FOR SUSPENDED REFILL "RTN","PSOUTL",35,0) K52 K PSOSFN S SFN=+$O(^PS(52.5,"B",DA(1),0)),PSOSFN=SFN Q:SFN=0 "RTN","PSOUTL",36,0) I $P($G(^PS(52.5,SFN,0)),"^",5)=$P($G(^PSRX(+^PS(52.5,SFN,0),"P",0)),"^",3),$P($G(^PSRX($P(^PS(52.5,SFN,0),"^"),"P",0)),"^",4)=0 N PSOXX S PSOXX=1 G KILL "RTN","PSOUTL",37,0) G:X'=""&($G(Y)=1) KILL I $G(Y)'=1,SFN I $D(^PS(52.5,SFN,0)),'$P(^(0),"^",5),'$P($G(^("P")),"^") D "RTN","PSOUTL",38,0) .S SDT=+$P(^PS(52.5,SFN,0),"^",2) K ^PS(52.5,"C",SDT,SFN) "RTN","PSOUTL",39,0) .I $P($G(^PS(52.5,SFN,0)),"^",7)="Q" K ^PS(52.5,"AQ",SDT,+$P(^PS(52.5,SFN,0),"^",3),SFN) D KCMPX^PSOCMOP(SFN,"Q") "RTN","PSOUTL",40,0) .I $P($G(^PS(52.5,SFN,0)),"^",7)="" K ^PS(52.5,"AC",+$P(^PS(52.5,SFN,0),"^",3),SDT,SFN) "RTN","PSOUTL",41,0) .K SFN,SDT "RTN","PSOUTL",42,0) Q "RTN","PSOUTL",43,0) S52 S (RIFN,PSOSX)=0 F S RIFN=$O(^PSRX(DA(1),1,RIFN)) Q:'RIFN S RFID=$P(^PSRX(DA(1),1,RIFN,0),"^"),PSOSX=PSOSX+1 "RTN","PSOUTL",44,0) S SFN=+$O(^PS(52.5,"B",DA(1),0)) I SFN,'$G(^PS(52.5,SFN,"P")),$P($G(^PSRX($P($G(^PS(52.5,SFN,0)),"^"),"STA")),"^")=5 D "RTN","PSOUTL",45,0) .I '$D(^PS(52.5,SFN,0))!($P($G(^(0)),"^",5)) Q "RTN","PSOUTL",46,0) .S $P(^PS(52.5,SFN,0),"^",2)=RFID,^PS(52.5,"C",RFID,SFN)="" "RTN","PSOUTL",47,0) .I $P($G(^PS(52.5,SFN,0)),"^",7)="Q" S ^PS(52.5,"AQ",RFID,+$P(^PS(52.5,SFN,0),"^",3),SFN)="" D SCMPX^PSOCMOP(SFN,"Q") "RTN","PSOUTL",48,0) .I $P($G(^PS(52.5,SFN,0)),"^",7)="" S ^PS(52.5,"AC",+$P(^PS(52.5,SFN,0),"^",3),RFID,SFN)="" "RTN","PSOUTL",49,0) K SFN,RFIN,RFID,PSOSX,PSOSXDT Q "RTN","PSOUTL",50,0) KILL N DFN "RTN","PSOUTL",51,0) I SFN D "RTN","PSOUTL",52,0) .S $P(^PSRX(DA(1),"STA"),"^")=0 Q:'$D(^PS(52.5,SFN,0)) S DFN=+$P(^PS(52.5,SFN,0),"^",3),PAT=$P(^DPT(DFN,0),"^") "RTN","PSOUTL",53,0) .;I $P(^PS(52.5,SFN,0),"^",5) Q "RTN","PSOUTL",54,0) .K ^PS(52.5,"B",+$P(^PS(52.5,SFN,0),"^"),SFN),^PS(52.5,"C",+$P(^PS(52.5,SFN,0),"^",2),SFN),^PS(52.5,"D",PAT,SFN),^PS(52.5,"AF",DFN,SFN) "RTN","PSOUTL",55,0) .I $P($G(^PS(52.5,SFN,0)),"^",7)="" D "RTN","PSOUTL",56,0) ..I $G(^PS(52.5,SFN,"P")) K ^PS(52.5,"AS",+$P(^(0),"^",8),+$P(^(0),"^",9),+$P(^(0),"^",6),+$P(^(0),"^",11),SFN),^PS(52.5,"ADL",$E(+$P(^PS(52.5,SFN,0),"^",8),1,7),SFN) Q "RTN","PSOUTL",57,0) ..K ^PS(52.5,"AC",DFN,+$P(^PS(52.5,SFN,0),"^",2),SFN) "RTN","PSOUTL",58,0) .I $P($G(^PS(52.5,SFN,0)),"^",7)'="" D "RTN","PSOUTL",59,0) ..;Kill CMOP xrefs "RTN","PSOUTL",60,0) ..N PSOC7 S PSOC7=$P($G(^PS(52.5,SFN,0)),"^",7) "RTN","PSOUTL",61,0) ..I PSOC7="Q"!(PSOC7="P") K ^PS(52.5,"AG",+$P(^PS(52.5,SFN,0),"^",3),SFN) D KCMPX^PSOCMOP(SFN,PSOC7) "RTN","PSOUTL",62,0) ..I PSOC7="X"!(PSOC7="P")!(PSOC7="L") K ^PS(52.5,$S(PSOC7="X":"AX",PSOC7="P":"AP",1:"AL"),$P(^PS(52.5,SFN,0),"^",2),$P(^(0),"^",3),SFN) D KCMPX^PSOCMOP(SFN,PSOC7) "RTN","PSOUTL",63,0) ..K ^PS(52.5,"APR",+$P(^PS(52.5,SFN,0),"^",8),+$P(^(0),"^",9),+$P(^(0),"^",6),+$P(^(0),"^",11),SFN),^PS(52.5,"ADL",$E(+$P(^PS(52.5,SFN,0),"^",8),1,7),SFN) "RTN","PSOUTL",64,0) .K ^PS(52.5,SFN,0),^PS(52.5,SFN,"P"),DFN,SFN,PAT "RTN","PSOUTL",65,0) S CNT=0 F SUB=0:0 S SUB=$O(^PSRX(DA(1),"A",SUB)) Q:'SUB S CNT=SUB "RTN","PSOUTL",66,0) S:DA>5 DA=DA+1 D NOW^%DTC S CNT=CNT+1 "RTN","PSOUTL",67,0) S ^PSRX(DA(1),"A",0)="^52.3DA^"_CNT_"^"_CNT,^PSRX(DA(1),"A",CNT,0)=%_"^D^"_DUZ_"^"_DA_"^" "RTN","PSOUTL",68,0) I '$D(PSOXX) S ^PSRX(DA(1),"A",CNT,0)=^PSRX(DA(1),"A",CNT,0)_"Refill " "RTN","PSOUTL",69,0) ;if PSOXX not exist, = refill. otherwise, it is a partial. "RTN","PSOUTL",70,0) S ^PSRX(DA(1),"A",CNT,0)=^PSRX(DA(1),"A",CNT,0)_$S($G(RESK):"returned to stock.",$G(PSOPSDAL):"deleted during Controlled Subs release.",$G(PSOXX)=1:"Partial deleted from suspense file.",1:"deleted during Rx edit.") K CNT,SUB "RTN","PSOUTL",71,0) Q "RTN","PSOUTL",72,0) CID ;calculates six months limit on issue dates "RTN","PSOUTL",73,0) S PSID=X,X="T-6M",%DT="X" D ^%DT S %DT(0)=Y,X=PSID,%DT="EX" D ^%DT K PSID "RTN","PSOUTL",74,0) Q "RTN","PSOUTL",75,0) CIDH S X="T-6M",%DT="X" D ^%DT X ^DD("DD") D EN^DDIOL("Issue Date must be greater or equal to "_Y,"","!") "RTN","PSOUTL",76,0) Q "RTN","PSOUTL",77,0) SPR F RF=0:0 S RF=$O(^PSRX(DA(1),1,RF)) Q:'RF S NODE=RF "RTN","PSOUTL",78,0) I NODE=1 S $P(^PSRX(DA(1),3),"^",4)=$P(^PSRX(DA(1),2),"^",2) Q "RTN","PSOUTL",79,0) SREF I $G(NODE) S NODE=NODE-1 G:'$D(^PSRX(DA(1),1,NODE,0)) SREF "RTN","PSOUTL",80,0) I NODE=0 S $P(^PSRX(DA(1),3),"^",4)=$P(^PSRX(DA(1),2),"^",2) Q "RTN","PSOUTL",81,0) S $P(^PSRX(DA(1),3),"^",4)=$P(^PSRX(DA(1),1,NODE,0),"^",1) Q "RTN","PSOUTL",82,0) K NODE,RF "RTN","PSOUTL",83,0) Q "RTN","PSOUTL",84,0) KPR F RF=0:0 S RF=$O(^PSRX(DA(1),1,RF)) Q:'RF S NODE=RF "RTN","PSOUTL",85,0) I NODE=DA&(X'="") S NODE=NODE-1 S:NODE=1 NODE=0 G:'NODE ORIG G:NODE>1 KREF "RTN","PSOUTL",86,0) I NODE=1 S $P(^PSRX(DA(1),3),"^",4)=$P(^PSRX(DA(1),2),"^",2) G EX "RTN","PSOUTL",87,0) KREF S NODE=NODE-1 G:'NODE EX "RTN","PSOUTL",88,0) I NODE=1 S $P(^PSRX(DA(1),3),"^",4)=$P(^PSRX(DA(1),2),"^",2) G EX "RTN","PSOUTL",89,0) G:NODE=DA&(X'="") KREF G:'$D(^PSRX(DA(1),1,NODE,0)) KREF "RTN","PSOUTL",90,0) ORIG I 'NODE S $P(^PSRX(DA(1),3),"^",4)=$P(^PSRX(DA(1),2),"^",2) G EX "RTN","PSOUTL",91,0) S $P(^PSRX(DA(1),3),"^",4)=$P(^PSRX(DA(1),1,NODE,0),"^",1) G EX "RTN","PSOUTL",92,0) EX K NODE,RF "RTN","PSOUTL",93,0) Q "RTN","PSOUTL",94,0) IBSS N PSOHLP S PSOHLP(1,"F")="!!" "RTN","PSOUTL",95,0) S PSOHLP(1)="Entry in this field must match the SERVICE field for pharmacy action" "RTN","PSOUTL",96,0) S PSOHLP(2,"F")="!" "RTN","PSOUTL",97,0) S PSOHLP(2)="types in the IB ACTION TYPE file AND be a valid entry in your" "RTN","PSOUTL",98,0) S PSOHLP(3,"F")="!" "RTN","PSOUTL",99,0) S PSOHLP(3)="SERVICE/SECTION file to generate copay charges!" "RTN","PSOUTL",100,0) S PSOHLP(4,"F")="!!" "RTN","PSOUTL",101,0) D EN^DDIOL(.PSOHLP) K PSOHLP "RTN","PSOUTL",102,0) Q "RTN","PSOUTL",103,0) IBSSR S PSOIBFL=0 F PSOIBLP=0:0 S PSOIBLP=$O(^DIC(49,PSOIBLP)) Q:'PSOIBLP!(PSOIBFL) S Y=PSOIBLP,PSOIBST=$$SERV^IBARX1(+Y) I $G(PSOIBST) S DIE="^PS(59,",DA=PSOSITE,DR="1003////"_PSOIBLP D ^DIE K DIE D S PSOIBFL=1 "RTN","PSOUTL",104,0) .W $C(7),!!,"There was an invalid entry in your IB SERVICE/SECTION field in your Outpatient",!,"Site Parameter file, but we have fixed the problem for you, and you",!,"may continue!" Q "RTN","PSOUTL",105,0) Q "RTN","PSOUTL",106,0) WARN ; "RTN","PSOUTL",107,0) I $G(PSOUNHLD) D Q "RTN","PSOUTL",108,0) .D EN^DDIOL("You cannot delete a refill while removing from Hold! Use the Edit Action.","","$C(7),!!"),EN^DDIOL(" ","","!!") "RTN","PSOUTL",109,0) I $G(CMOP(DA))]""&(+$G(CMOP(DA))<3) D K CMOP Q "RTN","PSOUTL",110,0) .D EN^DDIOL("You cannot delete a refill that"_$S(+$G(CMOP(DA))=1:" has been released by",1:" is being transmitted to")_" the CMOP","","!!") "RTN","PSOUTL",111,0) .D EN^DDIOL(" ","","!!") "RTN","PSOUTL",112,0) K CMOP "RTN","PSOUTL",113,0) ; "RTN","PSOUTL",114,0) N PSOL,PSR "RTN","PSOUTL",115,0) S PSR=0 F S PSR=$O(^PSRX(DA(1),1,PSR)) Q:'PSR S PSOL=PSR "RTN","PSOUTL",116,0) I DA=PSOL,$P(^PSRX(DA(1),1,DA,0),"^",18) D Q "RTN","PSOUTL",117,0) .D EN^DDIOL("Refill Released! Use the 'Return to Stock' option!","","$C(7),!!"),EN^DDIOL(" ","","!") "RTN","PSOUTL",118,0) ; "RTN","PSOUTL",119,0) ;Only allow deletion if last refill *259 "RTN","PSOUTL",120,0) I $O(^PSRX(DA(1),1,DA)) D Q "RTN","PSOUTL",121,0) .D EN^DDIOL("Only the last refill can be deleted. Later refills must be deleted first.","","$C(7),!!") "RTN","PSOUTL",122,0) .D EN^DDIOL("","","!!") "RTN","PSOUTL",123,0) ; "RTN","PSOUTL",124,0) ;Warn of In Process, Only delete if answered Yes ;*259 "RTN","PSOUTL",125,0) I $$REFIP^PSOUTLA1(DA(1),DA,"R") D I 'Y Q ;reset $T "RTN","PSOUTL",126,0) . D EN^DDIOL("** Refill has previously been sent to the External Dispense Machine","","!!,?2") "RTN","PSOUTL",127,0) . D EN^DDIOL("** for filling and is still Pending Processing","","$C(7),!,?2") "RTN","PSOUTL",128,0) . D EN^DDIOL("","","!") "RTN","PSOUTL",129,0) . K DIR "RTN","PSOUTL",130,0) . S DIR("A")="Do you want to continue? " "RTN","PSOUTL",131,0) . S DIR("B")="Y" "RTN","PSOUTL",132,0) . S DIR(0)="YA^^" "RTN","PSOUTL",133,0) . S DIR("?")="Enter Y for Yes or N for No." "RTN","PSOUTL",134,0) . D ^DIR "RTN","PSOUTL",135,0) . K DIR "RTN","PSOUTL",136,0) Q "RTN","PSOUTL",137,0) ; "RTN","PSOUTL",138,0) WARN1 ;move to PSOUTLA1 "RTN","PSOUTL",139,0) D WARN1^PSOUTLA1 "RTN","PSOUTL",140,0) Q "RTN","PSOUTL",141,0) ; "RTN","PSOUTL",142,0) CAN(PSOXRX) ;Clean up Rx when discontinued "RTN","PSOUTL",143,0) N SUSD,IFN,RF,NODE,DA "RTN","PSOUTL",144,0) Q:'$D(^PSRX(PSOXRX,0)) "RTN","PSOUTL",145,0) S DA=$O(^PS(52.5,"B",PSOXRX,0)) I DA S DIK="^PS(52.5,",SUSD=$P($G(^PS(52.5,DA,0)),"^",2) D ^DIK K DIK I $O(^PSRX(PSOXRX,1,0)) S DA=PSOXRX D REF^PSOCAN2 "RTN","PSOUTL",146,0) I $D(^PS(52.4,PSOXRX,0)) S DIK="^PS(52.4,",DA=PSOXRX D ^DIK K DIK "RTN","PSOUTL",147,0) I $G(^PSRX(PSOXRX,"H"))]"" K:$P(^PSRX(PSOXRX,"H"),"^") ^PSRX("AH",$P(^PSRX(PSOXRX,"H"),"^"),PSOXRX) S ^PSRX(PSOXRX,"H")="" "RTN","PSOUTL",148,0) I '$P($G(^PSRX(PSOXRX,2)),"^",2) K DIE S DIE="^PSRX(",DA=PSOXRX,DR="22///"_DT D ^DIE "RTN","PSOUTL",149,0) Q "RTN","PSOUTL",150,0) ECAN(PSOXRX) ;Clean up Rx when expired "RTN","PSOUTL",151,0) N DA "RTN","PSOUTL",152,0) Q:'$D(^PSRX(PSOXRX,0)) "RTN","PSOUTL",153,0) S DA=$O(^PS(52.5,"B",PSOXRX,0)) I DA K DIK S DIK="^PS(52.5," D ^DIK K DIK "RTN","PSOUTL",154,0) I $D(^PS(52.4,PSOXRX,0)) K DIK S DIK="^PS(52.4,",DA=PSOXRX D ^DIK K DIK "RTN","PSOUTL",155,0) I $G(^PSRX(PSOXRX,"H"))]"" K:$P(^PSRX(PSOXRX,"H"),"^") ^PSRX("AH",$P(^PSRX(PSOXRX,"H"),"^"),PSOXRX) S ^PSRX(PSOXRX,"H")="" "RTN","PSOUTL",156,0) I '$P($G(^PSRX(PSOXRX,2)),"^",2) K DIE S DIE="^PSRX(",DA=PSOXRX,DR="22///"_DT D ^DIE "RTN","PSOUTL",157,0) Q "RTN","PSOUTL",158,0) CMOP ;CMOP("L")=LAST FILL... if it is orig Rx =0 "RTN","PSOUTL",159,0) ;CMOP(FILL #)=CMOP status from 52[TRAN=0,DISP=1,RETRAN=2,NOT DISP=3 "RTN","PSOUTL",160,0) ;If suspended CMOP("S")=CMOP suspense status Q,L,X,P,R "RTN","PSOUTL",161,0) ;All returned variables can be killed by K CMOP "RTN","PSOUTL",162,0) ; "RTN","PSOUTL",163,0) S CRX=DA "RTN","PSOUTL",164,0) CMOP1 N X "RTN","PSOUTL",165,0) S (CMOP("L"),X)=0 F S X=$O(^PSRX(CRX,1,X)) Q:'X S CMOP("L")=X "RTN","PSOUTL",166,0) I $O(^PSRX(CRX,4,0)) F X=0:0 S X=$O(^PSRX(CRX,4,X)) Q:'X D "RTN","PSOUTL",167,0) .S CMOP($P($G(^PSRX(CRX,4,X,0)),"^",3))=$P($G(^(0)),"^",4) "RTN","PSOUTL",168,0) S X=$O(^PS(52.5,"B",CRX,0)) I X]"" S CMOP("S")=$P($G(^PS(52.5,X,0)),"^",7) "RTN","PSOUTL",169,0) K CRX,X "RTN","PSOUTL",170,0) Q "RTN","PSOUTL",171,0) ; "RTN","PSOUTL",172,0) CHKCMOP(RX,REA) ;Check if an RX is Transmitted/Retransmitted to CMOP and send alert mail "RTN","PSOUTL",173,0) ; "RTN","PSOUTL",174,0) ; Input: RX - ien to file #52 "RTN","PSOUTL",175,0) ; REA - reason DC's "A" = admission, "D" = death "RTN","PSOUTL",176,0) ; Output: none "RTN","PSOUTL",177,0) ; "RTN","PSOUTL",178,0) N CMOP,PSOCMOP "RTN","PSOUTL",179,0) S REA=$G(REA) "RTN","PSOUTL",180,0) I $$TRANCMOP(RX),$G(PSOCMOP)]"" D MAILCMOP(RX,PSOCMOP,REA) "RTN","PSOUTL",181,0) Q "RTN","PSOUTL",182,0) ; "RTN","PSOUTL",183,0) TRANCMOP(RX) ;check if a fill is Transmitted or Retransmitted "RTN","PSOUTL",184,0) ; "RTN","PSOUTL",185,0) ; Input: = RX number "RTN","PSOUTL",186,0) ; Function output:= RX number if CMOP status is Trans or Retrans "RTN","PSOUTL",187,0) ; = 0 if neither "RTN","PSOUTL",188,0) ; Global parm out:= PSOCMOP = string from call to ^PSOCMOPA "RTN","PSOUTL",189,0) ; "RTN","PSOUTL",190,0) N DA,PSOTRANS "RTN","PSOUTL",191,0) S DA=RX D ^PSOCMOPA "RTN","PSOUTL",192,0) S PSOTRANS=$P($G(PSOCMOP),"^") "RTN","PSOUTL",193,0) Q:PSOTRANS=0!(PSOTRANS=2) RX "RTN","PSOUTL",194,0) Q 0 "RTN","PSOUTL",195,0) ; "RTN","PSOUTL",196,0) MAILCMOP(RX,STR,REA) ;Send mail message to mail group PSX EXTERNAL DISPENSE ALERTS "RTN","PSOUTL",197,0) ; "RTN","PSOUTL",198,0) ; Input: RX = ien of PSRX "RTN","PSOUTL",199,0) ; STR = CMOP STATUS # ^ TRANSMIT DATE (FM) ^ LAST FILL # "RTN","PSOUTL",200,0) ; REA = reason DC'd "A" = admission, "D" = death "RTN","PSOUTL",201,0) ; Output: none "RTN","PSOUTL",202,0) ; "RTN","PSOUTL",203,0) N CMDT,CMST,DFN,VADM,PSOTEXT,PSOIEN,PSOKEYN,XMY,XMDUZ,XMSUB,XMTEXT "RTN","PSOUTL",204,0) N DIV,SSN,RXO,FILL,DRUG,DIVN,MAILGRP,NAME,PRV,RXSTS "RTN","PSOUTL",205,0) S RXO=$$GET1^DIQ(52,RX,.01) "RTN","PSOUTL",206,0) S CMDT=$P(STR,U,2) "RTN","PSOUTL",207,0) S CMDT=$E(CMDT,4,5)_"/"_$E(CMDT,6,7)_"/"_$E(CMDT,2,3) "RTN","PSOUTL",208,0) S FILL=$P(STR,U,3) "RTN","PSOUTL",209,0) S CMST=$P(STR,U),CMST=$S(CMST=2:"RETRANSMITTED",1:"TRANSMITTED") "RTN","PSOUTL",210,0) S DIV=$P(^PSRX(RX,2),"^",9),DIVN=$P($G(^PS(59,DIV,0)),"^") "RTN","PSOUTL",211,0) S MAILGRP="PSX EXTERNAL DISPENSE ALERTS" "RTN","PSOUTL",212,0) S XMY("G."_MAILGRP)="" "RTN","PSOUTL",213,0) ;if no members & no member groups & no remote members, then send to "RTN","PSOUTL",214,0) ; the default: PSXCMOPMGR key holders "RTN","PSOUTL",215,0) S PSOIEN=$O(^XMB(3.8,"B",MAILGRP,0)) "RTN","PSOUTL",216,0) I '$O(^XMB(3.8,PSOIEN,1,0))&'$O(^XMB(3.8,PSOIEN,5,0))&'$O(^XMB(3.8,PSOIEN,6,0)) D "RTN","PSOUTL",217,0) . S PSOKEYN=0 "RTN","PSOUTL",218,0) . F S PSOKEYN=$O(^XUSEC("PSXCMOPMGR",PSOKEYN)) Q:'PSOKEYN D "RTN","PSOUTL",219,0) . . S XMY(PSOKEYN)="" "RTN","PSOUTL",220,0) S DFN=$$GET1^DIQ(52,RX,2,"I") D DEM^VADPT "RTN","PSOUTL",221,0) S NAME=VADM(1) "RTN","PSOUTL",222,0) S SSN=$P($P(VADM(2),"^",2),"-",3) "RTN","PSOUTL",223,0) S RXSTS=$$GET1^DIQ(52,RX,100) "RTN","PSOUTL",224,0) S DRUG=$$GET1^DIQ(52,RX,6) "RTN","PSOUTL",225,0) S PRV=$$GET1^DIQ(52,RX,4) "RTN","PSOUTL",226,0) S XMDUZ=.5 "RTN","PSOUTL",227,0) S XMSUB=DIVN_" - DC Alert on CMOP Rx "_RXO_" "_CMST "RTN","PSOUTL",228,0) S PSOTEXT(1)=" Rx #: "_RXO_" Fill: "_FILL "RTN","PSOUTL",229,0) S PSOTEXT(2)=" Patient: "_NAME_" ("_SSN_")" "RTN","PSOUTL",230,0) S PSOTEXT(3)=" Drug: "_DRUG "RTN","PSOUTL",231,0) S PSOTEXT(4)=" Rx Status: "_RXSTS "RTN","PSOUTL",232,0) S:REA="A" PSOTEXT(4)=PSOTEXT(4)_" (due to Admission)" "RTN","PSOUTL",233,0) S:REA="D" PSOTEXT(4)=PSOTEXT(4)_" (due to Date of Death)" "RTN","PSOUTL",234,0) S PSOTEXT(5)="Processing Status: "_CMST_" to CMOP on "_CMDT "RTN","PSOUTL",235,0) S PSOTEXT(6)=" Provider: "_PRV "RTN","PSOUTL",236,0) S PSOTEXT(7)="" "RTN","PSOUTL",237,0) S PSOTEXT(8)="******** Please contact CMOP or take appropriate action ********" "RTN","PSOUTL",238,0) S XMTEXT="PSOTEXT(" D ^XMD "RTN","PSOUTL",239,0) D KVA^VADPT "RTN","PSOUTL",240,0) Q "RTN","PSOUTL",241,0) ; "RTN","PSOUTL",242,0) PSOCK ; "RTN","PSOUTL",243,0) W !!!,"*The following list of order checks is a comprehensive report of all" "RTN","PSOUTL",244,0) W !,"Outpatient, Non-VA, and Clinic medication orders on this patient's profile." "RTN","PSOUTL",245,0) W !,"It may include orders that are local, remote, active, pending, recently" "RTN","PSOUTL",246,0) W !,"discontinued, or expired. Please note that the sort order and format" "RTN","PSOUTL",247,0) W !,"displayed in this report differs from the display of MOCHA 1.0 order" "RTN","PSOUTL",248,0) W !,"checks which occurs during order processing.*",! "RTN","PSOUTL",249,0) Q "RTN","PSOUTL",250,0) ; "RTN","PSOUTL",251,0) PSSDGCK ; "RTN","PSOUTL",252,0) D ^PSSDIUTL "RTN","PSOUTL",253,0) Q "RTN","PSOUTL",254,0) ; "RTN","PSOUTL",255,0) PSOSUPCK(CHK) ; "RTN","PSOUTL",256,0) I '($P($G(^PSDRUG(CHK,0)),"^",3)["S"!($E($P($G(^PSDRUG(CHK,0)),"^",2),1,2)="XA")) K CHK Q 0 "RTN","PSOUTL",257,0) W !!,"You have selected a supply item, please select another drug" "RTN","PSOUTL",258,0) W !,"or leave blank and hit enter for Profile Order Checks." W ! "RTN","PSOUTL",259,0) K CHK "RTN","PSOUTL",260,0) Q 1 "RTN","PSOUTL",261,0) ; "RTN","PSOUTL",262,0) PRFLP ;ZB POST+18^PSODRG THE RUN D LOOP^ZZME3 "RTN","PSOUTL",263,0) N PSODRUG S (DGCKSTA,DGCKDNM)="" S PSODGCKF=1 "RTN","PSOUTL",264,0) I $D(PSOSD) F S DGCKSTA=$O(PSOSD(DGCKSTA)) Q:DGCKSTA="" F S DGCKDNM=$O(PSOSD(DGCKSTA,DGCKDNM)) Q:DGCKDNM="" D "RTN","PSOUTL",265,0) .S DIC=50,DIC(0)="MQZV",X=DGCKDNM D ^DIC K DIC "RTN","PSOUTL",266,0) .S DIC=50,DIC(0)="MQZV",X=+Y D ^DIC K DIC Q:Y=-1 "RTN","PSOUTL",267,0) .S PSODRUG("IEN")=DGCKDNM,PSODRUG("VA CLASS")=$P(Y(0),"^",2),PSODRUG("NAME")=$P(Y(0),"^") "RTN","PSOUTL",268,0) .S:+$G(^PSDRUG(+Y,2)) PSODRUG("OI")=+$G(^(2)),PSODRUG("OIN")=$P(^PS(50.7,+$G(^(2)),0),"^") "RTN","PSOUTL",269,0) .S PSODRUG("NDF")=$S($G(^PSDRUG(DGCKDNM,"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:0) "RTN","PSOUTL",270,0) .S PSODFN=DFN D ^PSODGAL1 "RTN","PSOUTL",271,0) .K X,Y,DTOUT,DUOUT "RTN","PSOUTL",272,0) K DGCKSTA,DGCKDNM,PSODGCKF,X,Y,DTOUT,DUOUT "RTN","PSOUTL",273,0) Q "RTN","PSOVER1") 0^30^B126374469^B118625991 "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,379,390**;DEC 1997;Build 86 "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) ;External reference to ^DPT( supported by DBIA 3097 "RTN","PSOVER1",13,0) ;External reference to ^PS(50.606 supported by DBIA 2174 "RTN","PSOVER1",14,0) ;External reference to ^PS(50.7 supported by DBIA 2223 "RTN","PSOVER1",15,0) ;External reference to ^PS(56 supported by DBIA 2229 "RTN","PSOVER1",16,0) REDO ; "RTN","PSOVER1",17,0) I '$G(PSOCLK) Q:$G(PSVERFLG) "RTN","PSOVER1",18,0) S (DRG,PSODRUG("NAME"))=$P(^PSDRUG(+$P(^PSRX(PSONV,0),"^",6),0),"^"),PSODRUG("VA CLASS")=$P(^(0),"^",2) "RTN","PSOVER1",19,0) S PSOVQUIT=0,PSODRUG("IEN")=$P(^PSRX(PSONV,0),"^",6) "RTN","PSOVER1",20,0) S PSOY(0)=^PSDRUG(PSODRUG("IEN"),0),PSOY=PSODRUG("IEN")_"^"_$P(PSOY(0),"^") "RTN","PSOVER1",21,0) D SET^PSODRG "RTN","PSOVER1",22,0) I '$D(PSODFN) S PSODFN=$P(^PSRX(PSONV,0),"^",2) "RTN","PSOVER1",23,0) ; "RTN","PSOVER1",24,0) EDIT ; "RTN","PSOVER1",25,0) S (PSDNEW,PSDOLD)="",PSDOLD=$P(^PSDRUG($P(^PSRX(PSONV,0),"^",6),0),"^")_"^"_PSONV "RTN","PSOVER1",26,0) S DA=PSONV D ^PSORXPR "RTN","PSOVER1",27,0) I $G(PKI1)=2 D DCV1^PSOPKIV1 G OUT "RTN","PSOVER1",28,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",29,0) D ^DIR K DIR W ! I $G(DIRUT)!($G(DTOUT)) S PSOVBCK=1 G OUT "RTN","PSOVER1",30,0) ;PSOPOCK=1 called from Process Order Check option; PSOCLK=1 means initiated from Rx verify by clerk. "RTN","PSOVER1",31,0) I Y="Y",($G(PSOCLK)!($G(PSOPOCK))) D FULLEDT S VALMBCK="R" G KILL:$$CHECK(PSONV) G EDIT "RTN","PSOVER1",32,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",33,0) I $D(DIRUT),$G(PSOCLK) S PSOCQ=1 G OUT "RTN","PSOVER1",34,0) I $D(DIRUT),$G(PSOACT)]"" S VALMBCK="R" G OUT "RTN","PSOVER1",35,0) G ORDCHK:Y="N",PROF:Y="P",OUT:"YNP"'[$E(Y) "RTN","PSOVER1",36,0) ; "RTN","PSOVER1",37,0) CHANGE ;S DA=PSONV,(PSRX1,PSRX2)=$P(^PSRX(PSONV,0),"^",6) "RTN","PSOVER1",38,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",39,0) ;I PSRX1'=PSRX2,DEA1'=DEA2 S DR="6////"_PSRX1 D ^DIE "RTN","PSOVER1",40,0) ; "RTN","PSOVER1",41,0) D EXPIRE K DIE,DR,DEA1,DEA2,P(5),PSRX1,PSRX2 "RTN","PSOVER1",42,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",43,0) ; "RTN","PSOVER1",44,0) S DA=$S($D(PSORXED("IRXN")):PSORXED("IRXN"),1:PSONV) D ^PSORXPR G OUT:$G(DIRUT) "RTN","PSOVER1",45,0) G OUT:$D(DIRUT)!($D(DTOUT)) "RTN","PSOVER1",46,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",47,0) G EDIT:PSDNEW=PSDOLD,REDO "RTN","PSOVER1",48,0) PROF I '$D(PSOSD) W !,$C(7),"This patient has no other prescriptions on file",!! G EDIT Q "RTN","PSOVER1",49,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",50,0) D HD^PSODDPR2() D ^PSODSPL D SHOW2^PSOVER G EDIT Q "RTN","PSOVER1",51,0) ; "RTN","PSOVER1",52,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",53,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",54,0) ; "RTN","PSOVER1",55,0) ORDCHK ; "RTN","PSOVER1",56,0) S RX0=^PSRX(PSONV,0) "RTN","PSOVER1",57,0) D ORDCK "RTN","PSOVER1",58,0) I $G(PSOQUIT) S:$G(PSOCLK) PSOQUIT=0 S:'$G(PSOCLK) PSORX("DFLG")=1 ;if verify by clerk continue on with the next Rx; if not exit "RTN","PSOVER1",59,0) I $G(PSOVQUIT)!$G(PSORX("DFLG")) G OUT "RTN","PSOVER1",60,0) ;------ "RTN","PSOVER1",61,0) VERIFY ; "RTN","PSOVER1",62,0) D FULL^VALM1 G:'$P(PSOPAR,"^",2) VERY "RTN","PSOVER1",63,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",64,0) . W:$D(PSODRUG("NAME")) !,PSODRUG("NAME"),! "RTN","PSOVER1",65,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",66,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",67,0) D ^DIR K DIR I Y="N"!("Q^"[$E(Y)) S PSOVBCK=1,PSORX("DFLG")=1 G OUT "RTN","PSOVER1",68,0) G DELETE:Y="D" "RTN","PSOVER1",69,0) VERY I $G(PKI1)=1 D REA^PSOPKIV1 G:'$D(PKIR) VERIFY "RTN","PSOVER1",70,0) K ^PSRX(PSONV,"DAI") S $P(^PSRX(PSONV,3),"^",6)="" "RTN","PSOVER1",71,0) K ^PSRX(PSONV,"DRI"),SPFL "RTN","PSOVER1",72,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",73,0) .W !!,"Dosing Instructions Missing. Please add!",! "RTN","PSOVER1",74,0) .I $P($G(^PSRX(PSONV,"SIG")),"^")]"",'$P($G(^("SIG")),"^",2) W "SIG: "_$P(^PSRX(PSONV,"SIG"),"^"),! "RTN","PSOVER1",75,0) .I $P($G(^PSRX(PSONV,"SIG")),"^",2),$O(^PSRX(PSONV,"SIG1",0)) D K I "RTN","PSOVER1",76,0) ..W "SIG: " F I=0:0 S I=$O(^PSRX(PSONV,"SIG1",I)) Q:'I W ^PSRX(PSONV,"SIG1",I,0),! "RTN","PSOVER1",77,0) .S DA=PSONV,PSOVER=1 K DIR,DIRUT,DUOUT,DTOUT "RTN","PSOVER1",78,0) .S PSODRUG("IEN")=$P(^PSRX(DA,0),"^",6),PSODFN=$P(^(0),"^",2),PSORXED("IRXN")=DA,PSODRUG("OI")=$P(^PSRX(DA,"OR1"),"^") "RTN","PSOVER1",79,0) .D DOSE^PSSORPH(.DOSE,PSODRUG("IEN"),"O",PSODFN),^PSOORED3 "RTN","PSOVER1",80,0) .K PSODFN,PSODRUG("IEN"),DOSE,PSOVER "RTN","PSOVER1",81,0) .I '$G(ENT) S DUOUT=1 "RTN","PSOVER1",82,0) .Q:$D(DUOUT)!($D(DTOUT)) "RTN","PSOVER1",83,0) .K DIR,DIRUT,DUOUT,DTOUT S DIE=52,DR=114 D ^DIE K DIE,DR,DTOUT "RTN","PSOVER1",84,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",85,0) .D EN^PSOFSIG(.PSORXED,1),UDSIG^PSOORED3 H 2 "RTN","PSOVER1",86,0) S DA=PSONV,$P(^PSRX(DA,2),"^",10)=DUZ,DRG=$P(^PSDRUG($P(^PSRX(DA,0),"^",6),0),"^") "RTN","PSOVER1",87,0) I $P(^PSRX(DA,2),"^",2)>DT,$P(PSOPAR,"^",6) D G KILL "RTN","PSOVER1",88,0) .S (SPFL1,PSOVER)="",PSORX("FILL DATE")=$P(^(2),"^",2),RXF=0 "RTN","PSOVER1",89,0) .D UPSUS S PSTRIVER=1 D SUS^PSORXL "RTN","PSOVER1",90,0) .K PSORX("FILL DATE"),PSTRIVER "RTN","PSOVER1",91,0) S PSOVER(PSONV)="" S $P(^PSRX(PSONV,"STA"),"^")=0,DRG=$P(^PSDRUG($P(^PSRX(DA,0),"^",6),0),"^") "RTN","PSOVER1",92,0) S $P(PSOSD("NON-VERIFIED",DRG),"^",2)=0,PSOSD("ACTIVE",DRG)=PSOSD("NON-VERIFIED",DRG) "RTN","PSOVER1",93,0) I $G(PKI1)=1,$G(PKIR)]"" D ACT^PSOPKIV1(DA) "RTN","PSOVER1",94,0) K PSOSD("NON-VERIFIED",DRG) D EN^PSOHLSN1(PSONV,"SC","CM","") ;S VALMBCK="" "RTN","PSOVER1",95,0) ;saves drug allergy order chks pso*7*390 "RTN","PSOVER1",96,0) I +$G(^TMP("PSODAOC",$J,1,0)) D "RTN","PSOVER1",97,0) .I $G(PSORX("DFLG")) K ^TMP("PSODAOC",$J) Q "RTN","PSOVER1",98,0) .N RXN,PSODAOC S RXN=PSONV,PSODAOC="Rx Backdoor VERIFIED NEW Order Acceptance_OP" "RTN","PSOVER1",99,0) .D DAOC^PSONEW "RTN","PSOVER1",100,0) .K ^TMP("PSODAOC",$J),RET "RTN","PSOVER1",101,0) ; "RTN","PSOVER1",102,0) ; - Calling ECME for claims generation and transmission / REJECT handling "RTN","PSOVER1",103,0) N ACTION "RTN","PSOVER1",104,0) I $$SUBMIT^PSOBPSUT(PSONV) D I ACTION="Q"!(ACTION="^") Q "RTN","PSOVER1",105,0) . S ACTION="" D ECMESND^PSOBPSU1(PSONV,,,$S($O(^PSRX(PSONV,1,0)):"RF",1:"OF")) "RTN","PSOVER1",106,0) . ; Quit if there is an unresolved Tricare non-billable reject code, PSO*7*358 "RTN","PSOVER1",107,0) . I $$PSOET^PSOREJP3(PSONV) S ACTION="Q" Q "RTN","PSOVER1",108,0) . I $$FIND^PSOREJUT(PSONV) D "RTN","PSOVER1",109,0) . . S ACTION=$$HDLG^PSOREJU1(PSONV,0,"79,88","OF","IOQ","Q") "RTN","PSOVER1",110,0) ; "RTN","PSOVER1",111,0) KILL S DA=PSONV,DIK="^PS(52.4," D ^DIK K DA,DIK D DCORD^PSONEW2 "RTN","PSOVER1",112,0) OUT ; "RTN","PSOVER1",113,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",114,0) I $G(PSOCLK) S PSORX("DFLG")=0 K UPFLAGX D CLEAN Q "RTN","PSOVER1",115,0) DELETE K UPFLAGX D DELETE^PSOVER2 G:$G(UPFLAGX) OUT K PSOSD("NON-VERIFIED",$G(DRG)) Q "RTN","PSOVER1",116,0) QUIT S PSOQUIT="" D CLEAN Q "RTN","PSOVER1",117,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",118,0) Q "RTN","PSOVER1",119,0) CLEAN ;cleans up tmp("psorxdc") global "RTN","PSOVER1",120,0) I $G(PSODOSEX) K PSODOSEX Q "RTN","PSOVER1",121,0) N PSOWRITE "RTN","PSOVER1",122,0) I $O(^TMP("PSORXDC",$J,0)) F RORD=0:0 S RORD=$O(^TMP("PSORXDC",$J,RORD)) Q:'RORD D "RTN","PSOVER1",123,0) .D PSOUL^PSSLOCK(RORD_$S($P(^TMP("PSORXDC",$J,RORD,0),"^")="P":"S",1:"")) "RTN","PSOVER1",124,0) .I $P(^TMP("PSORXDC",$J,RORD,0),"^")="P" D Q "RTN","PSOVER1",125,0) ..S PSOR=^PS(52.41,RORD,0) "RTN","PSOVER1",126,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",127,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",128,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",129,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",130,0) K ^TMP("PSORXDC",$J),RORD,PRNXZ,ORNZZ,PSOR "RTN","PSOVER1",131,0) Q "RTN","PSOVER1",132,0) KV1 ; "RTN","PSOVER1",133,0) K PSOANSQD,DRET,LST,PSOQUIT,PSODRUG,PSONEW,SIG,PSODIR,PHI,PRC,ORCHK,ORDRG,PSOSIGFL,PSORX("ISSUE DATE"),PSORX("FILL DATE"),CLOZPAT "RTN","PSOVER1",134,0) KV K DIR,DIRUT,DTOUT,DUOUT "RTN","PSOVER1",135,0) Q "RTN","PSOVER1",136,0) NVA ; "RTN","PSOVER1",137,0) I $P(PSOSD(STA,DNM),"^",11) D NVA^PSODRDU1 Q "RTN","PSOVER1",138,0) N PSOOI,CLASS,FLG,X,Y,RXREC,IFN "RTN","PSOVER1",139,0) S (Y,FLG)="" "RTN","PSOVER1",140,0) S RXREC=$P(PSOSD(STA,DNM),"^",10),PSOOI=+$G(^PS(55,DFN,"NVA",RXREC,0)),IFN=RXREC N DNM "RTN","PSOVER1",141,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",142,0) Q "RTN","PSOVER1",143,0) REMOTE ; "RTN","PSOVER1",144,0) K ^TMP($J,"DD"),^TMP($J,"DC"),^TMP($J,"DI"),^TMP($J,"DI"_PSODFN) D "RTN","PSOVER1",145,0) .I $T(HAVEHDR^ORRDI1)']"" Q "RTN","PSOVER1",146,0) .I '$$HAVEHDR^ORRDI1 Q "RTN","PSOVER1",147,0) .D HD^PSODDPR2():(($Y+5)'>IOSL) "RTN","PSOVER1",148,0) .I $D(^XTMP("ORRDI","OUTAGE INFO","DOWN")) D Q "RTN","PSOVER1",149,0) ..I $T(REMOTE^PSORX1)]"" Q "RTN","PSOVER1",150,0) ..W !!,"Remote data not available - Only local order checks processed.",! D HD^PSODDPR2():(($Y+5)>IOSL) "RTN","PSOVER1",151,0) .W !!,"Now doing remote order checks. Please wait..." "RTN","PSOVER1",152,0) .D REMOTE^PSOORRDI(PSODFN,+$P($G(^PSRX(PSONV,0)),"^",6)) "RTN","PSOVER1",153,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",154,0) .I $D(^TMP($J,"DD")) D DUP^PSOORRD2 "RTN","PSOVER1",155,0) .I $D(^TMP($J,"DC")) D CLS^PSOORRD2 "RTN","PSOVER1",156,0) .I $D(^TMP($J,"DI"_PSODFN)) K ^TMP($J,"DI") M ^TMP($J,"DI")=^TMP($J,"DI"_PSODFN) D DRGINT^PSOORRD2 "RTN","PSOVER1",157,0) K ^TMP($J,"DD"),^TMP($J,"DC"),^TMP($J,"DI"),^TMP($J,"DI"_PSODFN) "RTN","PSOVER1",158,0) Q "RTN","PSOVER1",159,0) NOALRGY ; "RTN","PSOVER1",160,0) N PSODFN,PSODRUG "RTN","PSOVER1",161,0) S PSODFN=$P(^PSRX(PSONV,0),"^",2),PSODRUG("IEN")=$P(^PSRX(PSONV,0),"^",6) "RTN","PSOVER1",162,0) D NOALRGY^PSODRG "RTN","PSOVER1",163,0) Q "RTN","PSOVER1",164,0) ; "RTN","PSOVER1",165,0) ORDCK ; "RTN","PSOVER1",166,0) N ORN,ORNZZ,PSOLST,Y,PSOODFN S ORN=PSONV,PSOLST(PSONV)=PSONV_"^"_PSONV,PSOVORD=1 "RTN","PSOVER1",167,0) N DRG,ON,CT,DRGI,PDRG,SEV,STX,INT,CLI,PSONULN,PSONULN1,LST,LSI,DGI,SER,SERS,DUPT,SV "RTN","PSOVER1",168,0) S ORNZZ=ORN,PRNXZ(ORN)=PSOLST(ORN),PSORENW("OIRXN")=PSONV,PSOODFN=DFN "RTN","PSOVER1",169,0) I '$D(PSODFN) S PSODFN=$P(^PSRX(PSONV,0),"^",2) "RTN","PSOVER1",170,0) D SHOW^PSOVER D HD^PSODDPR2():(($Y+5)>IOSL) "RTN","PSOVER1",171,0) S (PSODRUG("IEN"),PSDRUG("IEN"))=$P(^PSRX(PSONV,0),"^",6) "RTN","PSOVER1",172,0) N PSOVINF S PSOVINF=^PSDRUG(PSDRUG("IEN"),0),PSODRUG("VA CLASS")=$P(^(0),"^",2) "RTN","PSOVER1",173,0) S PSODRUG("VA CLASS")=$P(PSOVINF,"^",2),(DRG,PSODRUG("NAME"))=$P(^PSDRUG(PSDRUG("IEN"),0),"^") "RTN","PSOVER1",174,0) S PSODRUG("NDF")=$S($G(^PSDRUG(PSDRUG("IEN"),"ND"))]"":+^("ND")_"A"_$P(^("ND"),"^",3),1:0) "RTN","PSOVER1",175,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",176,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",177,0) S PSODRUG("DAW")=+$$GET1^DIQ(50,PSONV,81) "RTN","PSOVER1",178,0) K PSOVINF "RTN","PSOVER1",179,0) D POST^PSODRG S DFN=PSODFN "RTN","PSOVER1",180,0) I $$GET1^DIQ(52,PSONV,100,"I")=13 S PSORX("DFLG")=1 Q "RTN","PSOVER1",181,0) I $G(PSVERFLG),$G(PSOCLK) S PSVERFLG=0 "RTN","PSOVER1",182,0) I $G(PSOCLK),$G(PSORX("DFLG")) S PSOVQUIT=1 K PSORX("DFLG"),DIRUT,DTOUT Q "RTN","PSOVER1",183,0) Q:PSORX("DFLG") "RTN","PSOVER1",184,0) D:$$DS^PSSDSAPI&('$G(PSORX("DFLG"))) DOSCK^PSODOSUT("V") "RTN","PSOVER1",185,0) I $$GET1^DIQ(52,PSONV,100,"I")=13 S PSORX("DFLG")=1 Q "RTN","PSOVER1",186,0) I $G(PSOCLK),$G(PSORX("DFLG")) S PSOVQUIT=1 K PSORX("DFLG"),DIRUT,DTOUT Q "RTN","PSOVER1",187,0) Q:PSORX("DFLG")!($G(PSOQUIT)) "RTN","PSOVER1",188,0) S PSOLST(ORNZZ)=PRNXZ(ORNZZ),ORN=ORNZZ K PSORENW("OIRXN") "RTN","PSOVER1",189,0) Q "RTN","PSOVER1",190,0) ; "RTN","PSOVER1",191,0) FULLEDT ; "RTN","PSOVER1",192,0) D FULL^VALM1 "RTN","PSOVER1",193,0) N RX,FILL,OPSOLST,OPSLST,OLDDA,PSODRUG,REJ "RTN","PSOVER1",194,0) S (RX,PSORXED("IRXN"))=PSONV "RTN","PSOVER1",195,0) M OPSOLST=PSOLST,OPSLST=PSLST,ODA=DA "RTN","PSOVER1",196,0) N PSOSITE,ORN,PSOPAR,PSOLIST,PSOSD ;,PSD,PSDNEW,PSDOLD,DA,PSOSD,RX0,X1,X2,PSOQUIT "RTN","PSOVER1",197,0) S PSOSITE=$$RXSITE^PSOBPSUT(RX,""),ORN=RX "RTN","PSOVER1",198,0) S PSOPAR=$G(^PS(59,PSOSITE,1)),PSOLIST(1)=ORN_"," "RTN","PSOVER1",199,0) D EPH^PSORXEDT "RTN","PSOVER1",200,0) M PSOLST=OPSOLST,PSLST=OPSLST S VALMBCK="R" S:$D(OLDDA) DA=OLDDA "RTN","PSOVER1",201,0) Q "RTN","PSOVER1",202,0) ; "RTN","PSOVER1",203,0) DRIDOSE(DA,RX0) ;where DA is RXIEN and RX0 is zero node of file 52 for the RXIEN "RTN","PSOVER1",204,0) N T,RXN,RXX,SCRIPT,SEV,X,SER,PSOSERV,PSOSCPT,PSODOSF,RX "RTN","PSOVER1",205,0) S RX=RX0 "RTN","PSOVER1",206,0) S RXN=$P(RX0,"^") "RTN","PSOVER1",207,0) I $D(^PS(52.4,RX,0))!($D(^PSRX(RX,"DRI"))) D "RTN","PSOVER1",208,0) . Q:'$P($G(^PS(52.4,RX,0)),"^",8)&('$D(^PSRX(RX,"DRI"))) "RTN","PSOVER1",209,0) .W !!,"*** During order, there were DRUG-DRUG INTERACTION for the following RX(s):" "RTN","PSOVER1",210,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",211,0) . S SER=$P(^PS(56,SEV(X),0),"^",4) S:$G(SER)=1 PSOSERV=1 "RTN","PSOVER1",212,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",213,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",214,0) .S SER=$P(^PS(56,SEV(X),0),"^",4) "RTN","PSOVER1",215,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",216,0) S SCRIPT="" F S SCRIPT=$O(PSOSCPT(SCRIPT)) Q:SCRIPT="" W !,PSOSCPT(SCRIPT) "RTN","PSOVER1",217,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",218,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",219,0) W ! "RTN","PSOVER1",220,0) Q "RTN","PSOVER1",221,0) CHECK(PSONV) ; "RTN","PSOVER1",222,0) N PSOSTAT S PSOSTAT=$$GET1^DIQ(52,PSONV,100,"I") "RTN","PSOVER1",223,0) I ",11,12,13,14,15,"[(","_PSOSTAT_",") Q 1 "RTN","PSOVER1",224,0) Q 0 "VER") 8.0^22.0 "BLD",8511,6) ^345 **END** **END**