Released RMPR*3*182 SEQ #162 Extracted from mail message **KIDS**:RMPR*3.0*182^ **INSTALL NAME** RMPR*3.0*182 "BLD",9746,0) RMPR*3.0*182^PROSTHETICS^0^3170504^y "BLD",9746,1,0) ^^9^9^3170322^ "BLD",9746,1,1,0) 1. Eye glass STAT consult not showing on Suspense List "BLD",9746,1,2,0) "BLD",9746,1,3,0) 2. Add fields Lot, Model and Contract Number to Reconcile Close Out "BLD",9746,1,4,0) "BLD",9746,1,5,0) 3. Site issue causing error in Suspense Processing "BLD",9746,1,6,0) "BLD",9746,1,7,0) 4. Site was not getting diagnosis when using option RMPR VIEW 2319 "BLD",9746,1,8,0) "BLD",9746,1,9,0) 5. Reconciliation edit not working when used by two users at same time "BLD",9746,4,0) ^9.64PA^^ "BLD",9746,6.3) 13 "BLD",9746,"ABPKG") n "BLD",9746,"KRN",0) ^9.67PA^779.2^20 "BLD",9746,"KRN",.4,0) .4 "BLD",9746,"KRN",.4,"NM",0) ^9.68A^1^1 "BLD",9746,"KRN",.4,"NM",1,0) RMPR VIEW REQUEST FILE #668^668^0 "BLD",9746,"KRN",.4,"NM","B","RMPR VIEW REQUEST FILE #668",1) "BLD",9746,"KRN",.401,0) .401 "BLD",9746,"KRN",.402,0) .402 "BLD",9746,"KRN",.403,0) .403 "BLD",9746,"KRN",.5,0) .5 "BLD",9746,"KRN",.84,0) .84 "BLD",9746,"KRN",3.6,0) 3.6 "BLD",9746,"KRN",3.8,0) 3.8 "BLD",9746,"KRN",9.2,0) 9.2 "BLD",9746,"KRN",9.8,0) 9.8 "BLD",9746,"KRN",9.8,"NM",0) ^9.68A^4^4 "BLD",9746,"KRN",9.8,"NM",1,0) RMPREO^^0^B12735146 "BLD",9746,"KRN",9.8,"NM",2,0) RMPR4E21^^0^B64344678 "BLD",9746,"KRN",9.8,"NM",3,0) RMPR4LI^^0^B18898445 "BLD",9746,"KRN",9.8,"NM",4,0) RMPOPAT3^^0^B39179406 "BLD",9746,"KRN",9.8,"NM","B","RMPOPAT3",4) "BLD",9746,"KRN",9.8,"NM","B","RMPR4E21",2) "BLD",9746,"KRN",9.8,"NM","B","RMPR4LI",3) "BLD",9746,"KRN",9.8,"NM","B","RMPREO",1) "BLD",9746,"KRN",19,0) 19 "BLD",9746,"KRN",19.1,0) 19.1 "BLD",9746,"KRN",101,0) 101 "BLD",9746,"KRN",409.61,0) 409.61 "BLD",9746,"KRN",771,0) 771 "BLD",9746,"KRN",779.2,0) 779.2 "BLD",9746,"KRN",870,0) 870 "BLD",9746,"KRN",8989.51,0) 8989.51 "BLD",9746,"KRN",8989.52,0) 8989.52 "BLD",9746,"KRN",8994,0) 8994 "BLD",9746,"KRN","B",.4,.4) "BLD",9746,"KRN","B",.401,.401) "BLD",9746,"KRN","B",.402,.402) "BLD",9746,"KRN","B",.403,.403) "BLD",9746,"KRN","B",.5,.5) "BLD",9746,"KRN","B",.84,.84) "BLD",9746,"KRN","B",3.6,3.6) "BLD",9746,"KRN","B",3.8,3.8) "BLD",9746,"KRN","B",9.2,9.2) "BLD",9746,"KRN","B",9.8,9.8) "BLD",9746,"KRN","B",19,19) "BLD",9746,"KRN","B",19.1,19.1) "BLD",9746,"KRN","B",101,101) "BLD",9746,"KRN","B",409.61,409.61) "BLD",9746,"KRN","B",771,771) "BLD",9746,"KRN","B",779.2,779.2) "BLD",9746,"KRN","B",870,870) "BLD",9746,"KRN","B",8989.51,8989.51) "BLD",9746,"KRN","B",8989.52,8989.52) "BLD",9746,"KRN","B",8994,8994) "BLD",9746,"QDEF") ^^^^^^^^^^YES "BLD",9746,"QUES",0) ^9.62^^ "BLD",9746,"REQB",0) ^9.611^5^4 "BLD",9746,"REQB",2,0) RMPR*3.0*137^2 "BLD",9746,"REQB",3,0) RMPR*3.0*83^2 "BLD",9746,"REQB",4,0) RMPR*3.0*90^2 "BLD",9746,"REQB",5,0) RMPR*3.0*99^2 "BLD",9746,"REQB","B","RMPR*3.0*137",2) "BLD",9746,"REQB","B","RMPR*3.0*83",3) "BLD",9746,"REQB","B","RMPR*3.0*90",4) "BLD",9746,"REQB","B","RMPR*3.0*99",5) "KRN",.4,2106,-1) 0^1 "KRN",.4,2106,0) RMPR VIEW REQUEST^3160504.0812^@^668^^@^3161208 "KRN",.4,2106,"DXS") 3 "KRN",.4,2106,"DXS",1,9) X DXS(1,9.6) S DIP(304)=$G(X) S X=10,X=$E(DIP(303),DIP(304),X),Y=X,X=DIP(205),X=X_Y,Y=X,X=DIP(105),X=X_Y,Y=X,X=DIP(2),X=X_Y S D0=I(0,0) "KRN",.4,2106,"DXS",1,9.2) S I(0,0)=$G(D0),DIP(1)=$S($D(^RMPR(668,D0,0)):^(0),1:"") S X="SSN: ",DIP(2)=$G(X),D0=$P(DIP(1),U,2) S:'D0!'$D(^DPT(+D0,0)) D0=-1 S I(100,0)=$G(D0) "KRN",.4,2106,"DXS",1,9.3) X DXS(1,9.2) S DIP(102)=$S($D(^DPT(D0,0)):^(0),1:""),DIP(101)=$G(X) S X=$P(DIP(102),U,9),DIP(103)=$G(X) S X=1,DIP(104)=$G(X) S X=3,X=$E(DIP(103),DIP(104),X) "KRN",.4,2106,"DXS",1,9.4) X DXS(1,9.3) S X=X_"-",DIP(105)=$G(X),D0=$P(DIP(1),U,2) S:'D0!'$D(^DPT(+D0,0)) D0=-1 S I(200,0)=$G(D0),DIP(202)=$S($D(^DPT(D0,0)):^(0),1:""),DIP(201)=$G(X) "KRN",.4,2106,"DXS",1,9.5) X DXS(1,9.4) S X=$P(DIP(202),U,9),DIP(203)=$G(X) S X=4,DIP(204)=$G(X) S X=5,X=$E(DIP(203),DIP(204),X)_"-",DIP(205)=$G(X) "KRN",.4,2106,"DXS",1,9.6) X DXS(1,9.5) S D0=$P(DIP(1),U,2) S:'D0!'$D(^DPT(+D0,0)) D0=-1 S DIP(302)=$S($D(^DPT(D0,0)):^(0),1:""),DIP(301)=$G(X) S X=$P(DIP(302),U,9),DIP(303)=$G(X) S X=6 "KRN",.4,2106,"DXS",2,9) S DIP(1)=$S($D(^RMPR(668,D0,8)):^(8),1:"") S X="Description of Item/Services Requested ** "_$P(DIP(1),U,5)_" **" "KRN",.4,2106,"F",1) "Order Date: ";X;C1~S DIP(1)=$S($D(^RMPR(668,D0,0)):^(0),1:"") S X=$P(DIP(1),U,1),X=$P(X,".",1) S Y=X D DT K DIP;X;d;L18;Z;"DATE(SUSPENSE DATE)"~ "KRN",.4,2106,"F",2) S DIP(1)=$S($D(^RMPR(668,D0,0)):^(0),1:"") S X="Patient: "_$P($G(^DPT(+$P(DIP(1),U,2),0)),U) W X K DIP;C30;X;Z;""Patient: "_VETERAN"~ "KRN",.4,2106,"F",3) X DXS(1,9) W X K DIP;C57;Z;""SSN: "_VETERAN:$E(SOCIAL SECURITY NUMBER,1,3)_"-"_VETERAN:$E(SOCIAL SECURITY NUMBER,4,5)_"-"_VETERAN:$E(SOCIAL SECURITY NUMBER,6,10)"~ "KRN",.4,2106,"F",4) S DIP(1)=$S($D(^RMPR(668,D0,0)):^(0),1:"") S X="Requestor: "_$P($G(^VA(200,+$P(DIP(1),U,11),0)),U) W X K DIP;C1;X;Z;""Requestor: "_REQUESTOR"~ "KRN",.4,2106,"F",5) "Suspended By: ";C30~8;X//~ "KRN",.4,2106,"F",6) S X="-",DIP(1)=$G(X),DIP(2)=$G(X),X=$G(IOM,80) S X=X,X1=DIP(1) S %=X,X="" S:X1]"" $P(X,X1,%\$L(X1)+1)=X1,X=$E(X,1,%) W X K DIP;C1;X//;Z;"DUP("-",IOM)"~ "KRN",.4,2106,"F",7) "Initial Action Date: ";C1~ "KRN",.4,2106,"F",8) S DIP(1)=$S($D(^RMPR(668,D0,0)):^(0),1:"") S X=$P(DIP(1),U,9),X=$P(X,".",1) S Y=X D DT K DIP;X;d;L18;Z;"DATE(INITIAL ACTION DATE)"~ "KRN",.4,2106,"F",9) "Complete Date: ";C35~5;X~ "KRN",.4,2106,"F",10) S X="=",DIP(1)=$G(X),DIP(2)=$G(X),X=$G(IOM,80) S X=X,X1=DIP(1) S %=X,X="" S:X1]"" $P(X,X1,%\$L(X1)+1)=X1,X=$E(X,1,%) W X K DIP;C1;X;Z;"DUP("=",IOM)"~ "KRN",.4,2106,"F",11) X DXS(2,9) W X K DIP;C1;Z;""Description of Item/Services Requested ** "_URGENCY_" **""~4,.01;C1;""~ "KRN",.4,2106,"F",12) S X="-",DIP(1)=$G(X),DIP(2)=$G(X),X=$G(IOM,80) S X=X,X1=DIP(1) S %=X,X="" S:X1]"" $P(X,X1,%\$L(X1)+1)=X1,X=$E(X,1,%) W X K DIP;C1;X;Z;"DUP("-",IOM)"~ "KRN",.4,2106,"F",13) "Initial Action Note: ";C1~7,.01;C1;X~ "KRN",.4,2106,"F",14) S X="-",DIP(1)=$G(X),DIP(2)=$G(X),X=$G(IOM,80) S X=X,X1=DIP(1) S %=X,X="" S:X1]"" $P(X,X1,%\$L(X1)+1)=X1,X=$E(X,1,%) W X K DIP;C1;X;Z;"DUP("-",IOM)"~ "KRN",.4,2106,"F",15) "Complete Note: ";C1~12,.01;X~ "KRN",.4,2106,"H") View "MBREQ") 0 "ORD",5,.4) .4;5;;;EDEOUT^DIFROMSO(.4,DA,"",XPDA);FPRE^DIFROMSI(.4,"",XPDA);EPRE^DIFROMSI(.4,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.4,DA,"",XPDA);DEL^DIFROMSK(.4,"",%) "ORD",5,.4,0) PRINT TEMPLATE "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) 182^3170504 "PKG",101,22,1,"PAH",1,1,0) ^^9^9^3170504 "PKG",101,22,1,"PAH",1,1,1,0) 1. Eye glass STAT consult not showing on Suspense List "PKG",101,22,1,"PAH",1,1,2,0) "PKG",101,22,1,"PAH",1,1,3,0) 2. Add fields Lot, Model and Contract Number to Reconcile Close Out "PKG",101,22,1,"PAH",1,1,4,0) "PKG",101,22,1,"PAH",1,1,5,0) 3. Site issue causing error in Suspense Processing "PKG",101,22,1,"PAH",1,1,6,0) "PKG",101,22,1,"PAH",1,1,7,0) 4. Site was not getting diagnosis when using option RMPR VIEW 2319 "PKG",101,22,1,"PAH",1,1,8,0) "PKG",101,22,1,"PAH",1,1,9,0) 5. Reconciliation edit not working when used by two users at same time "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") 4 "RTN","RMPOPAT3") 0^4^B39179406^B37951435 "RTN","RMPOPAT3",1,0) RMPOPAT3 ;HINES-CIOFO/RVD-Detail Display Patient 10-2319 Transaction;11/04/04 "RTN","RMPOPAT3",2,0) ;;3.0;PROSTHETICS;**70,92,99,182**;Feb 09, 1996;Build 13 "RTN","RMPOPAT3",3,0) ; "RTN","RMPOPAT3",4,0) ; RVD 7/8/02 patch #70 - this routine is a copy of RMPRPAT3. "RTN","RMPOPAT3",5,0) ; For Read Only 2319. "RTN","RMPOPAT3",6,0) ; AAC 08/03/04 Patch 92 - Code Set Versioning (CSV) "RTN","RMPOPAT3",7,0) ;Used API=ICDDX^ICDCODE to replace direct calls to global ICD9(80). "RTN","RMPOPAT3",8,0) ; "RTN","RMPOPAT3",9,0) ;DBIA # 10082 - file #80, global read. "RTN","RMPOPAT3",10,0) ; "RTN","RMPOPAT3",11,0) ;RMPR*3.0*182 Modified system to be able to pull the "RTN","RMPOPAT3",12,0) ; ext code and description for ICD10. "RTN","RMPOPAT3",13,0) ; "RTN","RMPOPAT3",14,0) ;expect ANS,IT(ANS) "RTN","RMPOPAT3",15,0) ; +IT(ANS)=ien of file 660 "RTN","RMPOPAT3",16,0) ;expect variables from GETPAT^RMPRUTIL "RTN","RMPOPAT3",17,0) ; RMPRSSNE (external form of SSN) "RTN","RMPOPAT3",18,0) ; RMPRNAM (name of patient) "RTN","RMPOPAT3",19,0) ; RMPRDOB "RTN","RMPOPAT3",20,0) ;display detailed record "RTN","RMPOPAT3",21,0) PRINT ;called from RMPOPAT2 "RTN","RMPOPAT3",22,0) ;get 2319 transaction "RTN","RMPOPAT3",23,0) ; "RTN","RMPOPAT3",24,0) N DIC,DIQ,DR,DA,RMPRV,RMPRDA,RV "RTN","RMPOPAT3",25,0) S DIC=660,DIQ="R19",DR=".01:96",DIQ(0)="EN" "RTN","RMPOPAT3",26,0) S (RMPRDA,DA)=+IT(ANS) "RTN","RMPOPAT3",27,0) D EN^DIQ1 "RTN","RMPOPAT3",28,0) S DIQ="R19",DR=72,DIQ(0)="I" D EN^DIQ1 "RTN","RMPOPAT3",29,0) ;get vendor info "RTN","RMPOPAT3",30,0) S DA=$P(^RMPR(660,RMPRDA,0),U,9) "RTN","RMPOPAT3",31,0) I DA D "RTN","RMPOPAT3",32,0) .S DIC=440,DIQ="RV",DR=".01:6",DIQ(0)="EN" "RTN","RMPOPAT3",33,0) .S (RMPRV,DA)=$P(^RMPR(660,RMPRDA,0),U,9) "RTN","RMPOPAT3",34,0) .D EN^DIQ1 "RTN","RMPOPAT3",35,0) ; "RTN","RMPOPAT3",36,0) ;array defined for record in following format: "RTN","RMPOPAT3",37,0) ;R19(filenumber,ien,field,E)=external form of data "RTN","RMPOPAT3",38,0) ;RV(filenumber,ien,field,E)=external form of data "RTN","RMPOPAT3",39,0) ;example "RTN","RMPOPAT3",40,0) ;R19(660,100,.01,"E")=APR 27, 1995 "RTN","RMPOPAT3",41,0) ;R19(660,100,.02,"E")=FUDGE,CHOCOLATE "RTN","RMPOPAT3",42,0) ;RV(440,131,.01,"E")=ORTHOTIC LAB "RTN","RMPOPAT3",43,0) ; "RTN","RMPOPAT3",44,0) D HDR "RTN","RMPOPAT3",45,0) W !,"TYPE OF FORM: ",$G(R19(660,RMPRDA,11,"E")) "RTN","RMPOPAT3",46,0) W ?25,"INITIATOR: ",$G(R19(660,RMPRDA,27,"E")) "RTN","RMPOPAT3",47,0) ;historical item "RTN","RMPOPAT3",48,0) W !,"ITEM DESCRIPTION: ",$G(R19(660,RMPRDA,89,"E")) "RTN","RMPOPAT3",49,0) W ?55,"DATE: ",$G(R19(660,RMPRDA,1,"E")) "RTN","RMPOPAT3",50,0) W !,"DELIVER TO: ",$G(R19(660,RMPRDA,25,"E")) "RTN","RMPOPAT3",51,0) W !,"TYPE TRANS: ",$G(R19(660,RMPRDA,2,"E")) "RTN","RMPOPAT3",52,0) W ?30,"QTY: ",$G(R19(660,RMPRDA,5,"E")) "RTN","RMPOPAT3",53,0) W:$G(R19(660,RMPRDA,29,"E")) ?40,"INVENTORY POINT: ",R19(660,RMPRDA,29,"E"),! "RTN","RMPOPAT3",54,0) W ?40,"SOURCE: ",$G(R19(660,RMPRDA,12,"E")) "RTN","RMPOPAT3",55,0) ;vendor tracking number "RTN","RMPOPAT3",56,0) I $G(R19(660,RMPRDA,11,"E"))="VISA" D "RTN","RMPOPAT3",57,0) .W !,"VENDOR TRACKING: ",$G(R19(660,RMPRDA,4.2,"E")) "RTN","RMPOPAT3",58,0) .W ?38,"BANK AUTHORIZATION: ",$G(R19(660,RMPRDA,4.3,"E")) "RTN","RMPOPAT3",59,0) W !,"VENDOR: ",?15,$G(R19(660,RMPRDA,7,"E")) "RTN","RMPOPAT3",60,0) I $D(RV) D "RTN","RMPOPAT3",61,0) .W !?15,$G(RV(440,RMPRV,1,"E")) "RTN","RMPOPAT3",62,0) .W !?15,$G(RV(440,RMPRV,4.2,"E")),"," "RTN","RMPOPAT3",63,0) .W ?$X+3,$G(RV(440,RMPRV,4.4,"E")),?$X+5,$G(RV(440,RMPRV,4.6,"E")) "RTN","RMPOPAT3",64,0) W !,"DELIVERY DATE: " "RTN","RMPOPAT3",65,0) I $D(R19(660,RMPRDA,10,"E")) W R19(660,RMPRDA,10,"E") "RTN","RMPOPAT3",66,0) W ! "RTN","RMPOPAT3",67,0) I '$P(IT(AN),U,3) D "RTN","RMPOPAT3",68,0) .W "TOTAL COST: " "RTN","RMPOPAT3",69,0) .I $G(R19(660,RMPRDA,14,"E"))'="" W "$"_$J(R19(660,RMPRDA,14,"E"),2) "RTN","RMPOPAT3",70,0) .I $G(R19(660,RMPRDA,14,"E"))="" W $S($G(R19(660,RMPRDA,6,"E"))'="":"$"_$J(R19(660,RMPRDA,6,"E"),2),$G(R19(660,RMPRDA,48,"E"))'="":"$"_$J(R19(660,RMPRDA,48,"E"),2),1:"") "RTN","RMPOPAT3",71,0) ; "RTN","RMPOPAT3",72,0) ;lab data "RTN","RMPOPAT3",73,0) I $D(^RMPR(660,RMPRDA,"LB")) D "RTN","RMPOPAT3",74,0) .N DIC,DIQ,DR,L19,DA "RTN","RMPOPAT3",75,0) .S (DA,RMPRLA)=$P(^RMPR(660,RMPRDA,"LB"),U,10) "RTN","RMPOPAT3",76,0) .Q:DA="" "RTN","RMPOPAT3",77,0) .S DIC=664.1,DIQ="L19",DR="15",DIQ(0)="E" "RTN","RMPOPAT3",78,0) .D EN^DIQ1 "RTN","RMPOPAT3",79,0) .W !,"WORK ORDER: ",$G(R19(660,RMPRDA,71,"E")) "RTN","RMPOPAT3",80,0) .W ?40,"RECEIVING STATION: ",$G(R19(660,RMPRDA,70,"E")) "RTN","RMPOPAT3",81,0) .W !,"TECHNICIAN: ",$G(L19(664.1,RMPRLA,15,"E")) "RTN","RMPOPAT3",82,0) .W !,"TOTAL LABOR HOURS: ",$G(R19(660,RMPRDA,45,"E")) "RTN","RMPOPAT3",83,0) .W ?40,"TOTAL LABOR COST: ",$G(R19(660,RMPRDA,46,"E")) "RTN","RMPOPAT3",84,0) .W !,"TOTAL MATERIAL COST: ",$G(R19(660,RMPRDA,47,"E")) "RTN","RMPOPAT3",85,0) .W ?40,"TOTAL LAB COST: ",$G(R19(660,RMPRDA,48,"E")) "RTN","RMPOPAT3",86,0) .W !,"COMPLETION DATE: ",$G(R19(660,RMPRDA,50,"E")) "RTN","RMPOPAT3",87,0) .W ?40,"LAB REMARKS: ",$G(R19(660,RMPRDA,51,"E")) "RTN","RMPOPAT3",88,0) W !,"REMARKS: ",?15,$G(R19(660,RMPRDA,16,"E")) "RTN","RMPOPAT3",89,0) I $G(R19(660,RMPRDA,17.5,"E")) W ?40,"RETURN STATUS: ",R19(660,RMPRDA,17.5,"E") "RTN","RMPOPAT3",90,0) ; "RTN","RMPOPAT3",91,0) ;historical data "RTN","RMPOPAT3",92,0) I $G(R19(660,RMPRDA,15,"E"))["*" D "RTN","RMPOPAT3",93,0) .;include records that have been merged "RTN","RMPOPAT3",94,0) .W !!,"HISTORICAL DATA",! "RTN","RMPOPAT3",95,0) .Q:'$D(R19(660,RMPRDA,89)) "RTN","RMPOPAT3",96,0) .W !,?15,"ITEM: ",$G(R19(660,RMPRDA,89,"E")) "RTN","RMPOPAT3",97,0) .W !,?15,"STATION: ",$G(R19(660,RMPRDA,90,"E")) "RTN","RMPOPAT3",98,0) .W !,?15,"VENDOR: ",$G(R19(660,RMPRDA,91,"E")) "RTN","RMPOPAT3",99,0) .W !,?23,$G(R19(660,RMPRDA,93,"E")),!,?23,$G(R19(660,RMPRDA,94,"E")) "RTN","RMPOPAT3",100,0) .W " ",$G(R19(660,RMPRDA,95,"E"))," ",$G(R19(660,RMPRDA,96,"E")) "RTN","RMPOPAT3",101,0) ;put in lab display here fields 45,46,47,48 and 51 "RTN","RMPOPAT3",102,0) ;lab amis "RTN","RMPOPAT3",103,0) I $G(R19(660,RMPRDA,73,"E")) D "RTN","RMPOPAT3",104,0) .W ?40,"ORTHOTICS LAB CODE: " "RTN","RMPOPAT3",105,0) .W $S($D(R19(660,RMPRDA,74,"E")):R19(660,RMPRDA,74,"E"),$D(R19(660,RMPRDA,75,"E")):R19(660,RMPRDA,75,"E"),1:"") "RTN","RMPOPAT3",106,0) .W !?40,"RESTORATIONS LAB CODE: " "RTN","RMPOPAT3",107,0) .W $S($D(R19(660,RMPRDA,76,"E")):R19(660,RMPRDA,76,"E"),$D(R19(660,RMPRDA,77,"E")):R19(660,RMPRDA,77,"E"),1:"") "RTN","RMPOPAT3",108,0) ;purchasing and issue from stock amis "RTN","RMPOPAT3",109,0) W !,"DISABILITY SERVED: ",$G(R19(660,RMPRDA,62,"E")) "RTN","RMPOPAT3",110,0) ;appliance/item information "RTN","RMPOPAT3",111,0) ;historical/original item "RTN","RMPOPAT3",112,0) W !,"ITEM DESCRIPTION: ",$G(R19(660,RMPRDA,89,"E")) "RTN","RMPOPAT3",113,0) ;check for changes to item description "RTN","RMPOPAT3",114,0) I $G(R19(660,RMPRDA,89,"E"))'=$G(R19(660,RMPRDA,4,"E")) W !,"*** See Above For Original Item Description ***" "RTN","RMPOPAT3",115,0) W !,"APPLIANCE: ",$G(R19(660,RMPRDA,4,"E")) "RTN","RMPOPAT3",116,0) W !,"PSAS HCPCS: ",$G(R19(660,RMPRDA,4.5,"E")) "RTN","RMPOPAT3",117,0) I $P($G(^RMPR(660,RMPRDA,1)),U,4) W ?22,$P($G(^RMPR(661.1,$P(^RMPR(660,RMPRDA,1),U,4),0)),U,2) "RTN","RMPOPAT3",118,0) ;added by #69 "RTN","RMPOPAT3",119,0) ; "RTN","RMPOPAT3",120,0) ; PATCH 92 - Code Set Versioning (CSV) changes below "RTN","RMPOPAT3",121,0) ; AAC - 08/03/04 "RTN","RMPOPAT3",122,0) ; RMPR*3*182 Changes to handle BOTH ICD9 and ICD10 internal pointers "RTN","RMPOPAT3",123,0) S (RMPRICD,RMPRIC9,RMPRCOD,RMPRDAT)="" S RMPRERR=0 "RTN","RMPOPAT3",124,0) S RMPRDAT=$P($G(^RMPR(660,RMPRDA,0)),U) "RTN","RMPOPAT3",125,0) I $D(^RMPR(660,RMPRDA,10)) S RMPRICD=$P(^RMPR(660,RMPRDA,10),U,8),RMPRICDC=$G(^ICD9(RMPRICD,0)) "RTN","RMPOPAT3",126,0) I RMPRICD D "RTN","RMPOPAT3",127,0) . S RMPRICDD=$O(^ICD9(RMPRICD,67,"B",RMPRDAT),-1) "RTN","RMPOPAT3",128,0) . S RMPRICDD=$S(RMPRICDD:$O(^ICD9(RMPRICD,67,"B",RMPRICDD,0)),1:1) "RTN","RMPOPAT3",129,0) . S RMPRICDD=$P($G(^ICD9(RMPRICD,67,RMPRICDD,0)),U,2) "RTN","RMPOPAT3",130,0) S RMPRICDT=$S(RMPRICD<50000:9,1:10) "RTN","RMPOPAT3",131,0) I RMPRICD="" W !,"ICD Message: ** NO CODE AVAILABLE **" "RTN","RMPOPAT3",132,0) I RMPRICD'="" W !,"ICD",RMPRICDT,": ",RMPRICDC," ",RMPRICDD "RTN","RMPOPAT3",133,0) ; "RTN","RMPOPAT3",134,0) ; End Patch 92 "RTN","RMPOPAT3",135,0) ; "RTN","RMPOPAT3",136,0) W !,"CPT MODIFIER: ",$G(R19(660,RMPRDA,4.7,"E")) "RTN","RMPOPAT3",137,0) W !,"DESCRIPTION: ",$G(R19(660,RMPRDA,24,"E")) "RTN","RMPOPAT3",138,0) W !,"EXTENDED DESCRIPTION: ",! "RTN","RMPOPAT3",139,0) I $D(R19(660,RMPRDA,28)) D G:$D(DUOUT)!$D(DTOUT) EX1 "RTN","RMPOPAT3",140,0) .N R28 "RTN","RMPOPAT3",141,0) .;command part of new standards "RTN","RMPOPAT3",142,0) .MERGE R28=R19(660,RMPRDA,28) "RTN","RMPOPAT3",143,0) .I $P($G(^RMPR(660,RMPRDA,"DES",0)),U,3)>1 N DIR S DIR(0)="E" D ^DIR Q:$D(DUOUT)!$D(DTOUT) D HDR W !,"EXTENDED DESCRIPTION: ",! "RTN","RMPOPAT3",144,0) .D EN^DDIOL(.R28) "RTN","RMPOPAT3",145,0) ;NPPD key items consolidated, example L5300 limb order "RTN","RMPOPAT3",146,0) I $P(IT(AN),U,3) W !!,"*** Return For DETAIL REPORT ***" N DIR S DIR(0)="E" D ^DIR G:$D(DUOUT)!$D(DTOUT) EX1 W @IOF D HDR,^RMPRPAT7 "RTN","RMPOPAT3",147,0) ;display work order if it is a 2529-3 form "RTN","RMPOPAT3",148,0) ;must pass ien to file 664.1 NOT 664.2 "RTN","RMPOPAT3",149,0) I $G(R19(660,RMPRDA,72,"I"))'="" D G EX1 "RTN","RMPOPAT3",150,0) .S DIR(0)="E" D ^DIR Q:$D(DTOUT)!$D(DUOUT) "RTN","RMPOPAT3",151,0) .S RMPRBCK=RMPRDA "RTN","RMPOPAT3",152,0) .N DIC "RTN","RMPOPAT3",153,0) .S RMPRDA=R19(660,RMPRBCK,72,"I") "RTN","RMPOPAT3",154,0) .D DISP^RMPR293(RMPRDA) "RTN","RMPOPAT3",155,0) .S RMPRDA=RMPRBCK K RMPRBCK "RTN","RMPOPAT3",156,0) ;return from work order "RTN","RMPOPAT3",157,0) G EXIT "RTN","RMPOPAT3",158,0) ; "RTN","RMPOPAT3",159,0) HDR ;display heading "RTN","RMPOPAT3",160,0) W @IOF,RMPRNAM,?30," SSN: " "RTN","RMPOPAT3",161,0) W $E(RMPRSSN,1,3)_"-"_$E(RMPRSSN,4,5)_"-"_$E(RMPRSSN,6,10),?50 "RTN","RMPOPAT3",162,0) W $G(R19(660,RMPRDA,8,"E")),?70,"DOB: " "RTN","RMPOPAT3",163,0) W $S(RMPRDOB:$E(RMPRDOB,4,5)_"-"_$E(RMPRDOB,6,7)_"-"_(1700+$E(RMPRDOB,1,3)),1:"Unknown") "RTN","RMPOPAT3",164,0) W !?20,"APPLIANCE/REPAIR LINE ITEM DETAIL ",?70,"<4-",ANS,">",! "RTN","RMPOPAT3",165,0) Q "RTN","RMPOPAT3",166,0) EXIT ;common exit point "RTN","RMPOPAT3",167,0) I $Y>(IOSL-4) F W ! Q:$Y>(IOSL-3) "RTN","RMPOPAT3",168,0) N DIR S DIR(0)="E" D ^DIR "RTN","RMPOPAT3",169,0) S RMOXY=Y "RTN","RMPOPAT3",170,0) ;duout,dtout is evaluated in dis+1^rmpopat2 "RTN","RMPOPAT3",171,0) EX1 ;back out through that point to clean up "RTN","RMPOPAT3",172,0) K R19,RV,RMPRICC,RMPRICD,RMPRIC9,RMPRCOD,RMPRDAT,RMPRERR,Y W @IOF "RTN","RMPOPAT3",173,0) Q "RTN","RMPOPAT3",174,0) ;end "RTN","RMPR4E21") 0^2^B64344678^B62022503 "RTN","RMPR4E21",1,0) RMPR4E21 ;PHX/HNC - CLOSE OUT PURCHASE CARD TRANSACTION ;3/1/1996 "RTN","RMPR4E21",2,0) ;;3.0;PROSTHETICS;**3,12,26,28,30,34,41,45,62,111,78,114,118,133,137,182**;Feb 09, 1996;Build 13 "RTN","RMPR4E21",3,0) ;TH Patch #78 - 08/04/03 - Add shipment date. Call routine ^RMPR4E23 "RTN","RMPR4E21",4,0) ;RVD patch #62 - PCE processing and link to suspense "RTN","RMPR4E21",5,0) ; "RTN","RMPR4E21",6,0) ;RMPR*3.0*182 Add Lot, Model and Contract number to reconciliation editing "RTN","RMPR4E21",7,0) ; Modify exit kill for ^TMP("RM") to be set to $J to "RTN","RMPR4E21",8,0) ; prevent killing other user's work area. "RTN","RMPR4E21",9,0) ; "RTN","RMPR4E21",10,0) ;I '$D(^PRC(440.5,"H",DUZ)) W !!,"You are not an authorized Purchase Card User, CONTACT FISCAL!" Q "RTN","RMPR4E21",11,0) START I '$D(RMPR) D DIV4^RMPRSIT Q:$D(X) "RTN","RMPR4E21",12,0) CL K ^TMP($J,"RMPRPCE") "RTN","RMPR4E21",13,0) K DIC S DIC="664",DIC(0)="AEQM",DIC("W")="D EN2^RMPR4D1",DIC("A")="Select PATIENT: " "RTN","RMPR4E21",14,0) S DIC("S")="I $D(^(4)) I ('$P(^(0),U,8)&'$P(^(0),U,5)),($P(^(0),U,14)=RMPR(""STA""))" "RTN","RMPR4E21",15,0) W !!,"You may also make a selection by Purchase Card Transaction" "RTN","RMPR4E21",16,0) W !,"(Example, PO number), or Bank Authorization Number (6 digit number).",! "RTN","RMPR4E21",17,0) D ^DIC S (DA,RMPRA)=+Y I Y=-1 G EXIT "RTN","RMPR4E21",18,0) K DIC G:$P(^RMPR(664,RMPRA,0),U,8) M4 G:$P(^(0),U,5) M6 "RTN","RMPR4E21",19,0) L +^RMPR(664,RMPRA,0):1 I $T=0 W !,?5,$C(7),"Someone else is Editing this entry!" G EXIT "RTN","RMPR4E21",20,0) ;get amis grouper number RGRP1 "RTN","RMPR4E21",21,0) S RGRP=0,RGRP1="" "RTN","RMPR4E21",22,0) S RGRP=$O(^RMPR(664,RMPRA,1,RGRP)) G:'RGRP BRK S RGRPP=$P($G(^RMPR(664,RMPRA,1,RGRP,0)),U,13) I 'RGRPP W !!,$C(7),"ERROR** This transaction was not posted to 2319, please contact your IRM..",!! S DIR(0)="E" D ^DIR G EXIT "RTN","RMPR4E21",23,0) S RGRP1=$P($G(^RMPR(660,RGRPP,"AMS")),U,1) "RTN","RMPR4E21",24,0) S (RMPRDFN,DFN)=$P(^RMPR(664,RMPRA,0),U,2),RMPRWO=$P(^(0),U,15),RMPRDA=$P(^(0),U,17) "RTN","RMPR4E21",25,0) D DEM^VADPT S RMPRSSNE=VA("PID"),RMPRSSN=+VADM(2),RMPRNAM=VADM(1) K VADM "RTN","RMPR4E21",26,0) ;set original value before close-out "RTN","RMPR4E21",27,0) K ^TMP("RM",$J),RM(RMPRA),RHCED S RMPRF=2 "RTN","RMPR4E21",28,0) K %X,%Y S %X="^RMPR(664,RMPRA,",%Y="^TMP("_"""RM"""_",$J,RMPRA," D %XY^%RCR "RTN","RMPR4E21",29,0) S RM(RMPRA,0)=$G(^RMPR(664,RMPRA,0)),RM(RMPRA,2)=$G(^(2)),RM(RMPRA,4)=$G(^(4)) "RTN","RMPR4E21",30,0) S RMPER=$P(RM(RMPRA,2),U,6),RMBAN=$P(RM(RMPRA,4),U,2),RMSHI=$P(RM(RMPRA,0),U,11),RMSHIEN=$P(RM(RMPRA,0),U,12) "RTN","RMPR4E21",31,0) S:RMSHI=""!(RMSHI+0=0) RMSHI=0 "RTN","RMPR4E21",32,0) ;added by #62 "RTN","RMPR4E21",33,0) ;collect all items and previous linkage to suspense. "RTN","RMPR4E21",34,0) I $G(RMSHIEN) S:'$D(^RMPR(660,RMSHIEN,10)) RM60LINK(RMSHIEN)="" "RTN","RMPR4E21",35,0) D COL^RMPRPCEL "RTN","RMPR4E21",36,0) ; "RTN","RMPR4E21",37,0) L ;**** ask for final posting ***************************************** "RTN","RMPR4E21",38,0) D ^RMPR4LI N DIR K RFLG "RTN","RMPR4E21",39,0) S DIR("A")="Ready to Reconcile and Close-Out Transaction",DIR("B")="NO",DIR(0)="Y" "RTN","RMPR4E21",40,0) S DIR("?")="You may now Close-out and Post this Transaction. Please answer Yes or No." "RTN","RMPR4E21",41,0) D ^DIR I Y["^"!($D(DTOUT)) W !,"Transaction NOT Closed-Out!" S:$D(^TMP("RM",$J)) RFLG=1 G:$D(RFLG) POST1 G KTMP "RTN","RMPR4E21",42,0) I Y=1 G POST1 "RTN","RMPR4E21",43,0) ;***add/edit transaction********************************************** "RTN","RMPR4E21",44,0) L1 K DIR S DIR(0)="FO",DIR("A")="Select ITEM" "RTN","RMPR4E21",45,0) S DIR("?")="^S RFL=1 D ZDSP^RMPR421A" "RTN","RMPR4E21",46,0) D ^DIR G:(Y="^")!(Y="") DS G:$D(DTOUT) L "RTN","RMPR4E21",47,0) G:$D(DIRUT)&($D(^RMPR(664,RMPRA,1))) L "RTN","RMPR4E21",48,0) S DIC=661,DIC(0)="ENMZ" D ^DIC I +Y'>0 W !,"** No Item selected.." G DS "RTN","RMPR4E21",49,0) G:$D(DTOUT)!$D(DUOUT) L "RTN","RMPR4E21",50,0) D PROC G L1 "RTN","RMPR4E21",51,0) ;***process items******************************************************* "RTN","RMPR4E21",52,0) PROC N NEW S HY=+Y I $D(^RMPR(664,RMPRA,1,"B",+Y)) S DA=$O(^RMPR(664,RMPRA,1,"B",+Y,0)) G CHK "RTN","RMPR4E21",53,0) FILE S Y=HY,NUM=$P(^RMPR(664,RMPRA,1,0),U,4)+1,$P(^(0),U,4)=NUM,$P(^(0),U,3)=$P(^(0),U,3)+1,^RMPR(664,RMPRA,1,NUM,0)=+Y,DA=NUM,^RMPR(664,RMPRA,1,"B",+Y,NUM)="" S NEW=1 "RTN","RMPR4E21",54,0) ENT K DR,DQ S DA(1)=RMPRA,DIE="^RMPR(664,"_RMPRA_",1," "RTN","RMPR4E21",55,0) ;S DR=$S($D(NEW):"",1:".01;") "RTN","RMPR4E21",56,0) I '$D(NEW),($P(^RMPR(664,RMPRA,1,DA,0),U,7)="") S $P(^(0),U,7)=$P(^(0),U,3) "RTN","RMPR4E21",57,0) S:'$D(NEW) RMDACA=$P(^RMPR(664,RMPRA,1,DA,0),U,13) "RTN","RMPR4E21",58,0) S R4DA=DA "RTN","RMPR4E21",59,0) S DR="8;S RMTYPE=$P(^RMPR(664,RMPRA,1,R4DA,0),U,9);9;.01;" "RTN","RMPR4E21",60,0) S DR=DR_"16R;1;14;17;13;15.4;15;15.6;3R;" ;RMPR*3.0*182 "RTN","RMPR4E21",61,0) I $D(NEW) S DR=DR_"2R~UNIT COST;" "RTN","RMPR4E21",62,0) E S DR=DR_"6R;",RHCNEW=$P($G(^RMPR(664,RMPRA,1,R4DA,0)),U,16) "RTN","RMPR4E21",63,0) S DR=DR_"4R~UNIT OF ISSUE;7;11////C" D ^DIE "RTN","RMPR4E21",64,0) I $D(NEW) S:$G(DA) ^TMP("RM",$J,"N",R4DA)=$G(^RMPR(664,RMPRA,1,R4DA,0)) "RTN","RMPR4E21",65,0) E S:'$G(DA)&(RMDACA) ^TMP("RM",$J,"C",RMDACA)="" I $G(DA) S ^TMP("RM",$J,"E",DA)=$G(^RMPR(664,RMPRA,1,DA,0)),RHCOLD=$P(^RMPR(664,RMPRA,1,DA,0),U,16),RD660=$P(^(0),U,13) I RHCNEW'=RHCOLD D "RTN","RMPR4E21",66,0) .S RHCED=1 "RTN","RMPR4E21",67,0) .I $D(RD660)&(RD660) S DIE="^RMPR(660,",DA=RD660,DR="4.5///^S X=$G(RHCOLD)" D ^DIE "RTN","RMPR4E21",68,0) I $D(R4DA),$P($G(^RMPR(664,RMPRA,1,R4DA,0)),U,10)=4 S DA=R4DA,DR=10 D ^DIE "RTN","RMPR4E21",69,0) ;check for Type of Transaction and update the cpt modifier. "RTN","RMPR4E21",70,0) I $D(R4DA),$D(RMTYPE) S RDATA=RMTYPE_"^"_RMPRA_"^"_R4DA D CHKCPT^RMPR4UTL(RDATA) "RTN","RMPR4E21",71,0) Q:$D(DTOUT) K NUM,R4DA,DA,Y,DR,RD660,RHCOLD,RHCNEW,DIE,RDATA,RMTYPE Q "RTN","RMPR4E21",72,0) CHK ;ADD DUPLICATE LINE ITEM "RTN","RMPR4E21",73,0) K DIR,Y S DIR(0)="S^Y:YES;N:NO",DIR("A")="DO YOU WANT TO ADD A DUPLICATE ITEM?",DIR("B")="NO" D ^DIR Q:$D(DIRUT)!($D(DTOUT)) I (X["Y")!(X["y") G FILE "RTN","RMPR4E21",74,0) S RD=0 F RDA=0:0 S RDA=$O(^RMPR(664,RMPRA,1,"B",HY,RDA)) Q:RDA'>0 S RD=RD+1 "RTN","RMPR4E21",75,0) LKP I RD>1 D Q:$D(DIRUT)!$D(DTOUT) I '$D(RD(+Y)) W $C(7) G LKP "RTN","RMPR4E21",76,0) .F RDA=0:0 S RDA=$O(^RMPR(664,RMPRA,1,"B",HY,RDA)) Q:RDA'>0 S RD(RDA)=^RMPR(664,RMPRA,1,RDA,0) W !?5,RDA,?10,$P(^PRC(441,$P(^RMPR(661,$P(RD(RDA),U),0),U),0),U,2)," $",$S($P(RD(RDA),U,7)'="":$P(RD(RDA),U,7),1:$P(RD(RDA),U,3)) "RTN","RMPR4E21",77,0) .K DIR,Y S DIR(0)="N" D ^DIR I +Y S DA=+Y "RTN","RMPR4E21",78,0) G ENT "RTN","RMPR4E21",79,0) ; "RTN","RMPR4E21",80,0) DS ;**** update shipping cost, % discount and bank authorization ******** "RTN","RMPR4E21",81,0) S (RMPERF,RMBANF,RMSHIF)=0 "RTN","RMPR4E21",82,0) I $P(^RMPR(664,RMPRA,0),U,11)="",$P(^(0),U,10) S $P(^(0),U,11)=$P(RM(RMPRA,0),U,10) "RTN","RMPR4E21",83,0) S DA=RMPRA,DIE="^RMPR(664,",DR="12;17;26" D ^DIE "RTN","RMPR4E21",84,0) S:+$P(^RMPR(664,RMPRA,0),U,11)=0 $P(^(0),U,11)=0 "RTN","RMPR4E21",85,0) I RMPER'=$P(^RMPR(664,RMPRA,2),U,6) S RMPERF=1 "RTN","RMPR4E21",86,0) I RMBAN'=$P(^RMPR(664,RMPRA,4),U,2) S RMBANF=1 "RTN","RMPR4E21",87,0) I RMSHI'=$P(^RMPR(664,RMPRA,0),U,11)!($P(^(0),U,11)=0&$P(^(0),U,12)) S RMSHIF=1 "RTN","RMPR4E21",88,0) CHK1 ;delete imcomplete items "RTN","RMPR4E21",89,0) S DIK="^RMPR(664,"_RMPRA_",1,",DA(1)=RMPRA F I=0:0 S I=$O(^RMPR(664,RMPRA,1,I)) Q:I'>0 S RMPRI=$G(^(I,0)) I $P(RMPRI,U,3)=""!($P(RMPRI,U,4)="")!($P(RMPRI,U,5)="") S DA=I D ^DIK "RTN","RMPR4E21",90,0) G L ;go back to select ITEM "RTN","RMPR4E21",91,0) ;************************************************************* "RTN","RMPR4E21",92,0) POST1 ;SET AMOUNT FOR IFCAP AMENDMENT. "RTN","RMPR4E21",93,0) S (R1,RMPR("AMT"),AMT,DCT,RMPRTO)=0 "RTN","RMPR4E21",94,0) I $D(^RMPR(664,RMPRA,2)),$P(^(2),U,6) S DCT=$P(^(2),U,6),DCT=DCT/100 "RTN","RMPR4E21",95,0) F RI=0:0 S RI=$O(^RMPR(664,RMPRA,1,RI)) Q:RI'>0 D "RTN","RMPR4E21",96,0) .N RMACT "RTN","RMPR4E21",97,0) .S RMX=$G(^RMPR(664,RMPRA,1,RI,0)),RMACT=$P(RMX,U,7),RMQTY=$P(RMX,U,4) "RTN","RMPR4E21",98,0) .I DCT S RMTOT=$S(RMACT=0!(RMACT>0):RMACT-$J(RMACT*DCT,0,2)*RMQTY,1:$P(RMX,U,3)-$J($P(RMX,U,3)*DCT,0,2)*RMQTY) "RTN","RMPR4E21",99,0) .I 'DCT S RMTOT=$S(RMACT=0!(RMACT>0):RMACT*RMQTY,1:$P(RMX,U,3)*RMQTY) "RTN","RMPR4E21",100,0) .S RMPR("AMT")=RMPR("AMT")+RMTOT,RMPRTO=RMPR("AMT") "RTN","RMPR4E21",101,0) S RMPRSH=$S($P(^RMPR(664,RMPRA,0),U,11)=0:0,$P(^RMPR(664,RMPRA,0),U,11):$P(^(0),U,11),$P(^RMPR(664,RMPRA,0),U,10):$P(^(0),U,10),1:"") "RTN","RMPR4E21",102,0) D CHECK^RMPRCT I '$D(RMPRTO) W !,"***** NOT CLOSED-OUT !!!!" G KTMP "RTN","RMPR4E21",103,0) ;************************************************************** "RTN","RMPR4E21",104,0) ;check 4;3,2;8&2;9&4;6 call PRCH7C if needed "RTN","RMPR4E21",105,0) ;if total amount has not changed, then don't need to call ammend "RTN","RMPR4E21",106,0) ;if it is an early record with no ifcap order then don't call ammend "RTN","RMPR4E21",107,0) ;set the reprint flag "RTN","RMPR4E21",108,0) I $FN($P(^RMPR(664,RMPRA,4),U,3),"P",2)'=$FN(RMPRTO+RMPRSH,"P",2)&($P(^(2),U,9)="")!($P(^(2),U,9)'="")&($FN($P(^(2),U,9),"P",2)'=$FN(RMPRTO+RMPRSH,"P",2)) D I (X=0)&'$D(^TMP("RM",$J)) W !!,"**** NOT CLOSED-OUT!! ****" G KTMP "RTN","RMPR4E21",109,0) .;call IFCAP AMMEND "RTN","RMPR4E21",110,0) .S RMPR442=$P(^RMPR(664,RMPRA,4),U,6) I RMPR442="" Q "RTN","RMPR4E21",111,0) .D AMEND^PRCH7C(RMPR442,RMPRTO+RMPRSH) "RTN","RMPR4E21",112,0) .I X=1 S $P(^RMPR(664,RMPRA,2),U,8)=DUZ,$P(^RMPR(664,RMPRA,2),U,9)=RMPRTO+RMPRSH,$P(^RMPR(664,RMPRA,2),U,10)=1 "RTN","RMPR4E21",113,0) .I X'=1 S $P(^RMPR(664,RMPRA,2),U,10)="" "RTN","RMPR4E21",114,0) ;do posting to 660 "RTN","RMPR4E21",115,0) I $D(^TMP("RM",$J))!$G(RMSHIF)!$G(RMPERF)!$G(RMBANF) D POST2^RMPR4M "RTN","RMPR4E21",116,0) I $D(RMPRWO),$D(^RMPR(664.2,+RMPRWO,0)) S $P(^("AM"),U,2)=1 S $P(^RMPR(664.2,+RMPRWO,0),U,7)=$P(^(0),U,7)+RMPRSH D DA0^RMPR29M(RMPRDA,RMPRA),POST^RMPR29U "RTN","RMPR4E21",117,0) G:$D(RFLG) EXIT "RTN","RMPR4E21",118,0) ;go to exit in above line if not close-out. "RTN","RMPR4E21",119,0) ;close-out remarks "RTN","RMPR4E21",120,0) W ! S DIE="^RMPR(664,",DA=RMPRA,DR="8.1" D ^DIE S RMPRCC=$P($G(^RMPR(664,RMPRA,2)),U,3) "RTN","RMPR4E21",121,0) F S R1=$O(^RMPR(664,RMPRA,1,R1)) Q:R1'>0 I $D(^(R1,0)) D "RTN","RMPR4E21",122,0) .N RM660 "RTN","RMPR4E21",123,0) .S RM660=$P($G(^(0)),U,13) I RM660,$P($G(^RMPR(660,RM660,0)),U,18)'[RMPRCC S $P(^(0),U,18)=$P(^(0),U,18)_" "_RMPRCC "RTN","RMPR4E21",124,0) ; "RTN","RMPR4E21",125,0) EX ;***reindex record in 664 here "RTN","RMPR4E21",126,0) L -^RMPR(664,RMPRA,0) "RTN","RMPR4E21",127,0) ;IFCAP final charge payment "RTN","RMPR4E21",128,0) S RMPR442=$P(^RMPR(664,RMPRA,4),U,6) ;don't call recon if it is an early record, no ifcap order. "RTN","RMPR4E21",129,0) D:RMPR442'="" RECON^PRCH7C(RMPR442,DUZ) "RTN","RMPR4E21",130,0) I (X=0)&(RMPR442'="") W !!,"**** TRANSACTION NOT CLOSED-OUT!! ****" G EX1 "RTN","RMPR4E21",131,0) S $P(^RMPR(664,RMPRA,4),U,4)=RMPRTO+RMPRSH "RTN","RMPR4E21",132,0) ;set close out date "RTN","RMPR4E21",133,0) D NOW^%DTC S $P(^RMPR(664,RMPRA,0),U,8)=% "RTN","RMPR4E21",134,0) ;set closed by "RTN","RMPR4E21",135,0) S $P(^RMPR(664,RMPRA,2),U,7)=DUZ,DA=$P(^RMPR(664,RMPRA,0),U,12) "RTN","RMPR4E21",136,0) I DA'="" S $P(^RMPR(660,DA,0),U,12)=%,DIK="^RMPR(660," D IX1^DIK "RTN","RMPR4E21",137,0) S RMPR660=0,DA="",DIK="^RMPR(660," "RTN","RMPR4E21",138,0) F S RMPR660=$O(^RMPR(664,RMPRA,1,RMPR660)) Q:RMPR660'>0 D "RTN","RMPR4E21",139,0) .;get pointer from item mult "RTN","RMPR4E21",140,0) .S DA=$P(^RMPR(664,RMPRA,1,RMPR660,0),U,13) "RTN","RMPR4E21",141,0) .;set delivery date "RTN","RMPR4E21",142,0) .I DA'="" S $P(^RMPR(660,DA,0),U,12)=DT D IX1^DIK "RTN","RMPR4E21",143,0) .;Patch #78 - Get IFCAP Transaction Date and prompt for Shipment Date "RTN","RMPR4E21",144,0) .I DA'="" S SKPSHDT=1 D ^RMPR4E23 K SKPSHDT "RTN","RMPR4E21",145,0) EX1 ; "RTN","RMPR4E21",146,0) I $D(RM60LINK) D "RTN","RMPR4E21",147,0) . F I=0:0 S I=$O(RM60LINK(I)) Q:I'>0 D "RTN","RMPR4E21",148,0) .. I '$D(^RMPR(660,I,0)) K RM60LINK(I) "RTN","RMPR4E21",149,0) ;added by #62 "RTN","RMPR4E21",150,0) D:$D(RM68FG)=1 AUTO^RMPRPCEL D:$D(RM68FG)>1 MAN^RMPRPCEL "RTN","RMPR4E21",151,0) ; "RTN","RMPR4E21",152,0) D EXIT "RTN","RMPR4E21",153,0) W !!,"Enter Next Transaction to Close-out, or to continue." "RTN","RMPR4E21",154,0) G CL "RTN","RMPR4E21",155,0) ; "RTN","RMPR4E21",156,0) EXIT ;KILL VARIABLES AND EXIT ROUTINE "RTN","RMPR4E21",157,0) L:$D(RMPRA) -^RMPR(664,RMPRA,0) "RTN","RMPR4E21",158,0) K ^TMP($J),^TMP("RM",$J) ;RMPR*3.0*182 "RTN","RMPR4E21",159,0) K RGRP,RGRP1,RGRPP,RMBAN,RMBANF "RTN","RMPR4E21",160,0) N RMPR,RMPRSITE D KILL^XUSCLEAN "RTN","RMPR4E21",161,0) Q "RTN","RMPR4E21",162,0) ; "RTN","RMPR4E21",163,0) KTMP S DIK="^RMPR(664,"_RMPRA_",1,",DA(1)=RMPRA F I=0:0 S I=$O(^TMP("RM",$J,"N",I)) Q:I'>0 S DA=I D ^DIK "RTN","RMPR4E21",164,0) S %X="^TMP("_"""RM"""_",$J,RMPRA,",%Y="^RMPR(664,RMPRA," D %XY^%RCR G EX1 "RTN","RMPR4E21",165,0) BRK W !,$C(7),"INCOMPLETE RECORD..file 664..entry..",RMPRA,"...PLEASE CONTACT YOUR IRM or CANCEL THIS ENTRY!!!" G EX1 "RTN","RMPR4E21",166,0) UNK W !,$C(7),"UNKNOWN 2319 RECORD TO UPDATE, 2319 NOT UPDATED!" G EXIT "RTN","RMPR4E21",167,0) M4 W !,$C(7),"This Transaction has already been CLOSED!" G EXIT "RTN","RMPR4E21",168,0) M6 W !,$C(7),"This Transaction has been CANCELED!" G EXIT "RTN","RMPR4LI") 0^3^B18898445^B14468243 "RTN","RMPR4LI",1,0) RMPR4LI ;PHX/HNB,RVD-DISPLAY ITEMS ON PURCHASE CARD TRANSACTION ;3/1/1996 "RTN","RMPR4LI",2,0) ;;3.0;PROSTHETICS;**3,12,19,20,28,30,41,90,182**;Feb 09, 1996;Build 13 "RTN","RMPR4LI",3,0) ;pass RMPRA "RTN","RMPR4LI",4,0) ; "RTN","RMPR4LI",5,0) ;RMPR*3.0*182 Add Contract, Model and Lot number to display "RTN","RMPR4LI",6,0) ; "RTN","RMPR4LI",7,0) S:'$D(RMPRDELN) RMPRDELN="" S (RMPRI,RMPRCNT)=0,RMPRX="" D HOME^%ZIS W @IOF S:'$D(RMPRSER) RMPRSER="" "RTN","RMPR4LI",8,0) W !?5,$G(RMPRSSNE) "RTN","RMPR4LI",9,0) W ?55,"Purchase Card",! "RTN","RMPR4LI",10,0) W ?5,$$STA^RMPRUTIL,"-",$P(^RMPR(664,RMPRA,4),U,5) "RTN","RMPR4LI",11,0) I DUZ=$P(^RMPR(664,RMPRA,0),U,9)!($D(^XUSEC("RMPR FCP MANAGER",DUZ))) W ?55,$$DEC($P(^RMPR(664,RMPRA,4),U,1),$P(^RMPR(664,RMPRA,0),U,9),RMPRA) "RTN","RMPR4LI",12,0) E W ?55,"encrypted" "RTN","RMPR4LI",13,0) W ! "RTN","RMPR4LI",14,0) N RBO S RBO=0 "RTN","RMPR4LI",15,0) W !,RMPR("L") "RTN","RMPR4LI",16,0) LI F S RMPRI=$O(^RMPR(664,RMPRA,1,RMPRI)) Q:RMPRI'>0 D G:$G(RMPRX)["^" EXIT "RTN","RMPR4LI",17,0) .S RMPRCNT=RMPRCNT+1 "RTN","RMPR4LI",18,0) .S RMPRI1=^RMPR(664,RMPRA,1,RMPRI,0) "RTN","RMPR4LI",19,0) .D PRT "RTN","RMPR4LI",20,0) I $D(^RMPR(664,RMPRA,1)) W !!,?25,"SUB TOTAL: ",?65,"$",$J(RBO,7,2) "RTN","RMPR4LI",21,0) I $D(^RMPR(664,RMPRA,2)),$P(^(2),U,6) S DCT=$P(^(2),U,6),DCT=DCT/100 "RTN","RMPR4LI",22,0) I $D(DCT) D "RTN","RMPR4LI",23,0) .W !!,?25,"% DISCOUNT: " "RTN","RMPR4LI",24,0) .Q:'$D(DCT) "RTN","RMPR4LI",25,0) .W DCT*100 "RTN","RMPR4LI",26,0) .S DCTT=$J(RBO*DCT,7,2) "RTN","RMPR4LI",27,0) .W ?65,"$",DCTT "RTN","RMPR4LI",28,0) .S DCTT=$TR(DCTT," ","") "RTN","RMPR4LI",29,0) .S RBO=RBO-DCTT "RTN","RMPR4LI",30,0) .K DCT,DCTT "RTN","RMPR4LI",31,0) W !?25,"SHIPPING CHARGE: " "RTN","RMPR4LI",32,0) S R2=$S($P(^RMPR(664,RMPRA,0),U,11)]"":$P(^(0),U,11),$P(^(0),U,10):$P(^(0),U,10),1:"") W ?65,"$",$J(R2,7,2) W ! "RTN","RMPR4LI",33,0) W !,?25,"TOTAL COST: ",?65,"$",$J(R2+RBO,7,2) "RTN","RMPR4LI",34,0) W !,?5,"BANK AUTHORIZATION: ",$P(^RMPR(664,RMPRA,4),U,2) "RTN","RMPR4LI",35,0) G EXIT "RTN","RMPR4LI",36,0) PRT I RMPRCNT<0 W !,"NO ITEMS ON FILE" Q "RTN","RMPR4LI",37,0) W !!?5,"ITEM: " "RTN","RMPR4LI",38,0) S RMPRIT=$P(RMPRI1,U,1),RMPRIT1=$P(^RMPR(661,RMPRIT,0),U,1) "RTN","RMPR4LI",39,0) W $P(^PRC(441,RMPRIT1,0),U,1)," ",$P(^(0),U,2)," ",?45,"AMIS: " S RMPRAMIS=$S($P(RMPRI1,U,9)'="X":$P(^RMPR(661,RMPRIT,0),U,3),1:$P(^RMPR(661,RMPRIT,0),U,4)) "RTN","RMPR4LI",40,0) W $S(RMPRAMIS="":"NO CODE FOR THIS ITEM",1:$P(^RMPR(663,RMPRAMIS,0),U,1)) "RTN","RMPR4LI",41,0) W !,?5,"VENDOR TRACKING: ",$P($G(^RMPR(664,RMPRA,1,RMPRI,4)),U,1) "RTN","RMPR4LI",42,0) S RCPT=$P(^RMPR(664,RMPRA,1,RMPRI,0),U,16) "RTN","RMPR4LI",43,0) S:RCPT RMPRCPT=$G(^RMPR(661.1,RCPT,0)) "RTN","RMPR4LI",44,0) I $D(RMPRCPT) W !,?5,"PSAS HCPCS CODE: ",$P(RMPRCPT,U,1),?31,$P(RMPRCPT,U,2) "RTN","RMPR4LI",45,0) K RCPT,RMPRCPT "RTN","RMPR4LI",46,0) W !,?5,"CPT MODIFIER: ",$P($G(^RMPR(664,RMPRA,1,RMPRI,4)),U,2) "RTN","RMPR4LI",47,0) I $P(^RMPR(664,RMPRA,1,RMPRI,0),U,8)'="" W !?5,"REMARKS: ",$P(^(0),U,8) "RTN","RMPR4LI",48,0) I $D(RMPRF),RMPRF=2 W !!?5,"DELIVER TO: ",RMPRDELN "RTN","RMPR4LI",49,0) W !!?5,"DESCRIPTION: ",$P(RMPRI1,U,2) "RTN","RMPR4LI",50,0) W !?5,"CONTRACT #: " S RMPRVAL=$S($P(^RMPR(664,RMPRA,1,RMPRI,0),U,14)]"":$P(^(0),U,14),$D(^RMPR(660,+$P(^(0),U,13),2)):$P(^(2),U,9),1:"") W RMPRVAL ;RMPR*3*182 "RTN","RMPR4LI",51,0) W !?5,"MODEL: " S RMPRVAL=$S($P($G(^RMPR(664,RMPRA,1,RMPRI,2)),U,2)]"":$P(^(2),U,2),$D(^RMPR(660,+$P(^(0),U,13),9)):$P(^(9),U,2),1:"") W RMPRVAL "RTN","RMPR4LI",52,0) W !?5,"SERIAL NUMBER: " S RMPRSER=$S($P(^RMPR(664,RMPRA,1,RMPRI,0),U,15)]"":$P(^(0),U,15),$D(^RMPR(660,+$P(^(0),U,13),0)):$P(^(0),U,11),1:"") W RMPRSER ;RMPR*3*182 "RTN","RMPR4LI",53,0) W !?5,"LOT #: " S RMPRVAL=$S($P($G(^RMPR(664,RMPRA,1,RMPRI,2)),U,3)]"":$P(^(2),U,3),$D(^RMPR(660,+$P(^(0),U,13),0)):$P(^(0),U,24),1:"") W RMPRVAL ;RMPR*3*182 "RTN","RMPR4LI",54,0) ;W !?5,"UNIT COST: ",$J($S($P(RMPRI1,U,7):$P(RMPRI1,U,7),1:$P(RMPRI1,U,3)),0,2),?25,"UNIT OF ISSUE: " "RTN","RMPR4LI",55,0) K RMPRVAL "RTN","RMPR4LI",56,0) W !,?5,"UNIT COST: " S R1=$P(RMPRI1,U,7) S:R1=""!(R1<0) R1=$P(RMPRI1,U,3) W R1,?25,"UNIT OF ISSUE: " "RTN","RMPR4LI",57,0) S RMPRU=$P(RMPRI1,U,5) W:RMPRU'="" $P(^PRCD(420.5,RMPRU,0),U,1),?45,"QTY: ",$P(RMPRI1,U,4),?55,"ITEM COST: " "RTN","RMPR4LI",58,0) ;S R1=$S($P(RMPRI1,U,7):$P(RMPRI1,U,7),1:$P(RMPRI1,U,3)),R2=$P(RMPRI1,U,4),RBO=RBO+(R1*R2) W $J(R1*R2,0,2) "RTN","RMPR4LI",59,0) S R2=$P(RMPRI1,U,4) "RTN","RMPR4LI",60,0) S RBO=RBO+(R1*R2) W $J(R1*R2,0,2) "RTN","RMPR4LI",61,0) W !?5,"TYPE: ",$S($P(RMPRI1,U,9)="X":"REPAIR",$P(RMPRI1,U,9)="I":"INITIAL",$P(RMPRI1,U,9)="R":"REPLACE",$P(RMPRI1,U,9)="S":"SPARE",$P(RMPRI1,U,9)=5:"RENTAL",1:"") "RTN","RMPR4LI",62,0) W ?25,"CATEGORY: ",$S($P(RMPRI1,U,10)=1:"SC/OP",$P(RMPRI1,U,10)=2:"SC/IP",$P(RMPRI1,U,10)=3:"NSC/IP",$P(RMPRI1,U,10)=4:"NSC/OP",1:"") "RTN","RMPR4LI",63,0) W ?44,"SPECIAL CATEGORY: " "RTN","RMPR4LI",64,0) W $S($P(RMPRI1,U,11)=1:"SPEC/LEG",$P(RMPRI1,U,11)=2:"A&A",$P(RMPRI1,U,11)=3:"PHC",$P(RMPRI1,U,11)=4:"ELIGIBILITY REFORM",1:"") "RTN","RMPR4LI",65,0) ASK I $Y>17 R !!,"Enter '^' to Quit Display, to Continue : ",RMPRX:DTIME S:'$T RMPRX="^" Q:RMPRX="^" "RTN","RMPR4LI",66,0) W:$Y>17 @IOF "RTN","RMPR4LI",67,0) Q "RTN","RMPR4LI",68,0) EXIT K RMPRI1,R1,R2,ON,OFF Q "RTN","RMPR4LI",69,0) ; "RTN","RMPR4LI",70,0) ENC(X,X1,X2) ;encrypt "RTN","RMPR4LI",71,0) ;x is string to encrypt "RTN","RMPR4LI",72,0) ;x1 duz "RTN","RMPR4LI",73,0) ;x2 is ien to file 664 "RTN","RMPR4LI",74,0) D EN^XUSHSHP Q X "RTN","RMPR4LI",75,0) DEC(X,X1,X2) ;decript "RTN","RMPR4LI",76,0) ;x is encrypted string "RTN","RMPR4LI",77,0) ;x1 is duz "RTN","RMPR4LI",78,0) ;x2 is ien to file 664 "RTN","RMPR4LI",79,0) D DE^XUSHSHP Q X "RTN","RMPR4LI",80,0) ;end "RTN","RMPREO") 0^1^B12735146^B10452539 "RTN","RMPREO",1,0) RMPREO ;HINES/HNC SUSPENSE PROCESSING ; 10-MARCH-2005 "RTN","RMPREO",2,0) ;;3.0;PROSTHETICS;**45,55,83,182**;Feb 09, 1996;Build 13 "RTN","RMPREO",3,0) ; "RTN","RMPREO",4,0) ;HNC #83, add free text ordering provider 3/10/05 "RTN","RMPREO",5,0) ; "RTN","RMPREO",6,0) ;RMPR*3.0*182 Add Urgency flag to List Manager Suspense "RTN","RMPREO",7,0) ; List and print template RPMR VIEW REQUEST "RTN","RMPREO",8,0) ; for action 'View Request' "RTN","RMPREO",9,0) ; Also, adds check that will insure variable "RTN","RMPREO",10,0) ; RMPRSITE is undefined rather than test for "RTN","RMPREO",11,0) ; array RMPR defined as a viable site exists "RTN","RMPREO",12,0) ; in RMPRSITE. "RTN","RMPREO",13,0) ; "RTN","RMPREO",14,0) EN ; -- main entry point for RMPREO "RTN","RMPREO",15,0) D ^%ZISC "RTN","RMPREO",16,0) N STRING,CLREND,COLUMN,LINE,ON,OFF "RTN","RMPREO",17,0) ;get patient to test with "RTN","RMPREO",18,0) K ^TMP($J,"RMPREO") "RTN","RMPREO",19,0) K ^TMP($J,"RMPREOEE") "RTN","RMPREO",20,0) ;ask station "RTN","RMPREO",21,0) I '$D(RMPRSITE) D DIV4^RMPRSIT Q:$D(X) ;RMPR*3.0*182 "RTN","RMPREO",22,0) I '$D(RMPRDFN) D GETPAT^RMPRUTIL Q:'$D(RMPRDFN) "RTN","RMPREO",23,0) D EN^VALM("RMPREO") "RTN","RMPREO",24,0) Q "RTN","RMPREO",25,0) ; "RTN","RMPREO",26,0) HDR ; -- header code "RTN","RMPREO",27,0) N VA,VADM "RTN","RMPREO",28,0) S DFN=RMPRDFN "RTN","RMPREO",29,0) D DEM^VADPT "RTN","RMPREO",30,0) ;S VALMHDR(1)="Suspense Processing" "RTN","RMPREO",31,0) S VALMHDR(1)="Open/Pending/Closed Suspense for "_$$LOWER^VALM1(VADM(1))_" ("_$P(VADM(2),U,2)_") '!' = STAT" ;RMPR*3.0*182 "RTN","RMPREO",32,0) D KVAR^VADPT "RTN","RMPREO",33,0) Q "RTN","RMPREO",34,0) ; "RTN","RMPREO",35,0) INIT ; -- init variables and list array "RTN","RMPREO",36,0) K ^TMP($J,"RMPREO"),^TMP($J,"RMPREOEE") "RTN","RMPREO",37,0) D HDR "RTN","RMPREO",38,0) N RMPRA,CDATE,LINE,X,RMPRSTAT ;RMPR*3*182 "RTN","RMPREO",39,0) ;start loop "RTN","RMPREO",40,0) ; "RTN","RMPREO",41,0) K ADATE,PDAY "RTN","RMPREO",42,0) S RMPRA="",VALMCNT=0,RRX="" "RTN","RMPREO",43,0) ;reverse order display "RTN","RMPREO",44,0) F S RMPRA=$O(^RMPR(668,"C",RMPRDFN,RMPRA),-1) Q:RMPRA="" D "RTN","RMPREO",45,0) .I $P(^RMPR(668,RMPRA,0),U,10)="X" Q "RTN","RMPREO",46,0) .S VALMCNT=VALMCNT+1,LINE=VALMCNT "RTN","RMPREO",47,0) .S RRX=$$SETFLD^VALM1(LINE,RRX,"LINE") "RTN","RMPREO",48,0) .S RMPRSTAT="" I $P($G(^RMPR(668,RMPRA,8)),U,5)["STAT" S RMPRSTAT="!" ;RMPR*3*182 "RTN","RMPREO",49,0) .S CDATE=$P(^RMPR(668,RMPRA,0),U,1),CDATE=$$DAT1^RMPRUTL1(CDATE)_RMPRSTAT ;RMPR*3*182 "RTN","RMPREO",50,0) .S RRX=$$SETFLD^VALM1(CDATE,RRX,"DATE") "RTN","RMPREO",51,0) .S WHO1="" "RTN","RMPREO",52,0) .I $P(^RMPR(668,RMPRA,0),U,11)'="" S WHO1=$$WHO^RMPREOU($P(^RMPR(668,RMPRA,0),U,11),12,RMPRA) "RTN","RMPREO",53,0) .I $P($G(^RMPR(668,RMPRA,"IFC1")),U,3)'="" S WHO1=$$WHO^RMPREOU("",12,RMPRA) "RTN","RMPREO",54,0) .; "RTN","RMPREO",55,0) .S RRX=$$SETFLD^VALM1(WHO1,RRX,"WHO") "RTN","RMPREO",56,0) .K WHO,WHO1 "RTN","RMPREO",57,0) .;type "RTN","RMPREO",58,0) .S TYPE=$$TYPE^RMPREOU(RMPRA,8) "RTN","RMPREO",59,0) .S RRX=$$SETFLD^VALM1(TYPE,RRX,"TYPE") "RTN","RMPREO",60,0) .;display description if manual "RTN","RMPREO",61,0) .; "RTN","RMPREO",62,0) .S RRX=$$SETFLD^VALM1($$DES^RMPREOU(RMPRA,22),RRX,"DES") "RTN","RMPREO",63,0) .;init activation date "RTN","RMPREO",64,0) .S ADATE="",PDAY="",WRKDAY="" "RTN","RMPREO",65,0) .S ADATE=$P(^RMPR(668,RMPRA,0),U,9) "RTN","RMPREO",66,0) .I ADATE'="" S (PDAY,WRKDAY)=$$WRKDAY^RMPREOU(RMPRA) "RTN","RMPREO",67,0) .I ADATE="" S (PDAY,WRKDAY)=$$CWRKDAY^RMPREOU(RMPRA) "RTN","RMPREO",68,0) .S RRX=$$SETFLD^VALM1($$DAT1^RMPRUTL1(ADATE),RRX,"INITIAL ACTION DATE") "RTN","RMPREO",69,0) .I ADATE'="" S CDAY=$$PDAY^RMPREOU(RMPRA) I CDAY>7 S PDAY="*"_WRKDAY "RTN","RMPREO",70,0) .I ADATE=""&(WRKDAY>5) S PDAY="@"_WRKDAY "RTN","RMPREO",71,0) .S RRX=$$SETFLD^VALM1(PDAY,RRX,"PDAY") "RTN","RMPREO",72,0) .K ADATE,PDAY,WRKDAY,CDAY "RTN","RMPREO",73,0) .;S R660="" "RTN","RMPREO",74,0) .;F S R660=$O(^RMPR(668,RMPRA,6,"B",R660)) Q:R660'>0 D "RTN","RMPREO",75,0) .; .S RRX=$$SETFLD^VALM1($$ITEM^RMPREOU(R660,17),RRX,"ITEM") "RTN","RMPREO",76,0) .S RRX=$$SETFLD^VALM1($$STATUS^RMPREOU(RMPRA,7),RRX,"STATUS") "RTN","RMPREO",77,0) .S ^TMP($J,"RMPREO",LINE,0)=RRX "RTN","RMPREO",78,0) .S ^TMP($J,"RMPREOEE",LINE,0)=RMPRA "RTN","RMPREO",79,0) Q "RTN","RMPREO",80,0) ; "RTN","RMPREO",81,0) ; "RTN","RMPREO",82,0) SET(STRING,LINE,COLUMN,CLREND,ON,OFF) ;set array "RTN","RMPREO",83,0) I '$D(@VALMAR@(LINE,0)) D SET^VALM10(LINE,$J("",80)) "RTN","RMPREO",84,0) D SET^VALM10(LINE,$$SETSTR^VALM1(STRING,@VALMAR@(LINE,0),COLUMN,CLREND)) "RTN","RMPREO",85,0) I $G(ON)]""!($G(OFF)]"") D CNTRL^VALM10(LINE,COLUMN,$L(STRING),ON,OFF) "RTN","RMPREO",86,0) Q "RTN","RMPREO",87,0) ; "RTN","RMPREO",88,0) ; "RTN","RMPREO",89,0) HELP ; -- help code "RTN","RMPREO",90,0) S X="?" D DISP^XQORM1 W !! "RTN","RMPREO",91,0) Q "RTN","RMPREO",92,0) ; "RTN","RMPREO",93,0) EXIT ; -- exit code "RTN","RMPREO",94,0) ;NOT XUSCLEAN "RTN","RMPREO",95,0) K ^TMP($J,"RMPREO") "RTN","RMPREO",96,0) K RMPRDFN "RTN","RMPREO",97,0) Q "RTN","RMPREO",98,0) ; "RTN","RMPREO",99,0) EXPND ; -- expand code "RTN","RMPREO",100,0) Q "RTN","RMPREO",101,0) ; "VER") 8.0^22.2 "BLD",9746,6) ^162 **END** **END**