Released RMPR*3*81 SEQ #67 Extracted from mail message **KIDS**:RMPR*3.0*81^ **INSTALL NAME** RMPR*3.0*81 "BLD",4678,0) RMPR*3.0*81^PROSTHETICS^0^3031003^y "BLD",4678,4,0) ^9.64PA^^ "BLD",4678,"ABNS",0) ^9.66A^^ "BLD",4678,"ABPKG") n^n "BLD",4678,"KRN",0) ^9.67PA^8989.52^19 "BLD",4678,"KRN",.4,0) .4 "BLD",4678,"KRN",.401,0) .401 "BLD",4678,"KRN",.402,0) .402 "BLD",4678,"KRN",.403,0) .403 "BLD",4678,"KRN",.5,0) .5 "BLD",4678,"KRN",.84,0) .84 "BLD",4678,"KRN",3.6,0) 3.6 "BLD",4678,"KRN",3.8,0) 3.8 "BLD",4678,"KRN",9.2,0) 9.2 "BLD",4678,"KRN",9.8,0) 9.8 "BLD",4678,"KRN",9.8,"NM",0) ^9.68A^1^1 "BLD",4678,"KRN",9.8,"NM",1,0) RMPRE29^^0^B42725696 "BLD",4678,"KRN",9.8,"NM","B","RMPRE29",1) "BLD",4678,"KRN",19,0) 19 "BLD",4678,"KRN",19.1,0) 19.1 "BLD",4678,"KRN",101,0) 101 "BLD",4678,"KRN",409.61,0) 409.61 "BLD",4678,"KRN",771,0) 771 "BLD",4678,"KRN",870,0) 870 "BLD",4678,"KRN",8989.51,0) 8989.51 "BLD",4678,"KRN",8989.52,0) 8989.52 "BLD",4678,"KRN",8994,0) 8994 "BLD",4678,"KRN","B",.4,.4) "BLD",4678,"KRN","B",.401,.401) "BLD",4678,"KRN","B",.402,.402) "BLD",4678,"KRN","B",.403,.403) "BLD",4678,"KRN","B",.5,.5) "BLD",4678,"KRN","B",.84,.84) "BLD",4678,"KRN","B",3.6,3.6) "BLD",4678,"KRN","B",3.8,3.8) "BLD",4678,"KRN","B",9.2,9.2) "BLD",4678,"KRN","B",9.8,9.8) "BLD",4678,"KRN","B",19,19) "BLD",4678,"KRN","B",19.1,19.1) "BLD",4678,"KRN","B",101,101) "BLD",4678,"KRN","B",409.61,409.61) "BLD",4678,"KRN","B",771,771) "BLD",4678,"KRN","B",870,870) "BLD",4678,"KRN","B",8989.51,8989.51) "BLD",4678,"KRN","B",8989.52,8989.52) "BLD",4678,"KRN","B",8994,8994) "BLD",4678,"QUES",0) ^9.62^^ "BLD",4678,"REQB",0) ^9.611^1^1 "BLD",4678,"REQB",1,0) RMPR*3.0*74^1 "BLD",4678,"REQB","B","RMPR*3.0*74",1) "MBREQ") 0 "PKG",101,-1) 1^1 "PKG",101,0) PROSTHETICS^RMPR^PROSTHETICS VERSION 3.0 ALPHA "PKG",101,20,0) ^9.402P^^ "PKG",101,22,0) ^9.49I^1^1 "PKG",101,22,1,0) 3.0^2960209^2960214 "PKG",101,22,1,"PAH",1,0) 81^3031003 "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") YES "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") YES "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") 1 "RTN","RMPRE29") 0^1^B42725696 "RTN","RMPRE29",1,0) RMPRE29 ;PHX/JLT,RVD-EDIT 2319 ;10/2/03 13:04 "RTN","RMPRE29",2,0) ;;3.0;PROSTHETICS;**36,41,51,57,62,74,81**;Feb 09, 1996 "RTN","RMPRE29",3,0) ; "RTN","RMPRE29",4,0) ;RVD patch #62 - call PCE API to update patient care encounter. "RTN","RMPRE29",5,0) ; - add a screen display if no changes to the HCPCS. "RTN","RMPRE29",6,0) ;RVD patch #74 - call $$STATCHK^ICPTAPIU to check if CPT Code is "RTN","RMPRE29",7,0) ; active for a given date. "RTN","RMPRE29",8,0) ;RVD patch #81 - roll back patch RMPR*3.0*74 and returns the screen "RTN","RMPRE29",9,0) ; to the STATUS field of file #661.1. "RTN","RMPRE29",10,0) ;uses DBIA # 1995 & 1997. "RTN","RMPRE29",11,0) W ! S DIC="^RMPR(660,",DIC(0)="AEMQZ",DIC("A")="Select PATIENT: " "RTN","RMPRE29",12,0) S DIC("W")="D EN^RMPRD1",RMEND=0 "RTN","RMPRE29",13,0) S DIC("S")="I $P(^(0),U,6)!($P(^(0),U,26)'="""")" W ! "RTN","RMPRE29",14,0) D ^DIC G:+Y'>0 EXIT L +^RMPR(660,+Y,0):1 I $T=0 W !,?5,$C(7),"Someone else is Editing this entry!" G EXIT "RTN","RMPRE29",15,0) ;S (RMPRDA,DA)=+Y,DIE=DIC,DR="[RMPRE2319]" D ^DIE L -^RMPR(660,DA,0) "RTN","RMPRE29",16,0) S DIE=DIC,(RMPRDA,DA)=+Y "RTN","RMPRE29",17,0) TYP1 ;edit type of transaction.... "RTN","RMPRE29",18,0) S R1(0)=$G(^RMPR(660,RMPRDA,0)),R1(1)=$G(^(1)),R1("AM")=$G(^("AM")) "RTN","RMPRE29",19,0) S RMTOTCOS=$P(R1(0),U,16) "RTN","RMPRE29",20,0) S (RMHCPC,RMHCOLD)=$P(R1(1),U,4),(RMTYPE,RMTYPS)=$P(R1(0),U,4),(RMCAT,RMCATS)=$P(R1("AM"),U,3),(RMSPE,RMSPES)=$P(R1("AM"),U,4),RMSOUR=$P(R1(1),U,14) "RTN","RMPRE29",21,0) TRAN K DIR S DIR(0)="660,2" "RTN","RMPRE29",22,0) ;S DIR("A")="Enter Type of Transaction: " "RTN","RMPRE29",23,0) S:$D(RMTYPS) DIR("B")=$S(RMTYPS="I":"INITIAL",RMTYPS="X":"REPAIR",RMTYPS="R":"REPLACE",RMTYPS="S":"SPARE",1:"") "RTN","RMPRE29",24,0) D ^DIR "RTN","RMPRE29",25,0) I $D(DUOUT)!$D(DTOUT) S RMEND=1 D SETED2 G QED2 "RTN","RMPRE29",26,0) I Y="" W !,"Please enter type of Transaction!!" G TRAN "RTN","RMPRE29",27,0) S $P(R1(0),U,4)=Y,RMTYPE=Y "RTN","RMPRE29",28,0) S RMTYPS=$S(Y="I":"INITIAL",Y="X":"REPAIR",Y="R":"REPLACE",Y="S":"SPARE",1:"") "RTN","RMPRE29",29,0) PCAT K DIR S DIR(0)="660,62" "RTN","RMPRE29",30,0) S:$D(RMCATS) DIR("B")=$S(RMCATS=1:"SC/OP",RMCATS=2:"SC/IP",RMCATS=3:"NSC/IP",RMCATS=4:"NSC/OP",1:"") "RTN","RMPRE29",31,0) D ^DIR "RTN","RMPRE29",32,0) I $D(DUOUT)!$D(DTOUT) S RMEND=1 D SETED2 G QED2 "RTN","RMPRE29",33,0) I Y="" W !,"Please enter Patient Category!!" G PCAT "RTN","RMPRE29",34,0) S RMCAT=Y "RTN","RMPRE29",35,0) S $P(R1("AM"),U,3)=Y,RMCATS=$S(Y=1:"SC/OP",Y=2:"SC/IP",Y=3:"NSC/IP",Y=4:"NSC/OP",1:"") "RTN","RMPRE29",36,0) K DIR I RMCAT<4 S $P(R1("AM"),U,4)="" G HCPC "RTN","RMPRE29",37,0) S DIR(0)="660,63" "RTN","RMPRE29",38,0) S:$D(RMSPES) DIR("B")=$S(RMSPES=1:"SPECIAL LEGISLATION",RMSPES=2:"A&A",RMSPES=3:"PHC",RMSPES=4:"ELIGIBILITY REFORM",1:"") "RTN","RMPRE29",39,0) I RMCAT=4 D ^DIR I $D(DUOUT)!$D(DTOUT) S RMEND=1 D SETED2 G QED2 "RTN","RMPRE29",40,0) I RMCAT=4 S $P(R1("AM"),U,4)=Y,RMSPE=Y,RMSPES=$S(Y=1:"SPECIAL LEGISLATION",Y=2:"A&A",Y=3:"PHC",Y=4:"ELIGIBILITY REFORM",1:"") "RTN","RMPRE29",41,0) K DIR "RTN","RMPRE29",42,0) ; "RTN","RMPRE29",43,0) HCPC ;set type and ask item and HCPCS "RTN","RMPRE29",44,0) D SETED2 "RTN","RMPRE29",45,0) ;ask source "RTN","RMPRE29",46,0) N SRC "RTN","RMPRE29",47,0) S SRC=$P(R1(0),U,14) "RTN","RMPRE29",48,0) S DIE("NO^")="BACK" "RTN","RMPRE29",49,0) S DR="12;4;4.5" D ^DIE "RTN","RMPRE29",50,0) K DIE("NO^") "RTN","RMPRE29",51,0) I $D(DUOUT)!$D(DTOUT)!$D(Y) S RMEND=1 G QED2 "RTN","RMPRE29",52,0) S R1(0)=$G(^RMPR(660,RMPRDA,0)),R1(1)=$G(^(1)) "RTN","RMPRE29",53,0) I $P(R1(0),U,14)'=SRC S RMHCOLD="" "RTN","RMPRE29",54,0) S RMHCPC=$P(R1(1),U,4) "RTN","RMPRE29",55,0) W !,"OLD CPT MODIFER: ",$P(R1(1),U,6) "RTN","RMPRE29",56,0) ;if HCPCS was changed, Modifier must be changed "RTN","RMPRE29",57,0) I RMHCOLD'=RMHCPC D "RTN","RMPRE29",58,0) .S RDA=RMHCPC_"^"_$P(R1(0),U,4)_"^"_$P(R1(0),U,14)_"^"_660 "RTN","RMPRE29",59,0) .D CPT^RMPRCPTU(RDA) S $P(^RMPR(660,RMPRDA,1),U,6)=RMCPT "RTN","RMPRE29",60,0) .W !,"NEW CPT MODIFIER: ",RMCPT "RTN","RMPRE29",61,0) ;if HCPCS the same, ask user if want to edit modifier. "RTN","RMPRE29",62,0) E D "RTN","RMPRE29",63,0) .S DIR(0)="Y",DIR("B")="N",DIR("A")="Would you like to edit the CPT Modifier " "RTN","RMPRE29",64,0) .D ^DIR Q:$D(DUOUT)!$D(DTOUT) "RTN","RMPRE29",65,0) .I (Y>0) D "RTN","RMPRE29",66,0) ..S RDA=RMHCPC_"^"_$P(R1(0),U,4)_"^"_$P(R1(0),U,14)_"^"_660 "RTN","RMPRE29",67,0) ..D CPT^RMPRCPTU(RDA) S $P(^RMPR(660,RMPRDA,1),U,6)=RMCPT "RTN","RMPRE29",68,0) ..K DIR "RTN","RMPRE29",69,0) ..W:RMCPT=$P(R1(1),U,6) !!,"***Based on the information given above, CPT modifier string has not changed!!!",! "RTN","RMPRE29",70,0) ..W:RMCPT'=$P(R1(1),U,6) !,"NEW CPT MODIFIER: ",RMCPT "RTN","RMPRE29",71,0) S DR="7;5;14;9;21;16;28" D ^DIE "RTN","RMPRE29",72,0) I RMTOTCOS'=$P(^RMPR(660,DA,0),U,16) S DR="35////^S X=DUZ;36////^S X=DT" D ^DIE "RTN","RMPRE29",73,0) I $D(DTOUT)!('$G(Y))!($D(DUOUT)) D CHK "RTN","RMPRE29",74,0) QED2 ; "RTN","RMPRE29",75,0) Q:$D(RMPREDT) "RTN","RMPRE29",76,0) ;modified by #62 "RTN","RMPRE29",77,0) ;call PCE API to update patient care encounter. "RTN","RMPRE29",78,0) I $D(^RMPR(660,RMPRDA,10)),$P(^RMPR(660,RMPRDA,10),U,12) D "RTN","RMPRE29",79,0) .S RMCHK=$$SENDPCE^RMPRPCEA(RMPRDA) "RTN","RMPRE29",80,0) .I RMCHK<1 H 3 "RTN","RMPRE29",81,0) L -^RMPR(660,RMPRDA,0) "RTN","RMPRE29",82,0) K DIR W ! S DIR(0)="Y",DIR("A")="Would You like to Edit another Entry (Y/N) " D ^DIR "RTN","RMPRE29",83,0) G:'$D(DTOUT)&(Y>0) RMPRE29 "RTN","RMPRE29",84,0) EXIT ; "RTN","RMPRE29",85,0) N RMPR,RMPRSITE D KILL^XUSCLEAN "RTN","RMPRE29",86,0) K DIC,DIE,DIR,%,X,Y "RTN","RMPRE29",87,0) Q "RTN","RMPRE29",88,0) SETED2 ;set 660 "RTN","RMPRE29",89,0) S ^RMPR(660,DA,0)=R1(0),^RMPR(660,DA,1)=R1(1),^RMPR(660,DA,"AM")=R1("AM") "RTN","RMPRE29",90,0) S DIK="^RMPR(660,",DA=RMPRDA D IX1^DIK K DIC "RTN","RMPRE29",91,0) D CHK "RTN","RMPRE29",92,0) Q "RTN","RMPRE29",93,0) ; "RTN","RMPRE29",94,0) QUICK ;quick edit for HCPCS and type "RTN","RMPRE29",95,0) K RMCPT "RTN","RMPRE29",96,0) W ! S DIC="^RMPR(660,",DIC(0)="AEMNQZ",DIC("A")="Select NUMBER, or Patient: " "RTN","RMPRE29",97,0) S DIC("W")="D EN^RMPRD1" "RTN","RMPRE29",98,0) S DIC("S")="I $P(^(0),U,6)!($P(^(0),U,26)'="""")" W ! "RTN","RMPRE29",99,0) D ^DIC G:+Y'>0 EXIT L +^RMPR(660,+Y,0):1 I $T=0 W !,?5,$C(7),"Someone else is Editing this entry!" G EXIT "RTN","RMPRE29",100,0) ;add source "RTN","RMPRE29",101,0) S (RMPRDA,DA)=+Y,DIE=DIC,DR="2;4.5" "RTN","RMPRE29",102,0) S R1(0)=$G(^RMPR(660,DA,0)),R1(1)=$G(^RMPR(660,DA,1)) "RTN","RMPRE29",103,0) S RMTYPE=$P(R1(0),U,4),RMSOUR=$P(R1(0),U,14) "RTN","RMPRE29",104,0) S RMHCOLD=$P(R1(1),U,4) "RTN","RMPRE29",105,0) D ^DIE G:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)!$D(Y) SET "RTN","RMPRE29",106,0) S RMHCNEW=$P($G(^RMPR(660,DA,1)),U,4) "RTN","RMPRE29",107,0) S RMTYPE=$P($G(^RMPR(660,DA,0)),U,4) "RTN","RMPRE29",108,0) S RDA=RMHCNEW_"^"_RMTYPE_"^"_RMSOUR_"^"_660 "RTN","RMPRE29",109,0) W !,"OLD CPT MODIFER: ",$P(R1(1),U,6) "RTN","RMPRE29",110,0) I RMHCOLD'=RMHCNEW D "RTN","RMPRE29",111,0) .D CPT^RMPRCPTU(RDA) "RTN","RMPRE29",112,0) .W !,"NEW CPT MODIFIER: ",RMCPT "RTN","RMPRE29",113,0) .S $P(^RMPR(660,DA,1),U,6)=RMCPT "RTN","RMPRE29",114,0) I RMHCOLD=RMHCNEW D "RTN","RMPRE29",115,0) .W ! S DIR("B")="N",DIR(0)="Y",DIR("A")="Would You like to Edit CPT MODIFIER " D ^DIR "RTN","RMPRE29",116,0) .I $D(DTOUT)!('$G(Y)) K DIR Q "RTN","RMPRE29",117,0) .D CPT^RMPRCPTU(RDA) "RTN","RMPRE29",118,0) .W:RMCPT=$P(R1(1),U,6) !!,"***Based on the information given above, CPT modifier string has not changed!!!",! "RTN","RMPRE29",119,0) .W:RMCPT'=$P(R1(1),U,6) !,"NEW CPT MODIFIER: ",RMCPT "RTN","RMPRE29",120,0) .S $P(^RMPR(660,DA,1),U,6)=RMCPT "RTN","RMPRE29",121,0) SET K DIR D CHK "RTN","RMPRE29",122,0) ;modified by #62 "RTN","RMPRE29",123,0) ;call PCE API to update patient care encounter "RTN","RMPRE29",124,0) I $D(^RMPR(660,RMPRDA,10)),$P(^RMPR(660,RMPRDA,10),U,12) D "RTN","RMPRE29",125,0) .S RMCHK=$$SENDPCE^RMPRPCEA(RMPRDA) "RTN","RMPRE29",126,0) .I RMCHK<1 H 3 "RTN","RMPRE29",127,0) W ! S DIR(0)="Y",DIR("A")="Would You like to Edit another Entry (Y/N)" D ^DIR "RTN","RMPRE29",128,0) G:'$D(DTOUT)&(Y>0) QUICK^RMPRE29 "RTN","RMPRE29",129,0) L -^RMPR(660,RMPRDA,0) "RTN","RMPRE29",130,0) D KILL^XUSCLEAN Q "RTN","RMPRE29",131,0) ; "RTN","RMPRE29",132,0) CHK ;check for transaction changes "RTN","RMPRE29",133,0) S RMTYPE=$P($G(^RMPR(660,RMPRDA,0)),U,4) "RTN","RMPRE29",134,0) S RMHCPC=$P($G(^RMPR(660,RMPRDA,1)),U,4) Q:'$G(RMHCPC) "RTN","RMPRE29",135,0) S RMCPT1=$P($G(^RMPR(661.1,RMHCPC,4)),U,1) "RTN","RMPRE29",136,0) S RMCPT=$P($G(^RMPR(660,RMPRDA,1)),U,6) "RTN","RMPRE29",137,0) I ((RMTYPE="R")!(RMTYPE="X")),(RMCPT'["RP"),($G(^RMPR(661.1,RMHCPC,4))["RP") D ADDRP "RTN","RMPRE29",138,0) I ((RMTYPE="I")!(RMTYPE="S")),(RMCPT["RP") D DELRP "RTN","RMPRE29",139,0) I (RMSOUR="C"),(RMCPT["RR") D DELNU "RTN","RMPRE29",140,0) I (RMSOUR="C"),(RMCPT'["RR"),(RMCPT1["NU"),(RMCPT'["N") D ADDNU "RTN","RMPRE29",141,0) K RMHCPC,RMCI,RMC,RMCLEN,RMLPIECE,RMF,RMFPIECE,RMTYPE,RMPRA,R4DA Q "RTN","RMPRE29",142,0) ;return to EDIT option "RTN","RMPRE29",143,0) DELRP ;logic for deleting 'RP' modifier with transaction change. "RTN","RMPRE29",144,0) F RMCI=1:1:8 S RMC=$P(RMCPT,",",RMCI) I RMC="RP" S $P(RMCPT,",",RMCI)="" D "RTN","RMPRE29",145,0) .S RMF=$F(RMCPT,",,"),RMFPIECE=$E(RMCPT,1,RMF-2) "RTN","RMPRE29",146,0) .S RMLPIECE=$E(RMCPT,RMF,32),RMCPT=RMFPIECE_RMLPIECE,RMCLEN=$L(RMCPT) "RTN","RMPRE29",147,0) .I $E(RMCPT,1)="," S RMCPT=$E(RMCPT,2,RMCLEN) "RTN","RMPRE29",148,0) .I $E(RMCPT,RMCLEN)="," S RMCPT=$E(RMCPT,1,RMCLEN-1) "RTN","RMPRE29",149,0) .S $P(^RMPR(660,RMPRDA,1),U,6)=RMCPT "RTN","RMPRE29",150,0) Q "RTN","RMPRE29",151,0) DELNU ;logic for deleting 'NU' modifier. "RTN","RMPRE29",152,0) F RMCI=1:1:8 S RMC=$P(RMCPT,",",RMCI) I RMC="NU" S $P(RMCPT,",",RMCI)="" D "RTN","RMPRE29",153,0) .S RMF=$F(RMCPT,",,"),RMFPIECE=$E(RMCPT,1,RMF-2) "RTN","RMPRE29",154,0) .S RMLPIECE=$E(RMCPT,RMF,32),RMCPT=RMFPIECE_RMLPIECE,RMCLEN=$L(RMCPT) "RTN","RMPRE29",155,0) .I $E(RMCPT,1)="," S RMCPT=$E(RMCPT,2,RMCLEN) "RTN","RMPRE29",156,0) .I $E(RMCPT,RMCLEN)="," S RMCPT=$E(RMCPT,1,RMCLEN-1) "RTN","RMPRE29",157,0) .S $P(^RMPR(660,RMPRDA,1),U,6)=RMCPT "RTN","RMPRE29",158,0) Q "RTN","RMPRE29",159,0) ; "RTN","RMPRE29",160,0) ADDRP ;logic for adding 'RP' modifier with transaction change. "RTN","RMPRE29",161,0) S RMCPT=RMCPT_",RP" S $P(^RMPR(660,RMPRDA,1),U,6)=RMCPT "RTN","RMPRE29",162,0) Q "RTN","RMPRE29",163,0) ADDNU ;logic for adding 'NU' modifier. "RTN","RMPRE29",164,0) S RMCPT=RMCPT_",NU" S $P(^RMPR(660,RMPRDA,1),U,6)=RMCPT "RTN","RMPRE29",165,0) Q "RTN","RMPRE29",166,0) ;END "VER") 8.0^22 **END** **END**