Released RMPR*3*142 SEQ #120 Extracted from mail message **KIDS**:RMPR*3.0*142^ **INSTALL NAME** RMPR*3.0*142 "BLD",6860,0) RMPR*3.0*142^PROSTHETICS^0^3071218^y "BLD",6860,1,0) ^^5^5^3071207^ "BLD",6860,1,1,0) 1. No data available for clinics "BLD",6860,1,2,0) "BLD",6860,1,3,0) 2. CONT+5^RMPR29CA "BLD",6860,1,4,0) "BLD",6860,1,5,0) 3. UPD+2^RMPR29CA "BLD",6860,4,0) ^9.64PA^^ "BLD",6860,6.3) 2 "BLD",6860,"ABPKG") n "BLD",6860,"KRN",0) ^9.67PA^8989.52^19 "BLD",6860,"KRN",.4,0) .4 "BLD",6860,"KRN",.401,0) .401 "BLD",6860,"KRN",.402,0) .402 "BLD",6860,"KRN",.403,0) .403 "BLD",6860,"KRN",.5,0) .5 "BLD",6860,"KRN",.84,0) .84 "BLD",6860,"KRN",3.6,0) 3.6 "BLD",6860,"KRN",3.8,0) 3.8 "BLD",6860,"KRN",9.2,0) 9.2 "BLD",6860,"KRN",9.8,0) 9.8 "BLD",6860,"KRN",9.8,"NM",0) ^9.68A^5^5 "BLD",6860,"KRN",9.8,"NM",1,0) RMPR29CA^^0^B70452524 "BLD",6860,"KRN",9.8,"NM",2,0) RMPRPCEB^^0^B22025437 "BLD",6860,"KRN",9.8,"NM",3,0) RMPR29A^^0^B24738338 "BLD",6860,"KRN",9.8,"NM",4,0) RMPR29BG^^0^B10687470 "BLD",6860,"KRN",9.8,"NM",5,0) RMPR29GA^^0^B28760981 "BLD",6860,"KRN",9.8,"NM","B","RMPR29A",3) "BLD",6860,"KRN",9.8,"NM","B","RMPR29BG",4) "BLD",6860,"KRN",9.8,"NM","B","RMPR29CA",1) "BLD",6860,"KRN",9.8,"NM","B","RMPR29GA",5) "BLD",6860,"KRN",9.8,"NM","B","RMPRPCEB",2) "BLD",6860,"KRN",19,0) 19 "BLD",6860,"KRN",19.1,0) 19.1 "BLD",6860,"KRN",101,0) 101 "BLD",6860,"KRN",409.61,0) 409.61 "BLD",6860,"KRN",771,0) 771 "BLD",6860,"KRN",870,0) 870 "BLD",6860,"KRN",8989.51,0) 8989.51 "BLD",6860,"KRN",8989.52,0) 8989.52 "BLD",6860,"KRN",8994,0) 8994 "BLD",6860,"KRN","B",.4,.4) "BLD",6860,"KRN","B",.401,.401) "BLD",6860,"KRN","B",.402,.402) "BLD",6860,"KRN","B",.403,.403) "BLD",6860,"KRN","B",.5,.5) "BLD",6860,"KRN","B",.84,.84) "BLD",6860,"KRN","B",3.6,3.6) "BLD",6860,"KRN","B",3.8,3.8) "BLD",6860,"KRN","B",9.2,9.2) "BLD",6860,"KRN","B",9.8,9.8) "BLD",6860,"KRN","B",19,19) "BLD",6860,"KRN","B",19.1,19.1) "BLD",6860,"KRN","B",101,101) "BLD",6860,"KRN","B",409.61,409.61) "BLD",6860,"KRN","B",771,771) "BLD",6860,"KRN","B",870,870) "BLD",6860,"KRN","B",8989.51,8989.51) "BLD",6860,"KRN","B",8989.52,8989.52) "BLD",6860,"KRN","B",8994,8994) "BLD",6860,"QUES",0) ^9.62^^ "BLD",6860,"REQB",0) ^9.611^4^4 "BLD",6860,"REQB",1,0) RMPR*3.0*122^2 "BLD",6860,"REQB",2,0) RMPR*3.0*41^2 "BLD",6860,"REQB",3,0) RMPR*3.0*133^2 "BLD",6860,"REQB",4,0) RMPR*3.0*60^2 "BLD",6860,"REQB","B","RMPR*3.0*122",1) "BLD",6860,"REQB","B","RMPR*3.0*133",3) "BLD",6860,"REQB","B","RMPR*3.0*41",2) "BLD",6860,"REQB","B","RMPR*3.0*60",4) "MBREQ") 0 "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) 142^3071218 "PKG",101,22,1,"PAH",1,1,0) ^^5^5^3071218 "PKG",101,22,1,"PAH",1,1,1,0) 1. No data available for clinics "PKG",101,22,1,"PAH",1,1,2,0) "PKG",101,22,1,"PAH",1,1,3,0) 2. CONT+5^RMPR29CA "PKG",101,22,1,"PAH",1,1,4,0) "PKG",101,22,1,"PAH",1,1,5,0) 3. UPD+2^RMPR29CA "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") 5 "RTN","RMPR29A") 0^3^B24738338^B24451513 "RTN","RMPR29A",1,0) RMPR29A ;PHX/JLT,RVD-RMPR29 CONTINUED [ 09/29/94 11:22 AM ] "RTN","RMPR29A",2,0) ;;3.0;PROSTHETICS;**12,13,28,41,142**;Feb 09, 1996;Build 2 "RTN","RMPR29A",3,0) POST ;POST 2529-3 TO APPLIANCE/REPAIR FILE #660 "RTN","RMPR29A",4,0) I '$D(RMPRDA)!('$D(^RMPR(664.1,RMPRDA,2,0))) Q "RTN","RMPR29A",5,0) S NOAC=$P(^RMPR(664.1,RMPRDA,0),U,23),NOLC=$P(^(0),U,20),RMPR("REF")=$P(^(0),U,4),RMPRG=$P(^(0),U,14) "RTN","RMPR29A",6,0) I RMPRG G GGC "RTN","RMPR29A",7,0) L +^RMPR(669.9,RMPRSITE,0):999 I $T=0 S RMPRG=DT_99 G GGC "RTN","RMPR29A",8,0) S RMPRG=$P(^RMPR(669.9,RMPRSITE,0),U,7),RMPRG=RMPRG-1,$P(^RMPR(669.9,RMPRSITE,0),U,7)=RMPRG L -^RMPR(669.9,RMPRSITE,0) "RTN","RMPR29A",9,0) GGC I 'NOAC W !!,?5,"Updating Patient's 10-2319" "RTN","RMPR29A",10,0) S RMPRDT=$P(^RMPR(664.1,RMPRDA,0),U,1),RMPRDFN=$P(^(0),U,2),SRC=$P(^(0),U,11),TO=$P(^(0),U,15) K RNEW "RTN","RMPR29A",11,0) F RA=0:0 S RA=$O(^RMPR(664.1,RMPRDA,2,RA)) Q:RA'>0 I $D(^(RA,0)) S IT=$P(^(0),U,1),QTY=$P(^(0),U,2),UN=$P(^(0),U,3),RDA=$P(^(0),U,5),TYP=$P(^(0),U,7),ELS=$P(^(0),U,8),SCAT=$P(^(0),U,9),SER=$P(^(0),U,12) D "RTN","RMPR29A",12,0) .S HCPCS=$P($G(^RMPR(664.1,RMPRDA,2,RA,2)),U,1),RMCPT=$P($G(^(2)),U,2) "RTN","RMPR29A",13,0) .I RDA,'$D(^RMPR(660,RDA,0)) S RDA="" "RTN","RMPR29A",14,0) .I 'RDA S DIC="^RMPR(660,",DLAYGO=660,DIC(0)="LZ",X=RMPRDT D FILE^DICN K DLAYGO Q:+Y'>0 S RDA=+Y,RNEW=$P(Y,U,3) S $P(^RMPR(660,RDA,0),U,1)=RMPRDT,$P(^(0),U,2)=RMPRDFN,$P(^(0),U,3)=RMPRDT "RTN","RMPR29A",15,0) DR .K DR S DR="2///^S X=TYP;4.5////^S X=$G(HCPCS);5///^S X=QTY;9///^S X=SER;78///^S X=UN;8////^S X=RMPR(""STA"");11///^S X=4;62///^S X=ELS;63///^S X=SCAT;68///^S X=RMPRG;4.1////^S X=$P(^RMPR(661.1,HCPCS,0),U,4);4.7////^S X=RMCPT" "RTN","RMPR29A",16,0) .S DIE="^RMPR(660,",DA=RDA D ^DIE S RIT=$P(^RMPR(660,RDA,0),U,6) K ^RMPR(660,"AD",+RIT,RDA) "RTN","RMPR29A",17,0) .S $P(^RMPR(660,RDA,0),U,6)=IT,$P(^(0),U,27)=DUZ,$P(^RMPR(660,RDA,"LB"),U,1)=RMPR("REF"),$P(^("LB"),U,3)=SRC,$P(^("LB"),U,4)=TO,$P(^("LB"),U,14)=NOLC,$P(^RMPR(660,RDA,"AM"),U,2)=NOAC "RTN","RMPR29A",18,0) .I $D(^RMPR(664.1,RMPRDA,2,RA,1)),$O(^RMPR(664.1,RMPRDA,2,RA,1,0)) D "RTN","RMPR29A",19,0) ..K ^RMPR(660,RDA,"DES") F RW=0:0 S RW=$O(^RMPR(664.1,RMPRDA,2,RA,1,RW)) Q:RW'>0 S RN=RW S ^RMPR(660,RDA,"DES",RW,0)=^RMPR(664.1,RMPRDA,2,RA,1,RW,0) "RTN","RMPR29A",20,0) .I $D(RN) S ^RMPR(660,RDA,"DES",0)="^660.028^"_RN_U_RN_U_DT_"^^" "RTN","RMPR29A",21,0) .S DIK="^RMPR(660,",DA=RDA D:'$D(RNEW) IX^DIK D:$D(RNEW) IX1^DIK K RNEW "RTN","RMPR29A",22,0) .S $P(^RMPR(664.1,RMPRDA,2,RA,0),U,5)=RDA S $P(^RMPR(660,DA,"LB"),U,10)=RMPRDA,$P(^RMPR(660,DA,0),U,14)="V" S $P(^RMPR(664.1,RMPRDA,0),U,14)=RMPRG "RTN","RMPR29A",23,0) S DA=RMPRDA,DIK="^RMPR(664.1," D IX^DIK I $P(^RMPR(664.1,RMPRDA,0),U,15)=RMPR("STA") D EN4^RMPR29U(RMPRDA) "RTN","RMPR29A",24,0) Q "RTN","RMPR29A",25,0) END L:+$G(RMPRDA) -^RMPR(664.1,+RMPRDA,0) K ^UTILITY("DIQ1",$J) "RTN","RMPR29A",26,0) W !! S DIR(0)="Y",DIR("B")="YES",DIR("A")="Would you like to Process another 2529-3" D ^DIR G:+Y=1 PRC^RMPR29S "RTN","RMPR29A",27,0) N RMPR,RMPRSITE D KILL^XUSCLEAN Q "RTN","RMPR29A",28,0) ITM ;EDIT 2529-3 ITEM "RTN","RMPR29A",29,0) W ! K DIC,Y,RDA S DA=RMPRDA,DIC="^RMPR(664.1,"_RMPRDA_",2,",DIC("P")="664.16PA",DA(1)=RMPRDA,DIC(0)="AEQML",DIC("W")="S RA=$P(^(0),U,1) W ?16,$$ITM^RMPR31U(RA)" D ^DIC G:+Y'>0 PT "RTN","RMPR29A",30,0) S (IEN,DA)=+Y,RNEW=$P(Y,U,3) S RY=$P(Y,U,2) D ITA^RMPR29U(RY) "RTN","RMPR29A",31,0) S RDA(+Y)=^RMPR(664.1,RMPRDA,2,+Y,0) K RMPRPU I $P(RDA(IEN),U,5),$D(^RMPR(664.2,"AF",$P(RDA(IEN),U,5))) W $C(7),!!,?5,"A 2421 HAS BEEN INITIATED FOR THIS ITEM" S RMPRPU=1 "RTN","RMPR29A",32,0) I $P(RDA(IEN),U,5),$D(^RMPR(664.2,"AR4",$P(RDA(IEN),U,5))) W $C(7),!!,?5,"A 2529-3 HAS BEEN INITIATED FOR THIS ITEM" S RMPRPU=1 "RTN","RMPR29A",33,0) S DIE=DIC,DR=$S($D(RMPRPU):"",1:".01R") "RTN","RMPR29A",34,0) ;S DR=DR_";13;2R;3R;8R;9R;I $P(^RMPR(664.1,DA(1),2,DA,0),U,10)'=4 S Y=""@1"";10///@;10R;@1;7;12" "RTN","RMPR29A",35,0) S DR=DR_";8R;S RMTYPE=$P(^RMPR(664.1,RMPRDA,2,DA,0),U,7);9R;13;2R;3R;7;12" "RTN","RMPR29A",36,0) D ^DIE I $D(DA),'$D(Y(0)) S RY=$P(^RMPR(664.1,DA(1),2,DA,0),U) D ITA^RMPR29U(RY) "RTN","RMPR29A",37,0) I $D(DA),^RMPR(664.1,DA(1),2,DA,0)'=RDA(DA) S REDIT=1,RDATA=RMTYPE_"^"_RMPRDA_"^"_DA D CHKCPT^RMPR29U(RDATA) K RDATA,RMTYPE,RMCPT "RTN","RMPR29A",38,0) I $D(DA) I $P(^RMPR(664.1,DA(1),2,DA,0),U)=""!($P(^(0),U,2)="")!($P(^(0),U,3)="")!($P(^(0),U,7)="")!($P(^(0),U,8)="") S DIK=DIE D ^DIK D "RTN","RMPR29A",39,0) .K DA W !!,?5,$C(7),"ITEM INFORMATION IS MISSING",!!,?5,"Deleted..." "RTN","RMPR29A",40,0) I '$D(DA) S DA=$P(RDA(IEN),U,5),DIK="^RMPR(660," I +DA D ^DIK S DA=$O(^RMPR(664.2,"C",+$P(RDA(IEN),U,5),0)) I +DA S DIK="^RMPR(664.2," D ^DIK D "RTN","RMPR29A",41,0) .F DA=0:0 S DA=$O(^RMPR(664.3,"C",$P(RDA(IEN),U,5),DA)) Q:DA'>0 S DIK="^RMPR(664.3," D ^DIK "RTN","RMPR29A",42,0) K FLGG,DR,Y I $P($G(^RMPR(664.1,RMPRDA,2,0)),U,3)=""!($P($G(^(0)),U,4)="") D "RTN","RMPR29A",43,0) .W !!,$C(7),?5,"2529-3 HAS BEEN RETURNED CANCELLED" S DIE="^RMPR(664.1,",DA=RMPRDA,DR="19///@;.09///@;15///@;16///^S X=""CA""" D ^DIE S $P(^RMPR(664.1,DA,0),U,20)="",FLGG=1 "RTN","RMPR29A",44,0) K DR S RDC=$G(^RMPR(664.1,RMPRDA,2,IEN,0)) I (+RDC'=+RDA(IEN)),'RNEW D I $D(FLGG) G END "RTN","RMPR29A",45,0) .D NOW^%DTC S (NX,X)=% K % "RTN","RMPR29A",46,0) .S DIC("P")="664.129DA",DA(1)=RMPRDA "RTN","RMPR29A",47,0) .S DIC="^RMPR(664.1,"_RMPRDA_",8,",DIC(0)="LZ" "RTN","RMPR29A",48,0) .S DLAYGO=664.1 D FILE^DICN K DLAYGO "RTN","RMPR29A",49,0) .I +Y S DIE="^RMPR(664.1,"_RMPRDA_",8,",DA(1)=RMPRDA,DA=+Y,DR=".01///^S X=NX;1///^S X=$$ITM^RMPR31U(+RDA(IEN));2///^S X=$$ITM^RMPR31U(+RDC);3////^S X=DUZ;W $C(7),!!,?5,""ITEM/JOB HAS BEEN CHANGED OR DELETED"";4~AUDIT REMARKS" D ^DIE "RTN","RMPR29A",50,0) G ITM "RTN","RMPR29A",51,0) PT D:$D(REDIT) POST K DA,DR,REDIT G DISP^RMPR29D "RTN","RMPR29BG") 0^4^B10687470^B9828158 "RTN","RMPR29BG",1,0) RMPR29BG ;OI-HINES/SPS -OWL BASE HCPCS ENTER/EDIT/DELETE RPC;12/27/2004 "RTN","RMPR29BG",2,0) ;;3.0;PROSTHETICS;**75,142**;Feb 09, 1996;Build 2 "RTN","RMPR29BG",3,0) A1(RMAED,RMPRSITE,RMIE1,RMIE16,RMITM,RMQTY,RMUI,RMTT,RMPC,RMSN,RMHCPC,RMCPTM,RMVEN) ;roll and scroll entry point "RTN","RMPR29BG",4,0) G A2 "RTN","RMPR29BG",5,0) EN(RESULTS,RMAED,RMPRSITE,RMIE1,RMIE16,RMITM,RMQTY,RMUI,RMTT,RMPC,RMSN,RMHCPC,RMCPTM,RMVEN,RMBD,RMHTECH,RMPRTXT) ;RPC entry point "RTN","RMPR29BG",6,0) A2 ; "RTN","RMPR29BG",7,0) N J,L,RESULTS,RMIE16C,RMIE16F,R6641,RSITE "RTN","RMPR29BG",8,0) S RESULTS(0)="" "RTN","RMPR29BG",9,0) K ^TMP($J) "RTN","RMPR29BG",10,0) ; If no Tech assigned then self assign here "RTN","RMPR29BG",11,0) I +$P(^RMPR(664.1,RMIE1,0),U,16)'>0 S $P(^(0),U,16)=DUZ,$P(^(0),U,17)="A",$P(^(7),U,1)=DT,$P(^(7),U,3)=DUZ "RTN","RMPR29BG",12,0) ; "RTN","RMPR29BG",13,0) I RMAED="D" G DEL "RTN","RMPR29BG",14,0) ; "RTN","RMPR29BG",15,0) S RMERR=0 "RTN","RMPR29BG",16,0) S ^TMP("SPS",0)=RMAED_U_RMPRSITE_U_RMIE1_U_RMIE16_U_RMITM_U_RMQTY_U_RMUI_U_RMTT_U_RMPC_U_RMSN_U_RMHCPC_U_RMCPTM_U_RMVEN "RTN","RMPR29BG",17,0) S RMIE16F=$O(^RMPR(664.1,RMIE1,2,0)) "RTN","RMPR29BG",18,0) S R6641=$G(^RMPR(664.1,RMIE1,0)) "RTN","RMPR29BG",19,0) S RSITE=$P(R6641,U,15),RSITE=$O(^RMPR(669.9,"C",RSITE,0)) "RTN","RMPR29BG",20,0) I RSITE'=RMPRSITE S RMPRSITE=RSITE "RTN","RMPR29BG",21,0) I RMIE16F>0 S:RMIE16'=RMIE16F RMTT=$P(^RMPR(664.1,RMIE1,2,RMIE16F,0),U,7),RMPC=$P(^(0),U,8) "RTN","RMPR29BG",22,0) I RMIE16=RMIE16F D:RMTT'=$P(^RMPR(664.1,RMIE1,2,RMIE16F,0),U,7)!(RMPC'=$P(^(0),U,8)) "RTN","RMPR29BG",23,0) . S RMIE16C="" F S RMIE16C=$O(^RMPR(664.1,RMIE1,2,RMIE16C)) Q:RMIE16C="" D "RTN","RMPR29BG",24,0) .. Q:RMIE16C=RMIE16 "RTN","RMPR29BG",25,0) .. Q:'$D(^RMPR(664.1,RMIE1,2,RMIE16C,0)) "RTN","RMPR29BG",26,0) .. S $P(^RMPR(664.1,RMIE1,2,RMIE16C,0),U,7)=RMTT "RTN","RMPR29BG",27,0) .. S $P(^RMPR(664.1,RMIE1,2,RMIE16C,0),U,8)=RMPC "RTN","RMPR29BG",28,0) I RMIE16="" S RMIE16="+1,"_RMIE1 "RTN","RMPR29BG",29,0) E S RMIE16E=RMIE16,RMIE16=RMIE16_","_RMIE1 "RTN","RMPR29BG",30,0) S RMDAT(664.16,RMIE16_",",.01)=RMITM "RTN","RMPR29BG",31,0) S RMDAT(664.16,RMIE16_",",2)=RMQTY "RTN","RMPR29BG",32,0) S RMDAT(664.16,RMIE16_",",3)=RMUI "RTN","RMPR29BG",33,0) S RMDAT(664.16,RMIE16_",",6.5)=RMBD "RTN","RMPR29BG",34,0) S RMDAT(664.16,RMIE16_",",8)=RMTT "RTN","RMPR29BG",35,0) S RMDAT(664.16,RMIE16_",",9)=RMPC "RTN","RMPR29BG",36,0) S RMDAT(664.16,RMIE16_",",12)=RMSN "RTN","RMPR29BG",37,0) S RMDAT(664.16,RMIE16_",",13)=RMHCPC "RTN","RMPR29BG",38,0) S RMDAT(664.16,RMIE16_",",13.1)=RMCPTM "RTN","RMPR29BG",39,0) S RMDAT(664.16,RMIE16_",",13.2)=RMHTECH "RTN","RMPR29BG",40,0) S RMDAT(664.16,RMIE16_",",15)=RMVEN "RTN","RMPR29BG",41,0) D UPDATE^DIE("","RMDAT","RMIEN","RMERROR") "RTN","RMPR29BG",42,0) L -^RMPR(664.1,RMIE1) "RTN","RMPR29BG",43,0) I $D(RMERROR) S RMERR=1 G ERR "RTN","RMPR29BG",44,0) S J="" "RTN","RMPR29BG",45,0) F S J=$O(RMPRTXT(J)) Q:J="" D "RTN","RMPR29BG",46,0) . S L=J+1,RMPRTXTF(L)=RMPRTXT(J) "RTN","RMPR29BG",47,0) I '$D(RMIEN(1)) S RMIEN(1)=RMIE16E "RTN","RMPR29BG",48,0) D WP^DIE(664.16,RMIEN(1)_","_RMIE1_",",7,,"RMPRTXTF","RMWPERR") "RTN","RMPR29BG",49,0) I $D(RMWPERR) S ^TMP("SPS","WP")=RMWPERR("DIERR","1","TEXT","1") "RTN","RMPR29BG",50,0) ; "RTN","RMPR29BG",51,0) S RMPRDA=RMIE1 D INF^RMPRSIT,POST^RMPR29GA "RTN","RMPR29BG",52,0) QUIT K RMAED,RMBD,RMTECH,RMDAT,RMIE16E,RMIE2,RMPRDA,RMPRTXT,RMPRTXTF,RMERROR "RTN","RMPR29BG",53,0) K RMERR,RMAED,RMPRSITE,RMIE1,RMIE16,RMIEN,RMITM,RMQTY,RMUI,RMTT,RMPC "RTN","RMPR29BG",54,0) K RMSN,RMHCPC,RMCPTM,RMVEN,RMWPERR,RMHTK "RTN","RMPR29BG",55,0) Q "RTN","RMPR29BG",56,0) ERR S RESUTLS(0)=1_RMERROR("DIERR",1,"TEXT",1) "RTN","RMPR29BG",57,0) S ^TMP("SPS",1)=1_RMERROR("DIERR",1,"TEXT",1) "RTN","RMPR29BG",58,0) G QUIT "RTN","RMPR29BG",59,0) Q "RTN","RMPR29BG",60,0) DEL ; "RTN","RMPR29BG",61,0) S DA=$P(^RMPR(664.1,RMIE1,2,RMIE16,0),U,5) "RTN","RMPR29BG",62,0) I DA'="" D "RTN","RMPR29BG",63,0) . S DIK="^RMPR(660," D ^DIK "RTN","RMPR29BG",64,0) . K DA,DIK "RTN","RMPR29BG",65,0) S DA=$P(^RMPR(664.1,RMIE1,2,RMIE16,0),U,6) "RTN","RMPR29BG",66,0) I DA'="" D "RTN","RMPR29BG",67,0) . S DIK="^RMPR(664.2," D ^DIK "RTN","RMPR29BG",68,0) . K DA,DIK "RTN","RMPR29BG",69,0) S DA(1)=RMIE1,DA=RMIE16,DIK="^RMPR(664.1,"_DA(1)_",2," D ^DIK "RTN","RMPR29BG",70,0) K DA,DIK "RTN","RMPR29BG",71,0) S RMPRDA=RMIE1 D INF^RMPRSIT,POST^RMPR29GA "RTN","RMPR29BG",72,0) L -^RMPR(664.1,RMIE1) "RTN","RMPR29BG",73,0) G QUIT "RTN","RMPR29BG",74,0) Q "RTN","RMPR29BG",75,0) EN1(RESULTS,DA) ;Broker entry to kill WO "RTN","RMPR29BG",76,0) ;DA is passed "RTN","RMPR29BG",77,0) S DIK="^RMPR(664.1," D ^DIK "RTN","RMPR29BG",78,0) K DIK "RTN","RMPR29BG",79,0) Q "RTN","RMPR29CA") 0^1^B70452524^B68273293 "RTN","RMPR29CA",1,0) RMPR29CA ;OI-HINES/HNC,SPS -WORK ORDER SUSPENSE RPC;12/27/2004 "RTN","RMPR29CA",2,0) ;;3.0;PROSTHETICS;**75,122,142**;Feb 09, 1996;Build 2 "RTN","RMPR29CA",3,0) A1(RMIE68,RMPRDUZ,RMSUSTAT,RMPR6641,RMPRTXT) ;roll and scroll entry point "RTN","RMPR29CA",4,0) G A2 "RTN","RMPR29CA",5,0) EN(RESULTS,RMIE68,RMPRDUZ,RMSUSTAT,RMPR6641,RMPRTXT) ;RPC entry point "RTN","RMPR29CA",6,0) A2 ; "RTN","RMPR29CA",7,0) S RESULTS(0)="",STP=0 "RTN","RMPR29CA",8,0) K ^TMP($J) "RTN","RMPR29CA",9,0) ; "RTN","RMPR29CA",10,0) CONT ;RMSUSTAT is status 1=complete or 0=initial note or 2=pending (incomplete) "RTN","RMPR29CA",11,0) ;3=cancel or 4=cancel and clone "RTN","RMPR29CA",12,0) S RMIE=0 "RTN","RMPR29CA",13,0) F S RMIE=$O(^RMPR(664.1,RMPR6641,2,RMIE)) Q:RMIE'>0 D Q:STP=1 "RTN","RMPR29CA",14,0) .S RMIE60=$P(^RMPR(664.1,RMPR6641,2,RMIE,0),U,5) Q:'RMIE60 "RTN","RMPR29CA",15,0) .S ^TMP($J,RMIE60)="" "RTN","RMPR29CA",16,0) .D FD "RTN","RMPR29CA",17,0) .I STP=1 Q "RTN","RMPR29CA",18,0) .D UPD "RTN","RMPR29CA",19,0) I STP=1 G EXIT "RTN","RMPR29CA",20,0) I RMSUSTAT=1 D CNOTE "RTN","RMPR29CA",21,0) I RMSUSTAT=0 D INOTE,FD "RTN","RMPR29CA",22,0) I RMSUSTAT=2 D ONOTE,FD "RTN","RMPR29CA",23,0) I RMSUSTAT=3 D CANOTE^RMPR29CB "RTN","RMPR29CA",24,0) I RMSUSTAT=4 D CANOTE^RMPR29CB "RTN","RMPR29CA",25,0) ;set status "RTN","RMPR29CA",26,0) G EXIT "RTN","RMPR29CA",27,0) CNOTE ;(#12) COMPLETION NOTE "RTN","RMPR29CA",28,0) ;set file 668 "RTN","RMPR29CA",29,0) ;^RMPR(668,D0,4,0)=^668.012^^ "RTN","RMPR29CA",30,0) ;if status is close, or 1 "RTN","RMPR29CA",31,0) ;RMPRTXT ;load into field #12 "RTN","RMPR29CA",32,0) ;^RMPR(668,D0,4,D1,0) "RTN","RMPR29CA",33,0) ; "RTN","RMPR29CA",34,0) ;Update file 664.1 on Close out "RTN","RMPR29CA",35,0) I +$P(^RMPR(664.1,RMPR6641,0),U,16)'>0 S $P(^(0),U,16)=DUZ,$P(^(7),U,1)=DT,$P(^(7),U,3)=DUZ "RTN","RMPR29CA",36,0) S DIE="^RMPR(664.1,",DA=RMPR6641 "RTN","RMPR29CA",37,0) S DR="16////^S X=""C"";22////^S X=DUZ;23///^S X=DT" D ^DIE "RTN","RMPR29CA",38,0) K DR,DA,DIE "RTN","RMPR29CA",39,0) S RMIE=0 "RTN","RMPR29CA",40,0) F S RMIE=$O(^RMPR(664.1,RMPR6641,2,RMIE)) Q:RMIE'>0 D "RTN","RMPR29CA",41,0) .S DIE="^RMPR(664.2,",DA=$P($G(^RMPR(664.1,RMPR6641,2,RMIE,0)),U,6) "RTN","RMPR29CA",42,0) .Q:DA'>0 "RTN","RMPR29CA",43,0) .S DR="8////^S X=DT;9////^S X=DUZ" D ^DIE "RTN","RMPR29CA",44,0) .K DA,DR,DIE "RTN","RMPR29CA",45,0) .S DIE="^RMPR(660,",DA=$P($G(^RMPR(664.1,RMPR6641,2,RMIE,0)),U,5) "RTN","RMPR29CA",46,0) .Q:DA'>0 "RTN","RMPR29CA",47,0) .S DR="8.4////^S X=DT;10////^S X=DT;50////^S X=DT" D ^DIE "RTN","RMPR29CA",48,0) .K DA,DR,DIE "RTN","RMPR29CA",49,0) S DA=RMIE68 "RTN","RMPR29CA",50,0) D NOW^%DTC S RMPREODT=%,GMRCAD=% "RTN","RMPR29CA",51,0) S DIE="^RMPR(668," "RTN","RMPR29CA",52,0) S DR="5////^S X=RMPREODT;6////^S X=DUZ;14///^S X=""C""" D ^DIE "RTN","RMPR29CA",53,0) N RMPRC "RTN","RMPR29CA",54,0) S L="",LN=0 "RTN","RMPR29CA",55,0) F S L=$O(RMPRTXT(L)) Q:L="" D "RTN","RMPR29CA",56,0) . I 'LN D Q:RMPRC="" ;strip leading space from 1st line, ignore blank line "RTN","RMPR29CA",57,0) .. S RMPRC=$E($TR(RMPRTXT(L)," ","")) ;1st non space char "RTN","RMPR29CA",58,0) .. S:RMPRC'="" RMPRTXT(L)=$E(RMPRTXT(L),$F(RMPRTXT(L),RMPRC)-1,$L(RMPRTXT(L))) ;extract from 1st non space char to end of line "RTN","RMPR29CA",59,0) .. Q "RTN","RMPR29CA",60,0) . S LN=LN+1,^RMPR(668,RMIE68,4,LN,0)=RMPRTXT(L) "RTN","RMPR29CA",61,0) . Q "RTN","RMPR29CA",62,0) S $P(^RMPR(668,RMIE68,4,0),"^",3)=LN "RTN","RMPR29CA",63,0) K L,LN "RTN","RMPR29CA",64,0) ;S DA=RMIE68,DIK="^RMPR(668," D IX1^DIK "RTN","RMPR29CA",65,0) I '$P(^RMPR(668,DA,0),U,9) D "RTN","RMPR29CA",66,0) .S DIE="^RMPR(668," "RTN","RMPR29CA",67,0) .S DR="7///^S X=""See Completion Note for Initial Action Taken.""" "RTN","RMPR29CA",68,0) .D ^DIE "RTN","RMPR29CA",69,0) .S DR="10////^S X=RMPREODT;16////^S X=DUZ" D ^DIE "RTN","RMPR29CA",70,0) K RMPREODT "RTN","RMPR29CA",71,0) S GMRCO=$P(^RMPR(668,RMIE68,0),U,15) "RTN","RMPR29CA",72,0) I GMRCO="" S RESULTS(0)="0^Completed Manual Suspense Action. Suspense status has been updated to CLOSED." Q "RTN","RMPR29CA",73,0) S RMPRCOM=0 "RTN","RMPR29CA",74,0) F S RMPRCOM=$O(^RMPR(668,RMIE68,4,RMPRCOM)) Q:RMPRCOM="" D "RTN","RMPR29CA",75,0) .S GMRCOM(RMPRCOM)=^RMPR(668,RMIE68,4,RMPRCOM,0) "RTN","RMPR29CA",76,0) I $G(GMRCOM)="" S GMRCOM="Not Noted" "RTN","RMPR29CA",77,0) S GMRCSF="U" "RTN","RMPR29CA",78,0) S GMRCA=10 "RTN","RMPR29CA",79,0) S GMRCALF="N" "RTN","RMPR29CA",80,0) S GMRCATO="" "RTN","RMPR29CA",81,0) S (GMRCORNP,GMRCDUZ)=DUZ "RTN","RMPR29CA",82,0) S BDC=$$SFILE^GMRCGUIB(.GMRCO,.GMRCA,.GMRCSF,.GMRCORNP,.GMRCDUZ,.GMRCOM,.GMRCALF,.GMRCATO,.GMRCAD) "RTN","RMPR29CA",83,0) I +BDC=1 S RESULTS(0)=1_"^"_$P(BDC,U,2) "RTN","RMPR29CA",84,0) K GMRCO,GMRCA,GMRCSF,GMRCORNP,GMRCDUZ,GMRCOM,GMRCALF,GMRCATO,GMRCAD "RTN","RMPR29CA",85,0) I RESULTS(0)="" S RESULTS(0)="0^Completed Suspense Action, and Posted note to CPRS Consult. Suspense status has been updated to CLOSED." "RTN","RMPR29CA",86,0) Q "RTN","RMPR29CA",87,0) ONOTE ;Other note "RTN","RMPR29CA",88,0) ;set file 668 "RTN","RMPR29CA",89,0) ;^RMPR(668,D0,4,0)=^668.012^^ "RTN","RMPR29CA",90,0) ;if status is pending, and already initial action note or 0 "RTN","RMPR29CA",91,0) ;^RMPR(668,D0,1,D1,0)= (#.01) ACTION DATE [1D] "RTN","RMPR29CA",92,0) ;RMPRTXT ;load into field #11, #1 "RTN","RMPR29CA",93,0) ;^RMPR(668,D0,1,D1,1,0)=^668.111^^ "RTN","RMPR29CA",94,0) ; "RTN","RMPR29CA",95,0) S RMPRDA1=RMIE68,DA(1)=RMIE68,DA=RMIE68 "RTN","RMPR29CA",96,0) D NOW^%DTC S X=%,GMRCWHN=% "RTN","RMPR29CA",97,0) S DIC="^RMPR(668,"_RMIE68_",1," "RTN","RMPR29CA",98,0) S DIC(0)="CQL" "RTN","RMPR29CA",99,0) S DIC("P")="668.011DA" "RTN","RMPR29CA",100,0) S DLAYGO=668 "RTN","RMPR29CA",101,0) D ^DIC "RTN","RMPR29CA",102,0) I Y=-1 S RESULTS(0)="1^Error Modifying Record!" Q "RTN","RMPR29CA",103,0) S (DA,RMPRDA2)=+Y "RTN","RMPR29CA",104,0) K DIE,DR,Y "RTN","RMPR29CA",105,0) N RMPRC "RTN","RMPR29CA",106,0) S L="",LN=0 "RTN","RMPR29CA",107,0) F S L=$O(RMPRTXT(L)) Q:L="" D "RTN","RMPR29CA",108,0) . I 'LN D Q:RMPRC="" ;strip leading space from 1st line, ignore blank line "RTN","RMPR29CA",109,0) .. S RMPRC=$E($TR(RMPRTXT(L)," ","")) ;1st non space char "RTN","RMPR29CA",110,0) .. S:RMPRC'="" RMPRTXT(L)=$E(RMPRTXT(L),$F(RMPRTXT(L),RMPRC)-1,$L(RMPRTXT(L))) ;extract from 1st non space char to end of line "RTN","RMPR29CA",111,0) .. Q "RTN","RMPR29CA",112,0) . S LN=LN+1,^RMPR(668,RMIE68,1,RMPRDA2,1,LN,0)=RMPRTXT(L) "RTN","RMPR29CA",113,0) . Q "RTN","RMPR29CA",114,0) S $P(^RMPR(668,RMIE68,1,RMPRDA2,1,0),"^",3)=LN "RTN","RMPR29CA",115,0) K L,LN "RTN","RMPR29CA",116,0) S GMRCO=$P(^RMPR(668,RMIE68,0),U,15) "RTN","RMPR29CA",117,0) I GMRCO="" S RESULTS(0)="0^Completed Manual Suspense Action. Suspense status has not changed." Q "RTN","RMPR29CA",118,0) S RMPRCOM=0 "RTN","RMPR29CA",119,0) F S RMPRCOM=$O(^RMPR(668,RMIE68,1,RMPRDA2,1,RMPRCOM)) Q:RMPRCOM="" D "RTN","RMPR29CA",120,0) .S GMRCOM(RMPRCOM)=^RMPR(668,RMIE68,1,RMPRDA2,1,RMPRCOM,0) "RTN","RMPR29CA",121,0) D CMT^GMRCGUIB(.GMRCO,.GMRCOM,"",GMRCWHN,DUZ) "RTN","RMPR29CA",122,0) K DA,RMPRDA1,RMPRDA2,RMPRCOM,GMRCOM,GMRCO,GMRCWHN "RTN","RMPR29CA",123,0) S RESULTS(0)="0^Completed Suspense Action, and Posted note to CPRS Consult. Suspense status has not changed." "RTN","RMPR29CA",124,0) Q "RTN","RMPR29CA",125,0) INOTE ;initial action note "RTN","RMPR29CA",126,0) ;set file 668 "RTN","RMPR29CA",127,0) ;^RMPR(668,D0,3,0)=^668.07^^ "RTN","RMPR29CA",128,0) ;if status is pending, or 0 "RTN","RMPR29CA",129,0) ;RMPRTXT ;load into field #7 "RTN","RMPR29CA",130,0) ;^RMPR(668,D0,3,0)=^668.07^^ "RTN","RMPR29CA",131,0) ; "RTN","RMPR29CA",132,0) I $D(^RMPR(668,RMIE68,3,1,0)) S RESULTS(0)="1^Initial Action Note Already Posted!" Q "RTN","RMPR29CA",133,0) D NOW^%DTC S RMPREODT=% "RTN","RMPR29CA",134,0) N RMPRC "RTN","RMPR29CA",135,0) S ^RMPR(668,RMIE68,3,0)="^^^"_DT_"^" "RTN","RMPR29CA",136,0) S L="",LN=0 "RTN","RMPR29CA",137,0) F S L=$O(RMPRTXT(L)) Q:L="" D "RTN","RMPR29CA",138,0) . I 'LN D Q:RMPRC="" ;strip leading space from 1st line, ignore blank line "RTN","RMPR29CA",139,0) .. S RMPRC=$E($TR(RMPRTXT(L)," ","")) ;1st non space char "RTN","RMPR29CA",140,0) .. S:RMPRC'="" RMPRTXT(L)=$E(RMPRTXT(L),$F(RMPRTXT(L),RMPRC)-1,$L(RMPRTXT(L))) ;extract from 1st non space char to end of line "RTN","RMPR29CA",141,0) .. Q "RTN","RMPR29CA",142,0) . S LN=LN+1,^RMPR(668,RMIE68,3,LN,0)=RMPRTXT(L) "RTN","RMPR29CA",143,0) . Q "RTN","RMPR29CA",144,0) S $P(^RMPR(668,RMIE68,3,0),"^",3)=LN "RTN","RMPR29CA",145,0) K L,LN "RTN","RMPR29CA",146,0) S DIE="^RMPR(668," "RTN","RMPR29CA",147,0) S DA=RMIE68 "RTN","RMPR29CA",148,0) S DR="10////^S X=RMPREODT;16////^S X=DUZ;14///^S X=""P""" "RTN","RMPR29CA",149,0) D ^DIE "RTN","RMPR29CA",150,0) S GMRCO=$P(^RMPR(668,RMIE68,0),U,15) "RTN","RMPR29CA",151,0) I GMRCO="" S RESULTS(0)="0^Completed Manual Suspense Action. Suspense status has been updated to PENDING" Q "RTN","RMPR29CA",152,0) S RMPRCMT=0 "RTN","RMPR29CA",153,0) F S RMPRCMT=$O(^RMPR(668,RMIE68,3,RMPRCMT)) Q:RMPRCMT="" D "RTN","RMPR29CA",154,0) .S GMRCMT(RMPRCMT)=^RMPR(668,RMIE68,3,RMPRCMT,0) "RTN","RMPR29CA",155,0) D CMT^GMRCGUIB(GMRCO,.GMRCMT,DUZ,RMPREODT,DUZ) "RTN","RMPR29CA",156,0) K RMPREODT,GMRCO,RMGMRCO,GMRCMT,RMPRCMT "RTN","RMPR29CA",157,0) S RESULTS(0)="0^Completed Suspense Action, and Posted note to CPRS Consult. Suspense status has changed to PENDING." "RTN","RMPR29CA",158,0) Q "RTN","RMPR29CA",159,0) ; "RTN","RMPR29CA",160,0) FD ;file date "RTN","RMPR29CA",161,0) N DIE,DIC,I,J,Y,RMDFN,RMI,RMDATE,RM680,RM6810,RMERROR,RM60L,RC "RTN","RMPR29CA",162,0) N RMERR,RMCHK,DLAYGO,X,DR,RM668,RM60DAT,RMSTATUS "RTN","RMPR29CA",163,0) N RM68CNT,RM60CNT,RMREQU,RMSI,RMSAMIS,RM68IEN,RM60IEN,RMSUS60,RMSUS68,RMD "RTN","RMPR29CA",164,0) N RM68DATA,RM60TYP,RM68D,RM68TRAN,RMPRPRC,RM60IT,RMENTSUS,RMQUIT "RTN","RMPR29CA",165,0) ; "RTN","RMPR29CA",166,0) S RMERR=0 "RTN","RMPR29CA",167,0) S:RMSUSTAT="" RMSUSTAT=0 "RTN","RMPR29CA",168,0) L +^RMPR(660,RMIE60):2 "RTN","RMPR29CA",169,0) I $T=0 S RESULTS(0)="1^Someone else is Editing this entry! If this problem persists contact your IRM to clear the Lock Table",STP=1 Q "RTN","RMPR29CA",170,0) S RM680=$G(^RMPR(668,RMIE68,0)) "RTN","RMPR29CA",171,0) S RM688=$G(^RMPR(668,RMIE68,8)) "RTN","RMPR29CA",172,0) S RM6810=$G(^RMPR(668,RMIE68,10)) "RTN","RMPR29CA",173,0) S RMAMIS=$P($G(^RMPR(660,RMIE60,"AMS")),U,1) "RTN","RMPR29CA",174,0) ;code here for 668 fields "RTN","RMPR29CA",175,0) S RMDATE=$P(RM680,U,1) "RTN","RMPR29CA",176,0) S RMCODT=$P(RM680,U,5) "RTN","RMPR29CA",177,0) S RMINDT=$P(RM680,U,9) "RTN","RMPR29CA",178,0) S RMPRCO=$P(RM680,U,15) "RTN","RMPR29CA",179,0) S RMDWRT=$P(RM680,U,16) "RTN","RMPR29CA",180,0) S RMSTAT=$P(RM680,U,7) "RTN","RMPR29CA",181,0) S RMTRES=$P(RM680,U,8) "RTN","RMPR29CA",182,0) S RMTYRE=$S(RMTRES=1:"ROUTINE",RMTRES=2:"EYEGLASS",RMTRES=3:"CONTACT LENS",RMTRES=4:"OXYGEN",RMTRES=5:"MANUAL",RMTRES=11:"LAB",1:"") "RTN","RMPR29CA",183,0) S RMREQU=$P(RM680,U,11) "RTN","RMPR29CA",184,0) S RMSERV="" "RTN","RMPR29CA",185,0) I $G(RMREQU) D GETS^DIQ(200,RMREQU,"29","E","RMAA") S RMSERV=RMAA(200,RMREQU_",",29,"E") "RTN","RMPR29CA",186,0) S RMPRDI=$E($P(RM688,U,2),1,16) "RTN","RMPR29CA",187,0) S RMICD9=$P(RM688,U,3) "RTN","RMPR29CA",188,0) ; "RTN","RMPR29CA",189,0) S RMDAT(660,RMIE60_",",8.1)=RMDATE "RTN","RMPR29CA",190,0) S RMDAT(660,RMIE60_",",8.2)=RMDWRT "RTN","RMPR29CA",191,0) S RMDAT(660,RMIE60_",",8.3)=RMINDT "RTN","RMPR29CA",192,0) S RMDAT(660,RMIE60_",",8.4)=RMCODT "RTN","RMPR29CA",193,0) S RMDAT(660,RMIE60_",",8.5)=RMTYRE "RTN","RMPR29CA",194,0) S RMDAT(660,RMIE60_",",8.6)=RMREQU "RTN","RMPR29CA",195,0) S RMDAT(660,RMIE60_",",8.61)=RMSERV "RTN","RMPR29CA",196,0) S RMDAT(660,RMIE60_",",8.7)=RMPRDI "RTN","RMPR29CA",197,0) S RMDAT(660,RMIE60_",",8.8)=RMICD9 "RTN","RMPR29CA",198,0) S RMDAT(660,RMIE60_",",8.9)=RMPRCO "RTN","RMPR29CA",199,0) S RMDAT(660,RMIE60_",",8.11)=RMSTAT "RTN","RMPR29CA",200,0) I RMSUSTAT=2 S RMDAT(660,RMIE60_",",8.14)=0 "RTN","RMPR29CA",201,0) I RMSUSTAT'=2 S RMDAT(660,RMIE60_",",8.14)=RMSUSTAT "RTN","RMPR29CA",202,0) D FILE^DIE("","RMDAT","RMERROR") "RTN","RMPR29CA",203,0) L -^RMPR(660,RMIE60) "RTN","RMPR29CA",204,0) I $D(RMERROR) S RMERR=1,STP=1 G ERR "RTN","RMPR29CA",205,0) ; "RTN","RMPR29CA",206,0) Q "RTN","RMPR29CA",207,0) UPD ;update file 668 with 2319 records "RTN","RMPR29CA",208,0) K DD,DO "RTN","RMPR29CA",209,0) S DA(1)=RMIE68 "RTN","RMPR29CA",210,0) S DIC="^RMPR(668,"_DA(1)_","_"10," "RTN","RMPR29CA",211,0) S DIC(0)="L",DLAYGO=668,X=RMIE60 "RTN","RMPR29CA",212,0) D FILE^DICN "RTN","RMPR29CA",213,0) K X,DD,DO "RTN","RMPR29CA",214,0) S DA(1)=RMIE68 "RTN","RMPR29CA",215,0) S DIC="^RMPR(668,"_DA(1)_","_"11," "RTN","RMPR29CA",216,0) S X=RMAMIS "RTN","RMPR29CA",217,0) D FILE^DICN "RTN","RMPR29CA",218,0) K DIC,X,DLAYGO,DO "RTN","RMPR29CA",219,0) Q "RTN","RMPR29CA",220,0) A3 G A4 "RTN","RMPR29CA",221,0) EN1(RESULTS,DA) ;Broker entry to kill WO "RTN","RMPR29CA",222,0) ;DA is passed "RTN","RMPR29CA",223,0) S DIK="^RMPR(664.1," D ^DIK "RTN","RMPR29CA",224,0) K DIK "RTN","RMPR29CA",225,0) A4 ; "RTN","RMPR29CA",226,0) Q "RTN","RMPR29CA",227,0) ERR ;exit on error "RTN","RMPR29CA",228,0) S RESULTS(0)="1^ERROR WAS "_RMERROR("DIERR",1,"TEXT",1) "RTN","RMPR29CA",229,0) EXIT ; "RTN","RMPR29CA",230,0) K %,BDC,RM688,RMAA,RMAMIS,RMCODT,RMDAT,RMDWRT,RMICD9,RMIE,RMIE60,RMINDT "RTN","RMPR29CA",231,0) K RMPRCO,RMPRDI,RMSERV,RMSTAT,RMTRES,RMTYRE,STP "RTN","RMPR29CA",232,0) Q "RTN","RMPR29GA") 0^5^B28760981^B28442542 "RTN","RMPR29GA",1,0) RMPR29GA ;PHX/JLT,RVD,SPS-RMPR29 CONTINUED [ 09/29/94 11:22 AM ] "RTN","RMPR29GA",2,0) ;;3.0;PROSTHETICS;**75,60,142**;Feb 09, 1996;Build 2 "RTN","RMPR29GA",3,0) ; Developed form RMPR29A for the GUI application "RTN","RMPR29GA",4,0) POST ;POST 2529-3 TO APPLIANCE/REPAIR FILE #660 "RTN","RMPR29GA",5,0) I '$D(RMPRDA)!('$D(^RMPR(664.1,RMPRDA,2,0))) Q "RTN","RMPR29GA",6,0) S NOAC=$P(^RMPR(664.1,RMPRDA,0),U,23),NOLC=$P(^(0),U,20),RMPR("REF")=$P(^(0),U,4),RMPRG=$P(^(0),U,14) "RTN","RMPR29GA",7,0) I NOLC=1 S RMHRWO=$P(^RMPR(664.1,RMPRDA,0),U,13) "RTN","RMPR29GA",8,0) I RMPRG G GGC "RTN","RMPR29GA",9,0) L +^RMPR(669.9,RMPRSITE,0):999 I $T=0 S RMPRG=DT_99 G GGC "RTN","RMPR29GA",10,0) S RMPRG=$P(^RMPR(669.9,RMPRSITE,0),U,7),RMPRG=RMPRG-1,$P(^RMPR(669.9,RMPRSITE,0),U,7)=RMPRG L -^RMPR(669.9,RMPRSITE,0) "RTN","RMPR29GA",11,0) GGC I 'NOAC W !!,?5,"Updating Patient's 10-2319" "RTN","RMPR29GA",12,0) S RMPRDT=$P(^RMPR(664.1,RMPRDA,0),U,1),RMPRDFN=$P(^(0),U,2),SRC=$P(^(0),U,11),TO=$P(^(0),U,15) K RNEW "RTN","RMPR29GA",13,0) F RA=0:0 S RA=$O(^RMPR(664.1,RMPRDA,2,RA)) Q:RA'>0 I $D(^(RA,0)) S IT=$P(^(0),U,1),QTY=$P(^(0),U,2),UN=$P(^(0),U,3),RDA=$P(^(0),U,5),TYP=$P(^(0),U,7),ELS=$P(^(0),U,8),SCAT=$P(^(0),U,9),SER=$P(^(0),U,12) D "RTN","RMPR29GA",14,0) .S HCPCS=$P($G(^RMPR(664.1,RMPRDA,2,RA,2)),U,1),RMCPT=$P($G(^(2)),U,2),RMHTECH=$P($G(^(2)),U,3) "RTN","RMPR29GA",15,0) .;Changed .01 and 1 fields to create date DT below 5/25/06 for 75 SPS "RTN","RMPR29GA",16,0) .I RDA,'$D(^RMPR(660,RDA,0)) S RDA="" "RTN","RMPR29GA",17,0) .I 'RDA S DIC="^RMPR(660,",DLAYGO=660,DIC(0)="LZ",X=DT D FILE^DICN K DLAYGO Q:+Y'>0 S RDA=+Y,RNEW=$P(Y,U,3) S $P(^RMPR(660,RDA,0),U,1)=DT,$P(^(0),U,2)=RMPRDFN,$P(^(0),U,3)=DT "RTN","RMPR29GA",18,0) DR .K DR "RTN","RMPR29GA",19,0) .S DR="2///^S X=TYP;4.5////^S X=$G(HCPCS);5///^S X=QTY;9///^S X=SER;78///^S X=UN;8////^S X=RMPR(""STA"");11///^S X=4;62///^S X=ELS;63///^S X=SCAT;68///^S X=RMPRG;4.1////^S X=$P(^RMPR(661.1,HCPCS,0),U,4);4.7////^S X=RMCPT;4.92////^S X=RMHTECH" "RTN","RMPR29GA",20,0) .S DIE="^RMPR(660,",DA=RDA D ^DIE S RIT=$P(^RMPR(660,RDA,0),U,6) K ^RMPR(660,"AD",+RIT,RDA) "RTN","RMPR29GA",21,0) .;Set OIF/OEF field "RTN","RMPR29GA",22,0) .S DFN=RMPRDFN D SVC^VADPT "RTN","RMPR29GA",23,0) .S RMPROEOI=$S(VASV(11)>0:"",VASV(12)>0:"",VASV(13)>0:"",1:0) "RTN","RMPR29GA",24,0) .I RMPROEOI="" S $P(^RMPR(660,RDA,5),U,1)=1 "RTN","RMPR29GA",25,0) .S $P(^RMPR(660,RDA,0),U,6)=IT "RTN","RMPR29GA",26,0) .I $P(^RMPR(660,RDA,0),U,27)="" S $P(^(0),U,27)=DUZ "RTN","RMPR29GA",27,0) .S $P(^RMPR(660,RDA,"LB"),U,1)=RMPR("REF"),$P(^("LB"),U,3)=SRC,$P(^("LB"),U,4)=TO,$P(^("LB"),U,14)=NOLC,$P(^RMPR(660,RDA,"AM"),U,2)=NOAC "RTN","RMPR29GA",28,0) .I NOLC=1 S $P(^RMPR(660,RDA,"LB"),U,2)=RMHRWO "RTN","RMPR29GA",29,0) .I $D(^RMPR(664.1,RMPRDA,2,RA,1)),$O(^RMPR(664.1,RMPRDA,2,RA,1,0)) D "RTN","RMPR29GA",30,0) ..K ^RMPR(660,RDA,"DES") F RW=0:0 S RW=$O(^RMPR(664.1,RMPRDA,2,RA,1,RW)) Q:RW'>0 S RN=RW S ^RMPR(660,RDA,"DES",RW,0)=^RMPR(664.1,RMPRDA,2,RA,1,RW,0) "RTN","RMPR29GA",31,0) .I $D(RN) S ^RMPR(660,RDA,"DES",0)="^660.028^"_RN_U_RN_U_DT_"^^" "RTN","RMPR29GA",32,0) .S DIK="^RMPR(660,",DA=RDA D:'$D(RNEW) IX^DIK D:$D(RNEW) IX1^DIK K RNEW "RTN","RMPR29GA",33,0) .S $P(^RMPR(664.1,RMPRDA,2,RA,0),U,5)=RDA S $P(^RMPR(660,DA,"LB"),U,10)=RMPRDA,$P(^RMPR(660,DA,0),U,14)="V" S $P(^RMPR(664.1,RMPRDA,0),U,14)=RMPRG "RTN","RMPR29GA",34,0) S DA=RMPRDA,DIK="^RMPR(664.1," D IX^DIK I $P(^RMPR(664.1,RMPRDA,0),U,15)=RMPR("STA") D EN4^RMPR29U(RMPRDA) "RTN","RMPR29GA",35,0) Q "RTN","RMPR29GA",36,0) END L:+$G(RMPRDA) -^RMPR(664.1,+RMPRDA,0) K ^UTILITY("DIQ1",$J) "RTN","RMPR29GA",37,0) W !! S DIR(0)="Y",DIR("B")="YES",DIR("A")="Would you like to Process another 2529-3" D ^DIR G:+Y=1 PRC^RMPR29S "RTN","RMPR29GA",38,0) N RMPR,RMPRSITE D KILL^XUSCLEAN Q "RTN","RMPR29GA",39,0) ITM ;EDIT 2529-3 ITEM "RTN","RMPR29GA",40,0) W ! K DIC,Y,RDA S DA=RMPRDA,DIC="^RMPR(664.1,"_RMPRDA_",2,",DIC("P")="664.16PA",DA(1)=RMPRDA,DIC(0)="AEQML",DIC("W")="S RA=$P(^(0),U,1) W ?16,$$ITM^RMPR31U(RA)" D ^DIC G:+Y'>0 PT "RTN","RMPR29GA",41,0) S (IEN,DA)=+Y,RNEW=$P(Y,U,3) S RY=$P(Y,U,2) D ITA^RMPR29U(RY) "RTN","RMPR29GA",42,0) S RDA(+Y)=^RMPR(664.1,RMPRDA,2,+Y,0) K RMPRPU I $P(RDA(IEN),U,5),$D(^RMPR(664.2,"AF",$P(RDA(IEN),U,5))) W $C(7),!!,?5,"A 2421 HAS BEEN INITIATED FOR THIS ITEM" S RMPRPU=1 "RTN","RMPR29GA",43,0) I $P(RDA(IEN),U,5),$D(^RMPR(664.2,"AR4",$P(RDA(IEN),U,5))) W $C(7),!!,?5,"A 2529-3 HAS BEEN INITIATED FOR THIS ITEM" S RMPRPU=1 "RTN","RMPR29GA",44,0) S DIE=DIC,DR=$S($D(RMPRPU):"",1:".01R") "RTN","RMPR29GA",45,0) S DR=DR_";8R;S RMTYPE=$P(^RMPR(664.1,RMPRDA,2,DA,0),U,7);9R;13;2R;3R;7;12" "RTN","RMPR29GA",46,0) D ^DIE I $D(DA),'$D(Y(0)) S RY=$P(^RMPR(664.1,DA(1),2,DA,0),U) D ITA^RMPR29U(RY) "RTN","RMPR29GA",47,0) I $D(DA),^RMPR(664.1,DA(1),2,DA,0)'=RDA(DA) S REDIT=1,RDATA=RMTYPE_"^"_RMPRDA_"^"_DA D CHKCPT^RMPR29U(RDATA) K RDATA,RMTYPE,RMCPT "RTN","RMPR29GA",48,0) I $D(DA) I $P(^RMPR(664.1,DA(1),2,DA,0),U)=""!($P(^(0),U,2)="")!($P(^(0),U,3)="")!($P(^(0),U,7)="")!($P(^(0),U,8)="") S DIK=DIE D ^DIK D "RTN","RMPR29GA",49,0) .K DA W !!,?5,$C(7),"ITEM INFORMATION IS MISSING",!!,?5,"Deleted..." "RTN","RMPR29GA",50,0) I '$D(DA) S DA=$P(RDA(IEN),U,5),DIK="^RMPR(660," I +DA D ^DIK S DA=$O(^RMPR(664.2,"C",+$P(RDA(IEN),U,5),0)) I +DA S DIK="^RMPR(664.2," D ^DIK D "RTN","RMPR29GA",51,0) .F DA=0:0 S DA=$O(^RMPR(664.3,"C",$P(RDA(IEN),U,5),DA)) Q:DA'>0 S DIK="^RMPR(664.3," D ^DIK "RTN","RMPR29GA",52,0) K FLGG,DR,Y I $P($G(^RMPR(664.1,RMPRDA,2,0)),U,3)=""!($P($G(^(0)),U,4)="") D "RTN","RMPR29GA",53,0) .W !!,$C(7),?5,"2529-3 HAS BEEN RETURNED CANCELLED" S DIE="^RMPR(664.1,",DA=RMPRDA,DR="19///@;.09///@;15///@;16///^S X=""CA""" D ^DIE S $P(^RMPR(664.1,DA,0),U,20)="",FLGG=1 "RTN","RMPR29GA",54,0) K DR S RDC=$G(^RMPR(664.1,RMPRDA,2,IEN,0)) I (+RDC'=+RDA(IEN)),'RNEW D I $D(FLGG) G END "RTN","RMPR29GA",55,0) .D NOW^%DTC S (NX,X)=% K % "RTN","RMPR29GA",56,0) .S DIC("P")="664.129DA",DA(1)=RMPRDA "RTN","RMPR29GA",57,0) .S DIC="^RMPR(664.1,"_RMPRDA_",8,",DIC(0)="LZ" "RTN","RMPR29GA",58,0) .S DLAYGO=664.1 D FILE^DICN K DLAYGO "RTN","RMPR29GA",59,0) .I +Y S DIE="^RMPR(664.1,"_RMPRDA_",8,",DA(1)=RMPRDA,DA=+Y,DR=".01///^S X=NX;1///^S X=$$ITM^RMPR31U(+RDA(IEN));2///^S X=$$ITM^RMPR31U(+RDC);3////^S X=DUZ;W $C(7),!!,?5,""ITEM/JOB HAS BEEN CHANGED OR DELETED"";4~AUDIT REMARKS" D ^DIE "RTN","RMPR29GA",60,0) G ITM "RTN","RMPR29GA",61,0) PT D:$D(REDIT) POST K DA,DR,REDIT G DISP^RMPR29D "RTN","RMPR29GA",62,0) Q "RTN","RMPR29GA",63,0) K DIE,DIK,DIR,ELS,HCPCS,IEN,IT,NOAC,NOLC,NX,QTY,RA,RDC,RIT,RMHRWO "RTN","RMPR29GA",64,0) K RMHTECH,RMPRDA,RMPRDFN,RMPRDT,RMPRG,RN,RW,RY,SCAT,SER,SRC,TO,TYP,UN,X "RTN","RMPRPCEB") 0^2^B22025437^B21783607 "RTN","RMPRPCEB",1,0) RMPRPCEB ;HIN/RVD-PROS PCE BACKGROUND UTILITY ; 1/23/04 8:09am "RTN","RMPRPCEB",2,0) ;;3.0;PROSTHETICS;**62,69,77,82,78,114,120,133,142**;Feb 09, 1996;Build 2 "RTN","RMPRPCEB",3,0) ; "RTN","RMPRPCEB",4,0) ;RVD patch #69 - add STATION in the error message. "RTN","RMPRPCEB",5,0) ; QUIT if no data in specified date range. "RTN","RMPRPCEB",6,0) ;RVD patch #77 - only create 1 PCE entry for the same pt & same day. "RTN","RMPRPCEB",7,0) ; "RTN","RMPRPCEB",8,0) ;KAM Patch #82 06/21/2004 - Add more robust text to 'Missing "RTN","RMPRPCEB",9,0) ; Prosthetics Clinic PCE error message "RTN","RMPRPCEB",10,0) ; "RTN","RMPRPCEB",11,0) ;WLC Patch #78 02/03/3005 - added NEW statement for error message "RTN","RMPRPCEB",12,0) ; variables defined for Patch 82. "RTN","RMPRPCEB",13,0) ; "RTN","RMPRPCEB",14,0) W !,"Invalid Entry Point.....",! "RTN","RMPRPCEB",15,0) Q "RTN","RMPRPCEB",16,0) TASK ;entry point for task job to send pros encounters to PCE. "RTN","RMPRPCEB",17,0) N RERRMSG,RERRMSG2 ; correction for patch 82 02/03/05 WLC "RTN","RMPRPCEB",18,0) S IO=0,RMAIL=1,SVDUZ=DUZ,DUZ=.5 "RTN","RMPRPCEB",19,0) S Y=DT D DD^%DT S RMRDAT=Y K RMX,RMXMT,^TMP($J) "RTN","RMPRPCEB",20,0) D NOW^%DTC S RMSTDT=% "RTN","RMPRPCEB",21,0) S X="T-90" D ^%DT S RM90DAY=Y "RTN","RMPRPCEB",22,0) S RMBIEN=$O(^RMPR(660,"B",RM90DAY)) "RTN","RMPRPCEB",23,0) Q:RMBIEN="" "RTN","RMPRPCEB",24,0) S (RMENDT,RFLDAT)=0 "RTN","RMPRPCEB",25,0) F RS=0:0 S RS=$O(^RMPR(669.9,RS)) Q:RS'>0 D PCEFLG "RTN","RMPRPCEB",26,0) S RI=$O(^RMPR(660,"B",RMBIEN,0))-1 ;starts at proper ien RMPR*120 "RTN","RMPRPCEB",27,0) F S RI=$O(^RMPR(660,RI)) Q:RI'>0 D "RTN","RMPRPCEB",28,0) .S RM600=$G(^RMPR(660,RI,0)) "RTN","RMPRPCEB",29,0) .I $P(RM600,U,2)="" Q "RTN","RMPRPCEB",30,0) .S RM611=$G(^RMPR(660,RI,1)) "RTN","RMPRPCEB",31,0) .S RM610=$G(^RMPR(660,RI,10)) "RTN","RMPRPCEB",32,0) .Q:$P(RM600,U,15) "RTN","RMPRPCEB",33,0) .Q:$P(RM600,U,17) "RTN","RMPRPCEB",34,0) .Q:'$P(RM610,U,8) "RTN","RMPRPCEB",35,0) .S RMSTA=$P(RM600,U,10) "RTN","RMPRPCEB",36,0) .;quit if already been processed. "RTN","RMPRPCEB",37,0) .Q:$P(RM610,U,12) "RTN","RMPRPCEB",38,0) .Q:(RMSTA="")!('$D(RSTAFLG(RMSTA))) "RTN","RMPRPCEB",39,0) .Q:'$P(RM611,U,4)!'$P(RM600,U,22) "RTN","RMPRPCEB",40,0) .S RMDATE=$P(RM600,U,1),RMDFN=$P(RM600,U,2) "RTN","RMPRPCEB",41,0) .S RMICD9=$P(RM610,U,8) I RMICD9'="" Q:$P($G(^ICD9(RMICD9,0)),U,9) ;quit if DX code inactive RMPR*120 "RTN","RMPRPCEB",42,0) .Q:$D(^TMP($J,RMSTA,RMDATE,RMDFN)) "RTN","RMPRPCEB",43,0) .S RMPROCF=0 "RTN","RMPRPCEB",44,0) .F J=0:0 S J=$O(^RMPR(660,"C",RMDFN,J)) Q:J'>0 D "RTN","RMPRPCEB",45,0) ..S RMJ60=$G(^RMPR(660,J,0)),RMJDT=$P(RMJ60,U,1),RMJST=$P(RMJ60,U,10) "RTN","RMPRPCEB",46,0) ..Q:(RMJST'=RMSTA)!(RMJDT'=RMDATE) "RTN","RMPRPCEB",47,0) ..S RMJ610=$G(^RMPR(660,J,10)),RMJ12=$P(RMJ610,U,12) "RTN","RMPRPCEB",48,0) ..I $G(RMJ12) S RMPROCF=1 "RTN","RMPRPCEB",49,0) .;don't process if PCE data was process for the same day. "RTN","RMPRPCEB",50,0) .Q:$G(RMPROCF) "RTN","RMPRPCEB",51,0) .S ^TMP($J,RMSTA,RMDATE,RMDFN,RI)="" "RTN","RMPRPCEB",52,0) ; "RTN","RMPRPCEB",53,0) D PROC "RTN","RMPRPCEB",54,0) I '$D(^TMP($J,"RMPRERR")) D "RTN","RMPRPCEB",55,0) .S ^TMP($J,"RMPR",5)="***** NO ERROR TO REPORT !!!!!" "RTN","RMPRPCEB",56,0) S RMSUBI=4 D BUILD D:$D(^XMB(3.8,"B","RMPR PCE")) MES1,MES2 "RTN","RMPRPCEB",57,0) G EXIT "RTN","RMPRPCEB",58,0) ; "RTN","RMPRPCEB",59,0) PCEFLG ; "RTN","RMPRPCEB",60,0) S:$D(^RMPR(669.9,RS,"PCE")) RFLDAT=$P($G(^RMPR(669.9,RS,"PCE")),U,2) "RTN","RMPRPCEB",61,0) S:'$D(^RMPR(669.9,RS,"PCE")) RFLDAT=0 "RTN","RMPRPCEB",62,0) S RSTAFLG($P(^RMPR(669.9,RS,0),U,2))=RFLDAT "RTN","RMPRPCEB",63,0) S $P(^RMPR(669.9,RS,"PCE"),U,1)=RMSTDT "RTN","RMPRPCEB",64,0) Q "RTN","RMPRPCEB",65,0) ; "RTN","RMPRPCEB",66,0) PROC ;process "RTN","RMPRPCEB",67,0) F RS=0:0 S RS=$O(^TMP($J,RS)) Q:RS'>0 F RII=0:0 S RII=$O(^TMP($J,RS,RII)) Q:RII'>0 F RJ=0:0 S RJ=$O(^TMP($J,RS,RII,RJ)) Q:RJ'>0 S RK=$O(^TMP($J,RS,RII,RJ,0)) D "RTN","RMPRPCEB",68,0) .;call PCE Interface "RTN","RMPRPCEB",69,0) .S RMIE60RK=RK "RTN","RMPRPCEB",70,0) .S RMC=$$SENDPCE^RMPRPCEA(RK) "RTN","RMPRPCEB",71,0) . I RMC<1 D "RTN","RMPRPCEB",72,0) ..S RSNAM=" " "RTN","RMPRPCEB",73,0) ..I $G(RS),$D(^DIC(4,RS,0)) S RSNAM=$E($P(^DIC(4,RS,0),U,1),1,8) "RTN","RMPRPCEB",74,0) ..S ^TMP($J,"RMPRERR",RK)="Station: "_RSNAM_", File #660 IEN="_RK_" - Error in PCE interface!!!" "RTN","RMPRPCEB",75,0) ..;Added next line for RMPR*3*82 "RTN","RMPRPCEB",76,0) ..I '$G(RMLOC) S ^TMP($J,"RMPRERR",RK)=^TMP($J,"RMPRERR",RK)_$G(RERRMSG)_$G(RERRMSG2) "RTN","RMPRPCEB",77,0) ..I $D(RMPROB($J,1))!$D(RMPROB($J,2)) D "RTN","RMPRPCEB",78,0) ...S (R2,R3,RMMESS)="",R6I=RK,RC=0 "RTN","RMPRPCEB",79,0) ...F R1=0:0 S R1=$O(RMPROB($J,R1)) Q:R1'>0 S RC=RC+1 F S R2=$O(RMPROB($J,R1,"ERROR1",R2)) Q:R2="" F S R3=$O(RMPROB($J,R1,"ERROR1",R2,R3)) Q:R3="" D "RTN","RMPRPCEB",80,0) ....F R4=0:0 S R4=$O(RMPROB($J,R1,"ERROR1",R2,R3,R4)) Q:R4'>0 D "RTN","RMPRPCEB",81,0) .....S RMMESS=RMPROB($J,R1,"ERROR1",R2,R3,R4),RMK=R6I_"."_RC,^TMP($J,"RMPRERR",RMK)=" ???? "_$E(RMMESS,1,999) "RTN","RMPRPCEB",82,0) .....K RMPROB($J,R1,"ERROR1",R2,R3,R4) "RTN","RMPRPCEB",83,0) K RMPROB "RTN","RMPRPCEB",84,0) Q "RTN","RMPRPCEB",85,0) ; "RTN","RMPRPCEB",86,0) MES1 ; "RTN","RMPRPCEB",87,0) S XMY("G.RMPR PCE")="",XMDUZ=.5,XMTEXT="^TMP($J,""RMPR""," "RTN","RMPRPCEB",88,0) S XMSUB="PROSTHETICS PCE BACKGROUND MESSAGE" "RTN","RMPRPCEB",89,0) S ^TMP($J,"RMPR",1)="Run Date: "_RMRDAT "RTN","RMPRPCEB",90,0) S ^TMP($J,"RMPR",2)="This is a notification from the Prosthetics Department........" "RTN","RMPRPCEB",91,0) S ^TMP($J,"RMPR",3)="" "RTN","RMPRPCEB",92,0) S ^TMP($J,"RMPR",4)="" "RTN","RMPRPCEB",93,0) Q "RTN","RMPRPCEB",94,0) MES2 ; "RTN","RMPRPCEB",95,0) S ^TMP($J,"RMPR",RMSUBI+2)="" "RTN","RMPRPCEB",96,0) I $D(^TMP($J,"RMPRERR")) S ^TMP($J,"RMPR",RMSUBI+3)="*** Please contact your PCE Coordinator or IRM ***" "RTN","RMPRPCEB",97,0) I '$D(^TMP($J,"RMPRERR")) S ^TMP($J,"RMPR",RMSUBI+3)="" "RTN","RMPRPCEB",98,0) S ^TMP($J,"RMPR",RMSUBI+4)="" "RTN","RMPRPCEB",99,0) S ^TMP($J,"RMPR",RMSUBI+5)="Thank You!!!" "RTN","RMPRPCEB",100,0) S ^TMP($J,"RMPR",RMSUBI+6)="" "RTN","RMPRPCEB",101,0) S ^TMP($J,"RMPR",RMSUBI+7)="PROSTHETICS DEPARTMENT" "RTN","RMPRPCEB",102,0) D ^XMD "RTN","RMPRPCEB",103,0) D NOW^%DTC "RTN","RMPRPCEB",104,0) ;if task finish to completion and; "RTN","RMPRPCEB",105,0) ;if no errors, set the PCE end date of the background job in #669.9. "RTN","RMPRPCEB",106,0) F RS=0:0 S RS=$O(^RMPR(669.9,RS)) Q:RS'>0 S $P(^RMPR(669.9,RS,"PCE"),U,2)=% "RTN","RMPRPCEB",107,0) Q "RTN","RMPRPCEB",108,0) ; "RTN","RMPRPCEB",109,0) BUILD ; "RTN","RMPRPCEB",110,0) F I=0:0 S I=$O(^TMP($J,"RMPRERR",I)) Q:I'>0 D "RTN","RMPRPCEB",111,0) .S RMMAIL=^TMP($J,"RMPRERR",I) "RTN","RMPRPCEB",112,0) .S RMSUBI=RMSUBI+1 "RTN","RMPRPCEB",113,0) .S ^TMP($J,"RMPR",RMSUBI)=RMMAIL "RTN","RMPRPCEB",114,0) Q "RTN","RMPRPCEB",115,0) ; "RTN","RMPRPCEB",116,0) EXIT ;MAIN EXIT POINT "RTN","RMPRPCEB",117,0) K ^TMP($J) "RTN","RMPRPCEB",118,0) S DUZ=SVDUZ "RTN","RMPRPCEB",119,0) N RMPRSITE,RMPR D KILL^XUSCLEAN "RTN","RMPRPCEB",120,0) Q "VER") 8.0^22.0 "BLD",6860,6) ^120 **END** **END**