Released RMPR*3*173 SEQ #153 Extracted from mail message **KIDS**:RMPR*3.0*173^ **INSTALL NAME** RMPR*3.0*173 "BLD",8677,0) RMPR*3.0*173^PROSTHETICS^0^3140623^y "BLD",8677,1,0) ^^3^3^3140122^^ "BLD",8677,1,1,0) 1. Users are able to edit Inactive HCPCS items in Prosthetics. "BLD",8677,1,2,0) "BLD",8677,1,3,0) 2. Purge process created for Prosthetics file #664 [PROSTHETICS 1358] "BLD",8677,4,0) ^9.64PA^^0 "BLD",8677,6.3) 29 "BLD",8677,"ABPKG") n "BLD",8677,"KRN",0) ^9.67PA^779.2^20 "BLD",8677,"KRN",.4,0) .4 "BLD",8677,"KRN",.401,0) .401 "BLD",8677,"KRN",.402,0) .402 "BLD",8677,"KRN",.403,0) .403 "BLD",8677,"KRN",.5,0) .5 "BLD",8677,"KRN",.84,0) .84 "BLD",8677,"KRN",3.6,0) 3.6 "BLD",8677,"KRN",3.8,0) 3.8 "BLD",8677,"KRN",9.2,0) 9.2 "BLD",8677,"KRN",9.8,0) 9.8 "BLD",8677,"KRN",9.8,"NM",0) ^9.68A^2^2 "BLD",8677,"KRN",9.8,"NM",1,0) RMPRCDP^^0^B34194835 "BLD",8677,"KRN",9.8,"NM",2,0) RMPRPIY7^^0^B59398060 "BLD",8677,"KRN",9.8,"NM","B","RMPRCDP",1) "BLD",8677,"KRN",9.8,"NM","B","RMPRPIY7",2) "BLD",8677,"KRN",19,0) 19 "BLD",8677,"KRN",19,"NM",0) ^9.68A^3^2 "BLD",8677,"KRN",19,"NM",2,0) RMPR PURGE MENU^^3 "BLD",8677,"KRN",19,"NM",3,0) RMPR PURGE AGED^^0^ "BLD",8677,"KRN",19,"NM","B","RMPR PURGE AGED",3) "BLD",8677,"KRN",19,"NM","B","RMPR PURGE MENU",2) "BLD",8677,"KRN",19.1,0) 19.1 "BLD",8677,"KRN",19.1,"NM",0) ^9.68A^^ "BLD",8677,"KRN",101,0) 101 "BLD",8677,"KRN",101,"NM",0) ^9.68A^^ "BLD",8677,"KRN",409.61,0) 409.61 "BLD",8677,"KRN",409.61,"NM",0) ^9.68A^^ "BLD",8677,"KRN",771,0) 771 "BLD",8677,"KRN",771,"NM",0) ^9.68A^^ "BLD",8677,"KRN",779.2,0) 779.2 "BLD",8677,"KRN",779.2,"NM",0) ^9.68A^^ "BLD",8677,"KRN",870,0) 870 "BLD",8677,"KRN",870,"NM",0) ^9.68A^^ "BLD",8677,"KRN",8989.51,0) 8989.51 "BLD",8677,"KRN",8989.51,"NM",0) ^9.68A^^ "BLD",8677,"KRN",8989.52,0) 8989.52 "BLD",8677,"KRN",8994,0) 8994 "BLD",8677,"KRN","B",.4,.4) "BLD",8677,"KRN","B",.401,.401) "BLD",8677,"KRN","B",.402,.402) "BLD",8677,"KRN","B",.403,.403) "BLD",8677,"KRN","B",.5,.5) "BLD",8677,"KRN","B",.84,.84) "BLD",8677,"KRN","B",3.6,3.6) "BLD",8677,"KRN","B",3.8,3.8) "BLD",8677,"KRN","B",9.2,9.2) "BLD",8677,"KRN","B",9.8,9.8) "BLD",8677,"KRN","B",19,19) "BLD",8677,"KRN","B",19.1,19.1) "BLD",8677,"KRN","B",101,101) "BLD",8677,"KRN","B",409.61,409.61) "BLD",8677,"KRN","B",771,771) "BLD",8677,"KRN","B",779.2,779.2) "BLD",8677,"KRN","B",870,870) "BLD",8677,"KRN","B",8989.51,8989.51) "BLD",8677,"KRN","B",8989.52,8989.52) "BLD",8677,"KRN","B",8994,8994) "BLD",8677,"QDEF") ^^^^NO^^^^^^YES "BLD",8677,"QUES",0) ^9.62^^ "BLD",8677,"REQB",0) ^9.611^1^1 "BLD",8677,"REQB",1,0) RMPR*3.0*139^2 "BLD",8677,"REQB","B","RMPR*3.0*139",1) "KRN",19,5676,-1) 3^2 "KRN",19,5676,0) RMPR PURGE MENU^Purge Obsolete Data^^M^^RMPRMANAGER^^^^^^PROSTHETICS "KRN",19,5676,1,0) ^19.06^1^1^3140110^^ "KRN",19,5676,1,1,0) Purge Menu "KRN",19,5676,10,0) ^19.01IP^4^4 "KRN",19,5676,10,4,0) 13645^PAG "KRN",19,5676,10,4,"^") RMPR PURGE AGED "KRN",19,5676,99) 63361,32513 "KRN",19,5676,"U") PURGE OBSOLETE DATA "KRN",19,13645,-1) 0^3 "KRN",19,13645,0) RMPR PURGE AGED^Purge Aged Purchasing Transactions^^R^^^^^^^^PROSTHETICS "KRN",19,13645,1,0) ^19.06^2^2^3140110^^ "KRN",19,13645,1,1,0) Purge file 664, PROSTHETICS ORDERS, of aged transactions based on "KRN",19,13645,1,2,0) same order purged from File 442. "KRN",19,13645,25) EN20^RMPRCDP "KRN",19,13645,"U") PURGE AGED PURCHASING TRANSACT "MBREQ") 0 "ORD",18,19) 19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA "ORD",18,19,0) OPTION "PKG",101,-1) 1^1 "PKG",101,0) PROSTHETICS^RMPR^PROSTHETICS VERSION 3.0 ALPHA "PKG",101,20,0) ^9.402P^^0 "PKG",101,22,0) ^9.49I^1^1 "PKG",101,22,1,0) 3.0^2960209^2960214 "PKG",101,22,1,"PAH",1,0) 173^3140623 "PKG",101,22,1,"PAH",1,1,0) ^^3^3^3140623 "PKG",101,22,1,"PAH",1,1,1,0) 1. Users are able to edit Inactive HCPCS items in Prosthetics. "PKG",101,22,1,"PAH",1,1,2,0) "PKG",101,22,1,"PAH",1,1,3,0) 2. Purge process created for Prosthetics file #664 [PROSTHETICS 1358] "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") YES "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 2 "RTN","RMPRCDP") 0^1^B34194835^B12814776 "RTN","RMPRCDP",1,0) RMPRCDP ;PHX/DWL,HNB-PURGE FILE 664 ;8/29/1994 "RTN","RMPRCDP",2,0) ;;3.0;PROSTHETICS;**3,173**;Feb 09, 1996;Build 29 "RTN","RMPRCDP",3,0) ; "RTN","RMPRCDP",4,0) ;RMPR*3.0*173 Added purge for file 664 to remove aged orders that are "RTN","RMPRCDP",5,0) ; no longer defined in IFCAP file 442. The purge will be "RTN","RMPRCDP",6,0) ; controlled to ONLY allow orders for a fiscal year greater "RTN","RMPRCDP",7,0) ; than 6 years ago to be entered and should be run AFTER "RTN","RMPRCDP",8,0) ; the IFCAP annual purging process and use the same fiscal "RTN","RMPRCDP",9,0) ; year that purge process used. "RTN","RMPRCDP",10,0) ; "RTN","RMPRCDP",11,0) EN1 ;Purge 664, Canceled Transactions "RTN","RMPRCDP",12,0) D DIV4^RMPRSIT Q:$D(X) "RTN","RMPRCDP",13,0) EN4 K IOP,ZTIO,%ZIS S %ZIS="MQ",%ZIS("B")="" D ^%ZIS G:POP END "RTN","RMPRCDP",14,0) ;I IOST["C-" W !,$C(7),"YOU MAY NOT SELECT YOUR TERMINAL" G EN4 "RTN","RMPRCDP",15,0) I $D(IO("Q")) D "RTN","RMPRCDP",16,0) .S ZTRTN="EN11^RMPRCDP" "RTN","RMPRCDP",17,0) .S ZTDESC="CANCEL TRANSACTIONS IN FILE 664 FOR A STATION/DIVISION" "RTN","RMPRCDP",18,0) .F RD="I","RMPRIEN","RMPRDT","RMPRSITE","RMPR(" S ZTSAVE(RD)="" "RTN","RMPRCDP",19,0) I $D(IO("Q")) K IO("Q") D ^%ZTLOAD W !,$S($D(ZTSK):"",1:"") G END "RTN","RMPRCDP",20,0) EN11 S (I,RMPRIEN)=0,RMPRDT=$P(^RMPR(669.9,RMPRSITE,0),U,10) G:RMPRDT'>89 END "RTN","RMPRCDP",21,0) S X1=DT,X2=-RMPRDT D C^%DTC S RMPRDT=X D NOW^%DTC S Y=% X ^DD("DD") "RTN","RMPRCDP",22,0) U IO W !!,"Purge Canceled Prosthetic Purchasing Transactions For: ",!,$P(^RMPR(669.9,RMPRSITE,0),U,1)," On ",Y,!! "RTN","RMPRCDP",23,0) F S RMPRIEN=$O(^RMPR(664,RMPRIEN)) Q:RMPRIEN'>0 D "RTN","RMPRCDP",24,0) .;quit if it is a purchase card transaction, non get purged "RTN","RMPRCDP",25,0) .Q:$D(^RMPR(664,RMPRIEN,4)) "RTN","RMPRCDP",26,0) .I ($P(^RMPR(664,RMPRIEN,0),U,5))&($P(^(0),U,5)",1:"") G END "RTN","RMPRCDP",37,0) EN2 S (I,RMPRIEN)=0,RMPRDT=$P(^RMPR(669.9,RMPRSITE,0),U,9) G:RMPRDT'>89 END "RTN","RMPRCDP",38,0) S X1=DT,X2=-RMPRDT D C^%DTC S RMPRDT=X D NOW^%DTC S Y=% X ^DD("DD") "RTN","RMPRCDP",39,0) U IO W !!,"Purge Closed Prosthetic Purchasing Transactions For",!,$P(^RMPR(669.9,RMPRSITE,0),U,1)," On ",Y,!! "RTN","RMPRCDP",40,0) F S RMPRIEN=$O(^RMPR(664,RMPRIEN)) Q:RMPRIEN'>0 D "RTN","RMPRCDP",41,0) .;quit if it is a purchase card transaction, non get purged "RTN","RMPRCDP",42,0) .Q:$D(^RMPR(664,RMPRIEN,4)) "RTN","RMPRCDP",43,0) .I ($P(^RMPR(664,RMPRIEN,0),U,8))&($P(^(0),U,8)",1:"") "RTN","RMPRCDP",55,0) G END "RTN","RMPRCDP",56,0) EN3A ; "RTN","RMPRCDP",57,0) S RMPRA=0 F S RMPRA=$O(^RMPR(664,RMPRA)) Q:RMPRA'>0 D "RTN","RMPRCDP",58,0) .;quit if this is a purchase card transaction, non should be purged "RTN","RMPRCDP",59,0) .Q:$D(^RMPR(664,RMPRA,4)) "RTN","RMPRCDP",60,0) .I '$P(^RMPR(664,RMPRA,0),U,6)&('$P(^(0),U,7))&($P(^(0),U,14)=RMPR("STA")) D "RTN","RMPRCDP",61,0) ..S DA=RMPRA,DIC="^RMPR(664," D EN^DIQ "RTN","RMPRCDP",62,0) ..S DA=RMPRA,DIK=DIC D ^DIK W "Deleted...",! S RDEL=1 "RTN","RMPRCDP",63,0) I $G(RDEL)'=1 W !!,"No Non-Obligated Transactions deleted." "RTN","RMPRCDP",64,0) K RMPRA,DIK,DA,I,DIC D ^%ZISC "RTN","RMPRCDP",65,0) Q "RTN","RMPRCDP",66,0) ; "RTN","RMPRCDP",67,0) ;RMPR*3.0*173 File 664 Aged Order Purge "RTN","RMPRCDP",68,0) EN20 ;Purge 664, Aged order transactions based on file 442 purge history for closed/cancelled orders "RTN","RMPRCDP",69,0) S DIR("?")="Enter 'YES' or 'Y' to continue processing." "RTN","RMPRCDP",70,0) S DIR(0)="Y",DIR("A")="Purge MUST follow the IFCAP annual purge process, OK to continue? ",DIR("B")="NO" D ^DIR I $D(DIRUT)!($D(DTOUT))!(+Y'=1) Q "RTN","RMPRCDP",71,0) D DIV4^RMPRSIT G END1:$D(X) "RTN","RMPRCDP",72,0) EN21 ;Select Fiscal Year "RTN","RMPRCDP",73,0) D:'$D(DT) DT^DICRW "RTN","RMPRCDP",74,0) S RMPRFYT=1700+$E(DT,1,3)+$E(DT,4),RMPRFY=RMPRFYT "RTN","RMPRCDP",75,0) S DIR("?")="Fiscal year. Should be same year (or prior) as used in IFCAP annual purge." "RTN","RMPRCDP",76,0) S DIR("A")="Enter FISCAL YEAR (YYYY) to purge",DIR(0)="N^1990:2100",DIR("B")=RMPRFYT-8 D ^DIR K DIR G END1:$D(DIRUT) S RMPRFY=Y "RTN","RMPRCDP",77,0) I RMPRFY>(RMPRFYT-8) W " You CANNOT purge Prosthetics order data for a fiscal year LESS than 8 years ago!!" G EN21 "RTN","RMPRCDP",78,0) S DIR("?")="Enter 'YES' or 'Y' to continue processing." "RTN","RMPRCDP",79,0) S DIR(0)="Y",DIR("A")="Purging closed PROS orders prior to FY end 09/30/"_RMPRFY_", OK? ",DIR("B")="NO" D ^DIR G:$D(DIRUT)!($D(DTOUT)) EN21 I +Y'=1 Q "RTN","RMPRCDP",80,0) S RMPRFYDT=(RMPRFY-1700)_1001 "RTN","RMPRCDP",81,0) EN25 K IOP,ZTIO,%ZIS S %ZIS="MQ",%ZIS("B")="" D ^%ZIS G:POP END1 "RTN","RMPRCDP",82,0) ;I IOST["C-" W !,$C(7),"YOU MAY NOT SELECT YOUR TERMINAL" G EN4 "RTN","RMPRCDP",83,0) I $D(IO("Q")) D "RTN","RMPRCDP",84,0) .S ZTRTN="EN26^RMPRCDP" "RTN","RMPRCDP",85,0) .S ZTDESC="PURGE ALL ORDERS IN FILE 664 FOR A STATION/DIVISION THAT ARE SAME/PRIOR TO CURRENT IFCAP PURGE YEAR" "RTN","RMPRCDP",86,0) .S ZTSAVE("RMPR*")="" "RTN","RMPRCDP",87,0) I $D(IO("Q")) K IO("Q") D ^%ZTLOAD W !,$S($D(ZTSK):"",1:"") G END1 "RTN","RMPRCDP",88,0) EN26 S (I,RMPRIEN,RMPRTOTD)=0 "RTN","RMPRCDP",89,0) D NOW^%DTC S Y=% X ^DD("DD") "RTN","RMPRCDP",90,0) U IO W !!,"Purge Prosthetic Purchasing Transactions For: ",RMPRFY," On ",Y,!! "RTN","RMPRCDP",91,0) F S RMPRIEN=$O(^RMPR(664,RMPRIEN)) Q:RMPRIEN'>0 D "RTN","RMPRCDP",92,0) . S RMPRDEL=0,RMPRODT=$P(^RMPR(664,RMPRIEN,0),U),RMPROSIT=$P(^RMPR(664,RMPRIEN,0),U,14),RMPRORD=$P($G(^RMPR(664,RMPRIEN,4)),U,5),RMPROIEN=$P($G(^RMPR(664,RMPRIEN,4)),U,6) "RTN","RMPRCDP",93,0) . I RMPRODT