Released RMPR*3*60 SEQ #113 Extracted from mail message **KIDS**:RMPR*3.0*60^ **INSTALL NAME** RMPR*3.0*60 "BLD",3182,0) RMPR*3.0*60^PROSTHETICS^0^3070709^y "BLD",3182,4,0) ^9.64PA^668^2 "BLD",3182,4,660,0) 660 "BLD",3182,4,660,2,0) ^9.641^660^1 "BLD",3182,4,660,2,660,0) RECORD OF PROS APPLIANCE/REPAIR (File-top level) "BLD",3182,4,660,2,660,1,0) ^9.6411^89.3^5 "BLD",3182,4,660,2,660,1,11,0) FORM REQUESTED ON "BLD",3182,4,660,2,660,1,34,0) OIF/OEF "BLD",3182,4,660,2,660,1,89.1,0) DALC REFERENCE NUMBER "BLD",3182,4,660,2,660,1,89.2,0) DALC BILL DATE "BLD",3182,4,660,2,660,1,89.3,0) DALC ORDERING STATION "BLD",3182,4,660,222) y^n^p^^^^n^^n "BLD",3182,4,660,224) "BLD",3182,4,668,0) 668 "BLD",3182,4,668,2,0) ^9.641^668^1 "BLD",3182,4,668,2,668,0) PROSTHETIC SUSPENSE (File-top level) "BLD",3182,4,668,2,668,1,0) ^9.6411^15^1 "BLD",3182,4,668,2,668,1,15,0) OIF/OEF "BLD",3182,4,668,222) y^n^p^^^^n^^n "BLD",3182,4,668,224) "BLD",3182,4,"APDD",660,660) "BLD",3182,4,"APDD",660,660,11) "BLD",3182,4,"APDD",660,660,34) "BLD",3182,4,"APDD",660,660,89.1) "BLD",3182,4,"APDD",660,660,89.2) "BLD",3182,4,"APDD",660,660,89.3) "BLD",3182,4,"APDD",668,668) "BLD",3182,4,"APDD",668,668,15) "BLD",3182,4,"B",660,660) "BLD",3182,4,"B",668,668) "BLD",3182,6) 2^ "BLD",3182,6.3) 18 "BLD",3182,"KRN",0) ^9.67PA^19^17 "BLD",3182,"KRN",.4,0) .4 "BLD",3182,"KRN",.4,"NM",0) ^9.68A^3^2 "BLD",3182,"KRN",.4,"NM",1,0) RMPR OIF/OEF PSAS VETS FILE #660^660^0 "BLD",3182,"KRN",.4,"NM",3,0) SUSPENSE OIF/OEF VETS FILE #668^668^0 "BLD",3182,"KRN",.4,"NM","B","RMPR OIF/OEF PSAS VETS FILE #660",1) "BLD",3182,"KRN",.4,"NM","B","SUSPENSE OIF/OEF VETS FILE #668",3) "BLD",3182,"KRN",.401,0) .401 "BLD",3182,"KRN",.401,"NM",0) ^9.68A^3^2 "BLD",3182,"KRN",.401,"NM",2,0) RMPR OIF/OEF PSAS VETS FILE #660^660^0 "BLD",3182,"KRN",.401,"NM",3,0) SUSPENSE OIF/OEF VETS FILE #668^668^0 "BLD",3182,"KRN",.401,"NM","B","RMPR OIF/OEF PSAS VETS FILE #660",2) "BLD",3182,"KRN",.401,"NM","B","SUSPENSE OIF/OEF VETS FILE #668",3) "BLD",3182,"KRN",.402,0) .402 "BLD",3182,"KRN",.403,0) .403 "BLD",3182,"KRN",.5,0) .5 "BLD",3182,"KRN",.84,0) .84 "BLD",3182,"KRN",3.6,0) 3.6 "BLD",3182,"KRN",3.8,0) 3.8 "BLD",3182,"KRN",9.2,0) 9.2 "BLD",3182,"KRN",9.8,0) 9.8 "BLD",3182,"KRN",9.8,"NM",0) ^9.68A^12^9 "BLD",3182,"KRN",9.8,"NM",1,0) RMPRDDC^^0^B26052181 "BLD",3182,"KRN",9.8,"NM",4,0) RMPR9LNP^^0^B11485144 "BLD",3182,"KRN",9.8,"NM",5,0) RMPR9LN1^^0^B9416364 "BLD",3182,"KRN",9.8,"NM",6,0) RMPR9PU^^0^B66397564 "BLD",3182,"KRN",9.8,"NM",7,0) RMPR121C^^0^B13650442 "BLD",3182,"KRN",9.8,"NM",8,0) RMPR9DO^^0^B88978694 "BLD",3182,"KRN",9.8,"NM",9,0) RMPR29WO^^0^B20200152 "BLD",3182,"KRN",9.8,"NM",11,0) RMPR29GA^^0^B28442542 "BLD",3182,"KRN",9.8,"NM",12,0) RMPRPFFS^^0^B29300840 "BLD",3182,"KRN",9.8,"NM","B","RMPR121C",7) "BLD",3182,"KRN",9.8,"NM","B","RMPR29GA",11) "BLD",3182,"KRN",9.8,"NM","B","RMPR29WO",9) "BLD",3182,"KRN",9.8,"NM","B","RMPR9DO",8) "BLD",3182,"KRN",9.8,"NM","B","RMPR9LN1",5) "BLD",3182,"KRN",9.8,"NM","B","RMPR9LNP",4) "BLD",3182,"KRN",9.8,"NM","B","RMPR9PU",6) "BLD",3182,"KRN",9.8,"NM","B","RMPRDDC",1) "BLD",3182,"KRN",9.8,"NM","B","RMPRPFFS",12) "BLD",3182,"KRN",19,0) 19 "BLD",3182,"KRN",19,"NM",0) ^9.68A^6^5 "BLD",3182,"KRN",19,"NM",2,0) RMPR SUSPENSE MENU^^2 "BLD",3182,"KRN",19,"NM",3,0) RMPR PRINT OIF/OEF SUSPENSE^^0 "BLD",3182,"KRN",19,"NM",4,0) RMPR NPPD TOOLS^^2 "BLD",3182,"KRN",19,"NM",5,0) RMPR PRINT OIF/OEF ITEMS^^0 "BLD",3182,"KRN",19,"NM",6,0) RMPR DALC^^0 "BLD",3182,"KRN",19,"NM","B","RMPR DALC",6) "BLD",3182,"KRN",19,"NM","B","RMPR NPPD TOOLS",4) "BLD",3182,"KRN",19,"NM","B","RMPR PRINT OIF/OEF ITEMS",5) "BLD",3182,"KRN",19,"NM","B","RMPR PRINT OIF/OEF SUSPENSE",3) "BLD",3182,"KRN",19,"NM","B","RMPR SUSPENSE MENU",2) "BLD",3182,"KRN",19.1,0) 19.1 "BLD",3182,"KRN",19.1,"NM",0) ^9.68A^^ "BLD",3182,"KRN",101,0) 101 "BLD",3182,"KRN",409.61,0) 409.61 "BLD",3182,"KRN",771,0) 771 "BLD",3182,"KRN",870,0) 870 "BLD",3182,"KRN",8994,0) 8994 "BLD",3182,"KRN",8994,"NM",0) ^9.68A^^0 "BLD",3182,"KRN","B",.4,.4) "BLD",3182,"KRN","B",.401,.401) "BLD",3182,"KRN","B",.402,.402) "BLD",3182,"KRN","B",.403,.403) "BLD",3182,"KRN","B",.5,.5) "BLD",3182,"KRN","B",.84,.84) "BLD",3182,"KRN","B",3.6,3.6) "BLD",3182,"KRN","B",3.8,3.8) "BLD",3182,"KRN","B",9.2,9.2) "BLD",3182,"KRN","B",9.8,9.8) "BLD",3182,"KRN","B",19,19) "BLD",3182,"KRN","B",19.1,19.1) "BLD",3182,"KRN","B",101,101) "BLD",3182,"KRN","B",409.61,409.61) "BLD",3182,"KRN","B",771,771) "BLD",3182,"KRN","B",870,870) "BLD",3182,"KRN","B",8994,8994) "BLD",3182,"QUES",0) ^9.62^^ "BLD",3182,"REQB",0) ^9.611^2^2 "BLD",3182,"REQB",1,0) RMPR*3.0*126^2 "BLD",3182,"REQB",2,0) RMPR*3.0*75^2 "BLD",3182,"REQB","B","RMPR*3.0*126",1) "BLD",3182,"REQB","B","RMPR*3.0*75",2) "FIA",660) RECORD OF PROS APPLIANCE/REPAIR "FIA",660,0) ^RMPR(660, "FIA",660,0,0) 660OID "FIA",660,0,1) y^n^p^^^^n^^n "FIA",660,0,10) "FIA",660,0,11) "FIA",660,0,"RLRO") "FIA",660,0,"VR") 3.0^RMPR "FIA",660,660) 1 "FIA",660,660,11) "FIA",660,660,34) "FIA",660,660,89.1) "FIA",660,660,89.2) "FIA",660,660,89.3) "FIA",668) PROSTHETIC SUSPENSE "FIA",668,0) ^RMPR(668, "FIA",668,0,0) 668ID "FIA",668,0,1) y^n^p^^^^n^^n "FIA",668,0,10) "FIA",668,0,11) "FIA",668,0,"RLRO") "FIA",668,0,"VR") 3.0^RMPR "FIA",668,668) 1 "FIA",668,668,15) "KRN",.4,2537,-1) 0^3 "KRN",.4,2537,0) SUSPENSE OIF/OEF VETS^3070328.1704^@^668^^@^3070703 "KRN",.4,2537,"F",1) .01~14~1~-2,^DPT(^^S I(0,0)=D0 S DIP(1)=$S($D(^RMPR(668,D0,0)):^(0),1:"") S X=$P(DIP(1),U,2),X=X S D(0)=+X;Z;"VETERAN:"~ "KRN",.4,2537,"F",2) -2,S DIP(101)=$S($D(^DPT(D0,0)):^(0),1:"") S X=$P(DIP(101),U,9),DIP(102)=$G(X) S X=6,DIP(103)=$G(X) S X=9,X=$E(DIP(102),DIP(103),X) W X K DIP;"SSN";Z;"$E(SSN,6,9)"~ "KRN",.4,2537,"H") PROSTHETIC SUSPENSE LIST "KRN",.4,2551,-1) 0^1 "KRN",.4,2551,0) RMPR OIF/OEF PSAS VETS^3070426.1044^@^660^^@^3070426 "KRN",.4,2551,"F",1) .01~.02;L12;"PATIENT"~-665,^RMPR(665,^^S I(0,0)=D0 S DIP(1)=$S($D(^RMPR(660,D0,0)):^(0),1:"") S X=$P(DIP(1),U,2),X=X S D(0)=+X;Z;"PATIENT NAME:"~ "KRN",.4,2551,"F",2) -665,-2,^DPT(^^S I(100,0)=D0 S DIP(101)=$S($D(^RMPR(665,D0,0)):^(0),1:"") S X=$P(DIP(101),U,1),X=X S D(0)=+X;Z;".01:"~ "KRN",.4,2551,"F",3) -665,-2,S DIP(201)=$S($D(^DPT(D0,0)):^(0),1:"") S X=$P(DIP(201),U,9),DIP(202)=$G(X) S X=6,DIP(203)=$G(X) S X=9,X=$E(DIP(202),DIP(203),X) W X K DIP;"SSN";Z;"$E(SSN,6,9)"~ "KRN",.4,2551,"F",4) -665,-2,S DIP(1)=$S($D(^RMPR(660,I(0,0),"HST")):^("HST"),1:"") S X=$P(DIP(1),U,1) W X K DIP;L12;"ITEM";Z;"HISTORICAL ITEM"~ "KRN",.4,2551,"F",5) -665,-2,S DIP(1)=$S($D(^RMPR(660,I(0,0),0)):^(0),1:"") S X=$P(DIP(1),U,16) W X K DIP;Z;"TOTAL COST"~ "KRN",.4,2551,"H") OIF/OEF PSAS VETS "KRN",.401,1657,-1) 0^3 "KRN",.401,1657,0) SUSPENSE OIF/OEF VETS^3070328.1709^@^668^^@^3070703 "KRN",.401,1657,2,0) ^.4014^2^2 "KRN",.401,1657,2,1,0) 668^^STATUS'="CLOSED"^"@B^;L1^^^^^4 "KRN",.401,1657,2,1,"CM") S Y(2)=$C(59)_$P($G(^DD(668,14,0)),U,3),Y(1)=$S($D(^RMPR(668,D0,0)):^(0),1:"") S X=$P($P(Y(2),$C(59)_$P(Y(1),U,10)_":",2),$C(59))'="CLOSED" I D0>0 S DISX(1)=X "KRN",.401,1657,2,1,"F") 0 "KRN",.401,1657,2,1,"GET") S Y(2)=$C(59)_$P($G(^DD(668,14,0)),U,3),Y(1)=$S($D(^RMPR(668,D0,0)):^(0),1:"") S X=$P($P(Y(2),$C(59)_$P(Y(1),U,10)_":",2),$C(59))'="CLOSED" I D0>0 S DISX(1)=X "KRN",.401,1657,2,1,"QCON") I DISX(1) "KRN",.401,1657,2,1,"T") 1 "KRN",.401,1657,2,1,"TXT") STATUS'=""CLOSED"" "KRN",.401,1657,2,2,0) 2.3215^^.01'=""^""@B^;L1^^^^^4 "KRN",.401,1657,2,2,1,0) ^.40141^1^1 "KRN",.401,1657,2,2,1,1,0) 2^.3215 "KRN",.401,1657,2,2,1,"B",2,1) "KRN",.401,1657,2,2,2,0) ^.401418^1^1 "KRN",.401,1657,2,2,2,1,0) 668^100^2^DPT(^0 "KRN",.401,1657,2,2,2,1,"RCOD") S I(0,0)=D0 S Y(1)=$S($D(^RMPR(668,D0,0)):^(0),1:"") S X=$P(Y(1),U,2),X=X S D(0)=+X "KRN",.401,1657,2,2,2,"B",668,1) "KRN",.401,1657,2,2,"CM") S X=.01'="" I D1>0 S DISX(2)=X "KRN",.401,1657,2,2,"F") 0 "KRN",.401,1657,2,2,"GET") S X=.01'="" I D1>0 S DISX(2)=X "KRN",.401,1657,2,2,"QCON") I DISX(2) "KRN",.401,1657,2,2,"T") 1 "KRN",.401,1657,2,2,"TXT") .01'="""" "KRN",.401,1657,2,"B",2.3215,2) "KRN",.401,1657,2,"B",668,1) "KRN",.401,1681,-1) 0^2 "KRN",.401,1681,0) RMPR OIF/OEF PSAS VETS^3070426.104^@^660^^@^3070426 "KRN",.401,1681,2,0) ^.4014^2^2 "KRN",.401,1681,2,1,0) 660^.01^ENTRY DATE^^^^^^^1 "KRN",.401,1681,2,1,"ASK") 1 "KRN",.401,1681,2,1,"F") ?z^@ "KRN",.401,1681,2,1,"GET") S DISX(1)=$P($G(^RMPR(660,D0,0)),U) "KRN",.401,1681,2,1,"QCON") I DISX(1)="" "KRN",.401,1681,2,1,"T") @^@ "KRN",.401,1681,2,1,"TXT") ENTRY DATE is null "KRN",.401,1681,2,2,0) 2.3215^^.01'=""^"""@B^;L1^^^^^4 "KRN",.401,1681,2,2,1,0) ^.40141^1^1 "KRN",.401,1681,2,2,1,1,0) 2^.3215 "KRN",.401,1681,2,2,1,"B",2,1) "KRN",.401,1681,2,2,2,0) ^.401418^2^2 "KRN",.401,1681,2,2,2,1,0) 660^100^665^RMPR(665,^0 "KRN",.401,1681,2,2,2,1,"RCOD") S I(0,0)=D0 S Y(1)=$S($D(^RMPR(660,D0,0)):^(0),1:"") S X=$P(Y(1),U,2),X=X S D(0)=+X "KRN",.401,1681,2,2,2,2,0) 665^200^2^DPT(^0 "KRN",.401,1681,2,2,2,2,"RCOD") S I(100,0)=D0 S Y(101)=$S($D(^RMPR(665,D0,0)):^(0),1:"") S X=$P(Y(101),U,1),X=X S D(0)=+X "KRN",.401,1681,2,2,2,"B",660,1) "KRN",.401,1681,2,2,2,"B",665,2) "KRN",.401,1681,2,2,"CM") S X=.01'="" I D1>0 S DISX(2)=X "KRN",.401,1681,2,2,"F") 0 "KRN",.401,1681,2,2,"GET") S X=.01'="" I D1>0 S DISX(2)=X "KRN",.401,1681,2,2,"QCON") I DISX(2) "KRN",.401,1681,2,2,"T") 1 "KRN",.401,1681,2,2,"TXT") .01'="""" "KRN",.401,1681,2,"B",2.3215,2) "KRN",.401,1681,2,"B",660,1) "KRN",19,5661,-1) 2^2 "KRN",19,5661,0) RMPR SUSPENSE MENU^Suspense^^M^28^^^^^^^101 "KRN",19,5661,10,0) ^19.01IP^16^13 "KRN",19,5661,10,16,0) 12706^OF^2 "KRN",19,5661,10,16,"^") RMPR PRINT OIF/OEF SUSPENSE "KRN",19,5661,"U") SUSPENSE "KRN",19,10688,-1) 2^4 "KRN",19,10688,0) RMPR NPPD TOOLS^NPPD Tools^^M^2182^^^^^^^101 "KRN",19,10688,10,0) ^19.01IP^13^13 "KRN",19,10688,10,13,0) 12707^NOF^11 "KRN",19,10688,10,13,"^") RMPR PRINT OIF/OEF ITEMS "KRN",19,10688,"U") NPPD TOOLS "KRN",19,12486,-1) 0^6 "KRN",19,12486,0) RMPR DALC^DALC SERVER^^S^^^^^^^^ "KRN",19,12486,1,0) ^19.06^1^1^3070523^^ "KRN",19,12486,1,1,0) Patch 60 "KRN",19,12486,25) MAIN^RMPRDDC "KRN",19,12486,220) XQSERVER^R^^^Y^N "KRN",19,12486,"U") DALC SERVER "KRN",19,12706,-1) 0^3 "KRN",19,12706,0) RMPR PRINT OIF/OEF SUSPENSE^Print OIF/OEF Suspense List^^P^^^^^^^^PROSTHETICS "KRN",19,12706,1,0) ^19.06^1^1^3070426^^ "KRN",19,12706,1,1,0) Fileman Print to list the OIF/OEF patients. "KRN",19,12706,60) RMPR(668, "KRN",19,12706,62) 0 "KRN",19,12706,63) [SUSPENSE OIF/OEF VETS] "KRN",19,12706,64) [SUSPENSE OIF/OEF VETS] "KRN",19,12706,"U") PRINT OIF/OEF SUSPENSE LIST "KRN",19,12707,-1) 0^5 "KRN",19,12707,0) RMPR PRINT OIF/OEF ITEMS^Print OIF/OEF Items Issued^^P^^^^^^^^PROSTHETICS "KRN",19,12707,1,0) ^^1^1^3070426^ "KRN",19,12707,1,1,0) Print option to print OIF/OEF patients with items issued. "KRN",19,12707,60) RMPR(660, "KRN",19,12707,62) 0 "KRN",19,12707,63) [OIF/OEF PSAS VETS] "KRN",19,12707,64) [OIF/OEF PSAS VETS] "KRN",19,12707,"U") PRINT OIF/OEF ITEMS ISSUED "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 "ORD",6,.401) .401;6;;;EDEOUT^DIFROMSO(.401,DA,"",XPDA);FPRE^DIFROMSI(.401,"",XPDA);EPRE^DIFROMSI(.401,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.401,DA,"",XPDA);DEL^DIFROMSK(.401,"",%) "ORD",6,.401,0) SORT TEMPLATE "ORD",18,19) 19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA "ORD",18,19,0) OPTION "PKG",101,-1) 1^1 "PKG",101,0) PROSTHETICS^RMPR^PROSTHETICS VERSION 3.0 ALPHA "PKG",101,20,0) ^9.402P^^0 "PKG",101,22,0) ^9.49I^1^1 "PKG",101,22,1,0) 3.0^2960209^2960214 "PKG",101,22,1,"PAH",1,0) 60^3070709^104 "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") 9 "RTN","RMPR121C") 0^7^B13650442^B12618481 "RTN","RMPR121C",1,0) RMPR121C ;HINES-OI/HNC/SPS - IFCAP GUI TO 2319 ;3/1/2003 "RTN","RMPR121C",2,0) ;;3.0;PROSTHETICS;**90,75,60**;Feb 09, 1996;Build 18 "RTN","RMPR121C",3,0) ; "RTN","RMPR121C",4,0) R19 ;PASS RMPRA AS IEN OF 644, AND B2 AS ITEM MULTIPLE "RTN","RMPR121C",5,0) ;S:$D(RMPRCONT) $P(^RMPR(664,RMPRA,1,B2,0),U,14)=RMPRCONT "RTN","RMPR121C",6,0) S RMPRI=$P(^RMPR(664,RMPRA,1,B2,0),U,1),RMPRCT=$P(^(0),U,3) "RTN","RMPR121C",7,0) S RMPRQT=$P(^RMPR(664,RMPRA,1,B2,0),U,4),RMPRDES=$P(^(0),U,2) "RTN","RMPR121C",8,0) S RMPRPER=$P(^RMPR(664,RMPRA,2),U,6)/100 "RTN","RMPR121C",9,0) ;contract data "RTN","RMPR121C",10,0) S RMPRCONT="" "RTN","RMPR121C",11,0) S RMPRCONT=$P(^RMPR(664,RMPRA,1,B2,0),U,14) "RTN","RMPR121C",12,0) ;TEMPORARY FIX FOR TRANSACTION TYPE AND PATIENT CATAGORY "RTN","RMPR121C",13,0) S RMPRT=$P(^RMPR(664,RMPRA,1,B2,0),U,9),RMPRR=$P(^(0),U,8),RMPRDIS=$P(^(0),U,10),RMPRS=$P(^(0),U,12),UOI=$P(^(0),U,5),RMPRSLN=$P(^(0),U,15) "RTN","RMPR121C",14,0) ; "RTN","RMPR121C",15,0) I RMPRT="R" S $P(^RMPR(664,RMPRA,1,B2,0),U,9)="X",RMPRT="X" "RTN","RMPR121C",16,0) I RMPRDIS=2 S $P(^RMPR(664,RMPRA,1,B2,0),U,10)=1,RMPRDIS=1 "RTN","RMPR121C",17,0) I RMPRDIS=3 S $P(^RMPR(664,RMPRA,1,B2,0),U,10)=4,RMPRDIS=4 "RTN","RMPR121C",18,0) S RMPRSC=$P(^RMPR(664,RMPRA,1,B2,0),U,11) ;Special catagory "RTN","RMPR121C",19,0) S RMPRNOB=$P(^RMPR(664,RMPRA,1,B2,0),U,17) ;NUMBER OF BIDS "RTN","RMPR121C",20,0) S RMPRHCPC=$P(^RMPR(664,RMPRA,1,B2,0),U,16) ;PSAS HCPCS "RTN","RMPR121C",21,0) S RMPRMK=$P(^RMPR(664,RMPRA,1,B2,2),U,1),RMPRMD=$P(^(2),U,2),RMPRLTN=$P(^(2),U,3),RMPREW=$P(^(2),U,4) ;MAKE,MODEL,LOT,EXCLUDE/WAVER "RTN","RMPR121C",22,0) S RMCPT=$P($G(^RMPR(664,RMPRA,1,B2,4)),U,2) ;CPT MODIFIER "RTN","RMPR121C",23,0) K DD,DO S DIC="^RMPR(660,",DIC(0)="QL",X=DT,DLAYGO=660 "RTN","RMPR121C",24,0) D FILE^DICN K DLAYGO,DIC,D0 S (RMPR660,DA)=+Y "RTN","RMPR121C",25,0) S $P(^RMPR(664,RMPRA,1,B2,0),U,13)=RMPR660 "RTN","RMPR121C",26,0) S DA=RMPRA,DIK="^RMPR(664," D IX1^DIK "RTN","RMPR121C",27,0) S RMPRAMT=(RMPRQT*RMPRCT) "RTN","RMPR121C",28,0) S RMPRDCT=RMPRAMT*RMPRPER "RTN","RMPR121C",29,0) S RMPRTOTL=RMPRAMT-RMPRDCT "RTN","RMPR121C",30,0) ;ctd is unit cost with percent discount applied. "RTN","RMPR121C",31,0) S RMPRCTD=RMPRAMT-RMPRDCT/RMPRQT "RTN","RMPR121C",32,0) ; "RTN","RMPR121C",33,0) S ^RMPR(660,RMPR660,0)=DT_U_RMPRDFN_U_DT_U_RMPRT_U_U_U_RMPRQT_U_UOI_U_RMPRV_U_RMPR("STA")_U_U_U_"14"_U_RMPRS_U_U_$J(RMPRTOTL,0,2)_"^^^^^^" "RTN","RMPR121C",34,0) ;SERIAL#,MAKE,MODEL,LOT#,EXCLUDE/WAVER "RTN","RMPR121C",35,0) S $P(^RMPR(660,RMPR660,0),U,11)=RMPRSLN,$P(^(0),U,24)=RMPRLTN "RTN","RMPR121C",36,0) S $P(^RMPR(660,RMPR660,9),U)=RMPRMK,$P(^(9),U,2)=RMPRMD "RTN","RMPR121C",37,0) S $P(^RMPR(660,RMPR660,2),U,3)=RMPREW "RTN","RMPR121C",38,0) ;OIF/OEF "RTN","RMPR121C",39,0) S DFN=RMPRDFN D SVC^VADPT "RTN","RMPR121C",40,0) S RMPROEOI=$S(VASV(11)>0:"",VASV(12)>0:"",VASV(13)>0:"",1:0) "RTN","RMPR121C",41,0) D KVAR^VADPT "RTN","RMPR121C",42,0) I RMPROEOI="" S $P(^RMPR(660,RMPR660,5),U,1)=1 "RTN","RMPR121C",43,0) ;CONTRACT # "RTN","RMPR121C",44,0) S $P(^RMPR(660,RMPR660,2),U,9)=$P(^RMPR(664,RMPRA,1,B2,0),U,14) "RTN","RMPR121C",45,0) ; ITEM "RTN","RMPR121C",46,0) S $P(^RMPR(660,RMPR660,0),U,6)=RMPRI "RTN","RMPR121C",47,0) ;NUMBER OF BIDS "RTN","RMPR121C",48,0) S $P(^RMPR(660,RMPR660,2),U,10)=RMPRNOB "RTN","RMPR121C",49,0) ;HCPCS code "RTN","RMPR121C",50,0) S:RMPRHCPC $P(^RMPR(660,RMPR660,0),U,22)=$P(^RMPR(661.1,RMPRHCPC,0),U,4) "RTN","RMPR121C",51,0) ; "RTN","RMPR121C",52,0) S ^RMPR(660,RMPR660,"AMS")=RMPRG,^RMPR(660,RMPR660,"AM")=U_U_RMPRDIS_U_RMPRSC "RTN","RMPR121C",53,0) ; /SPS removed below from above line for 75 may re-use later "RTN","RMPR121C",54,0) ; I $D(RMPRWO),RMPRWO S $P(^("AM"),U,2)=1,$P(^RMPR(660,RMPR660,"LB"),U,5)=RMPRWO "RTN","RMPR121C",55,0) S:$D(RMPRR) $P(^RMPR(660,RMPR660,0),U,18)=RMPRR "RTN","RMPR121C",56,0) S RMPRTRN=$P(^RMPR(664,RMPRA,4),U,5) "RTN","RMPR121C",57,0) S $P(^RMPR(660,RMPR660,0),U,27)=DUZ,^(1)=RMPRTRN_U_RMPRDES_"^^"_RMPRHCPC_"^^"_RMCPT "RTN","RMPR121C",58,0) ;If work order and no count fields need to be set "RTN","RMPR121C",59,0) I +$P(^RMPR(664,RMPRA,0),U,17)>0 D NCNT "RTN","RMPR121C",60,0) ;note to supplier "RTN","RMPR121C",61,0) ; "RTN","RMPR121C",62,0) S RMPRNS="" "RTN","RMPR121C",63,0) S (D1,RD)=0 "RTN","RMPR121C",64,0) F S RD=$O(^RMPR(664,RMPRA,1,B2,1,RD)) Q:RD="" D "RTN","RMPR121C",65,0) .S ^RMPR(660,RMPR660,"DES",RD,0)=^RMPR(664,RMPRA,1,B2,1,RD,0) "RTN","RMPR121C",66,0) .I $L(RMPRNS)>160 Q "RTN","RMPR121C",67,0) .S RMPRNS=RMPRNS_" "_^RMPR(664,RMPRA,1,B2,1,RD,0) "RTN","RMPR121C",68,0) .S D1=RD "RTN","RMPR121C",69,0) S ^RMPR(660,RMPR660,"DES",0)="^660.028^"_D1_U_D1 "RTN","RMPR121C",70,0) S:$D(RMPRDELN) ^RMPR(660,RMPR660,3)=RMPRDELN "RTN","RMPR121C",71,0) ;modified by #62 "RTN","RMPR121C",72,0) S ^TMP($J,"RMPRPCE",660,RMPR660)=RMPRG_"^"_$G(RMPRDFN) "RTN","RMPR121C",73,0) ;set x-refs "RTN","RMPR121C",74,0) S DIK="^RMPR(660,",DA=RMPR660 D IX1^DIK "RTN","RMPR121C",75,0) K RMPRTRN "RTN","RMPR121C",76,0) Q "RTN","RMPR121C",77,0) NCNT ; ADD NO ADMIN COUNT TO 660 FOR WORK ORDER "RTN","RMPR121C",78,0) ; "RTN","RMPR121C",79,0) S RMIE1=$P(^RMPR(664,RMPRA,0),U,17) "RTN","RMPR121C",80,0) S RMRWO=$P(^RMPR(664.1,RMIE1,0),U,13) "RTN","RMPR121C",81,0) S RMDAT(660,RMPR660_",",72.5)=RMRWO "RTN","RMPR121C",82,0) S RMDAT(660,RMPR660_",",72)=RMIE1 "RTN","RMPR121C",83,0) S RMDAT(660,RMPR660_",",81)=1 "RTN","RMPR121C",84,0) S RMDAT(660,RMPR660_",",11)=14 "RTN","RMPR121C",85,0) S RMDAT(660,RMPR660_",",12)="C" "RTN","RMPR121C",86,0) D FILE^DIE("","RMDAT","RMERROR") "RTN","RMPR121C",87,0) I $D(RMERROR) S RESULT(0)=1_U_RMERROR G EXIT "RTN","RMPR121C",88,0) Q "RTN","RMPR121C",89,0) EXIT ; "RTN","RMPR121C",90,0) K RMIE1,RMRWO,RMPRA,RMPR660 "RTN","RMPR121C",91,0) Q "RTN","RMPR29GA") 0^11^B28442542^B27172398 "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**;Feb 09, 1996;Build 18 "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 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",17,0) DR .K DR "RTN","RMPR29GA",18,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",19,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",20,0) .;Set OIF/OEF field "RTN","RMPR29GA",21,0) .S DFN=RMPRDFN D SVC^VADPT "RTN","RMPR29GA",22,0) .S RMPROEOI=$S(VASV(11)>0:"",VASV(12)>0:"",VASV(13)>0:"",1:0) "RTN","RMPR29GA",23,0) .I RMPROEOI="" S $P(^RMPR(660,RDA,5),U,1)=1 "RTN","RMPR29GA",24,0) .S $P(^RMPR(660,RDA,0),U,6)=IT "RTN","RMPR29GA",25,0) .I $P(^RMPR(660,RDA,0),U,27)="" S $P(^(0),U,27)=DUZ "RTN","RMPR29GA",26,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",27,0) .I NOLC=1 S $P(^RMPR(660,RDA,"LB"),U,2)=RMHRWO "RTN","RMPR29GA",28,0) .I $D(^RMPR(664.1,RMPRDA,2,RA,1)),$O(^RMPR(664.1,RMPRDA,2,RA,1,0)) D "RTN","RMPR29GA",29,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",30,0) .I $D(RN) S ^RMPR(660,RDA,"DES",0)="^660.028^"_RN_U_RN_U_DT_"^^" "RTN","RMPR29GA",31,0) .S DIK="^RMPR(660,",DA=RDA D:'$D(RNEW) IX^DIK D:$D(RNEW) IX1^DIK K RNEW "RTN","RMPR29GA",32,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",33,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",34,0) Q "RTN","RMPR29GA",35,0) END L:+$G(RMPRDA) -^RMPR(664.1,+RMPRDA,0) K ^UTILITY("DIQ1",$J) "RTN","RMPR29GA",36,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",37,0) N RMPR,RMPRSITE D KILL^XUSCLEAN Q "RTN","RMPR29GA",38,0) ITM ;EDIT 2529-3 ITEM "RTN","RMPR29GA",39,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",40,0) S (IEN,DA)=+Y,RNEW=$P(Y,U,3) S RY=$P(Y,U,2) D ITA^RMPR29U(RY) "RTN","RMPR29GA",41,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",42,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",43,0) S DIE=DIC,DR=$S($D(RMPRPU):"",1:".01R") "RTN","RMPR29GA",44,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",45,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",46,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",47,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",48,0) .K DA W !!,?5,$C(7),"ITEM INFORMATION IS MISSING",!!,?5,"Deleted..." "RTN","RMPR29GA",49,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",50,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",51,0) K FLGG,DR,Y I $P($G(^RMPR(664.1,RMPRDA,2,0)),U,3)=""!($P($G(^(0)),U,4)="") D "RTN","RMPR29GA",52,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",53,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",54,0) .D NOW^%DTC S (NX,X)=% K % "RTN","RMPR29GA",55,0) .S DIC("P")="664.129DA",DA(1)=RMPRDA "RTN","RMPR29GA",56,0) .S DIC="^RMPR(664.1,"_RMPRDA_",8,",DIC(0)="LZ" "RTN","RMPR29GA",57,0) .S DLAYGO=664.1 D FILE^DICN K DLAYGO "RTN","RMPR29GA",58,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",59,0) G ITM "RTN","RMPR29GA",60,0) PT D:$D(REDIT) POST K DA,DR,REDIT G DISP^RMPR29D "RTN","RMPR29GA",61,0) Q "RTN","RMPR29GA",62,0) K DIE,DIK,DIR,ELS,HCPCS,IEN,IT,NOAC,NOLC,NX,QTY,RA,RDC,RIT,RMHRWO "RTN","RMPR29GA",63,0) K RMHTECH,RMPRDA,RMPRDFN,RMPRDT,RMPRG,RN,RW,RY,SCAT,SER,SRC,TO,TYP,UN,X "RTN","RMPR29WO") 0^9^B20200152^B19191231 "RTN","RMPR29WO",1,0) RMPR29WO ;HOIFO/SPS - WORK ORDER GRID OWL PROGRAM ;11/8/05 07:12 "RTN","RMPR29WO",2,0) ;;3.0;PROSTHETICS;**75,122,60**;Feb 09, 1996;Build 18 "RTN","RMPR29WO",3,0) ; "RTN","RMPR29WO",4,0) ;SORT - STATUS OF 664.1, if CA change to X to check. "RTN","RMPR29WO",5,0) ; "RTN","RMPR29WO",6,0) A1(SORT) ;entry point for testing "RTN","RMPR29WO",7,0) D A2 "RTN","RMPR29WO",8,0) Q "RTN","RMPR29WO",9,0) EN(RESULT,SORT) ; -- Broker callback to get list to display "RTN","RMPR29WO",10,0) A2 N STRING,CLREND,COLUMN,ON,OFF "RTN","RMPR29WO",11,0) S DATE=2010101 "RTN","RMPR29WO",12,0) S SITE="ALL",START=00,STOP=99 "RTN","RMPR29WO",13,0) K ^TMP($J) "RTN","RMPR29WO",14,0) N RMPRA,CDATE,X "RTN","RMPR29WO",15,0) K ADATE,PDAY,RMPRCD "RTN","RMPR29WO",16,0) S (CNT,VALMCNT)=0,(RMPR6641,RRX)="" "RTN","RMPR29WO",17,0) F S RMPR6641=$O(^RMPR(664.1,RMPR6641)) Q:RMPR6641="" D "RTN","RMPR29WO",18,0) .I '$D(^RMPR(664.1,RMPR6641,0)) Q "RTN","RMPR29WO",19,0) .I $P(^RMPR(664.1,RMPR6641,0),U,13)="" Q "RTN","RMPR29WO",20,0) .S WO66410=^RMPR(664.1,RMPR6641,0) "RTN","RMPR29WO",21,0) .S RMSTS=$P(WO66410,U,17) "RTN","RMPR29WO",22,0) .I RMSTS="CA" S RMSTS="X" "RTN","RMPR29WO",23,0) .I RMSTS="PC" Q "RTN","RMPR29WO",24,0) .I SORT'[RMSTS Q "RTN","RMPR29WO",25,0) .I RMSTS="X" S RMSTS="CA" "RTN","RMPR29WO",26,0) .S RMSTS=$$EXTERNAL^DILFD(664.1,16,"",RMSTS) "RTN","RMPR29WO",27,0) .S RMRDTI=$P(WO66410,U,9) "RTN","RMPR29WO",28,0) .S RMPRA=$P(WO66410,U,8) Q:RMPRA'>0 D "RTN","RMPR29WO",29,0) ..S STN=$P(^RMPR(668,RMPRA,0),U,7) "RTN","RMPR29WO",30,0) ..S STNX=$$STATN^RMPRUTIL(STN) "RTN","RMPR29WO",31,0) ..;ssn range filter "RTN","RMPR29WO",32,0) ..S DFN=$P(^RMPR(668,RMPRA,0),U,2) "RTN","RMPR29WO",33,0) ..D DEM^VADPT "RTN","RMPR29WO",34,0) ..S SSNEN=$E($P(VADM(2),"^",2),10,11) "RTN","RMPR29WO",35,0) ..I SSNEN>STOP Q "RTN","RMPR29WO",36,0) ..I SSNEN0 D "RTN","RMPR29WO",41,0) .Q:'$D(^TMP($J,I)) "RTN","RMPR29WO",42,0) .S ^TMP($J,"RMPRWO",CNT)=^TMP($J,I) "RTN","RMPR29WO",43,0) .S CNT=CNT-1 "RTN","RMPR29WO",44,0) G EXIT "RTN","RMPR29WO",45,0) Q "RTN","RMPR29WO",46,0) REC ;records to grid "RTN","RMPR29WO",47,0) ;stop date, init action date "RTN","RMPR29WO",48,0) ;check ien, patch 77 "RTN","RMPR29WO",49,0) ; "RTN","RMPR29WO",50,0) N DIC,DIQ,DR,STOPDT "RTN","RMPR29WO",51,0) S STOPDT=$P($G(^RMPR(668,RMPRA,0)),U,9),STOPDT=$$DAT2^RMPRUTL1(STOPDT) "RTN","RMPR29WO",52,0) I $D(RMRDTI) S RMRDTE=$$DAT2^RMPRUTL1(RMRDTI) "RTN","RMPR29WO",53,0) S CDATE=$P(^RMPR(668,RMPRA,0),U,1),CDATE=$$DAT2^RMPRUTL1(CDATE) "RTN","RMPR29WO",54,0) S WDATE=$P(^RMPR(664.1,RMPR6641,0),U,1),WDATE=$$DAT2^RMPRUTL1(WDATE) "RTN","RMPR29WO",55,0) S RMWDTI=$P(^RMPR(664.1,RMPR6641,0),U,1) "RTN","RMPR29WO",56,0) S DFN=$P(^RMPR(668,RMPRA,0),U,2) Q:DFN="" "RTN","RMPR29WO",57,0) N VA,VADM "RTN","RMPR29WO",58,0) D DEM^VADPT "RTN","RMPR29WO",59,0) S WHO=VADM(1) "RTN","RMPR29WO",60,0) S SSN=VADM(2) "RTN","RMPR29WO",61,0) D SVC^VADPT "RTN","RMPR29WO",62,0) S RMPROEOI=$S(VASV(11)>0:"",VASV(12)>0:"",VASV(13)>0:"",1:0) "RTN","RMPR29WO",63,0) D KVAR^VADPT "RTN","RMPR29WO",64,0) ;type "RTN","RMPR29WO",65,0) S TYPE=$$TYPE^RMPREOU(RMPRA,8) "RTN","RMPR29WO",66,0) Q:TYPE'["LAB" "RTN","RMPR29WO",67,0) S CNT=CNT+1 "RTN","RMPR29WO",68,0) ;display description if manual "RTN","RMPR29WO",69,0) S DES=$$DES^RMPREOU(RMPRA,22) "RTN","RMPR29WO",70,0) S DES=$TR(DES,"^","*") "RTN","RMPR29WO",71,0) S DES=$TR(DES,"""","'") "RTN","RMPR29WO",72,0) ;init action date "RTN","RMPR29WO",73,0) S ADATE="",PDAY="",WRKDAY="" "RTN","RMPR29WO",74,0) S ADATE=$P(^RMPR(668,RMPRA,0),U,9) "RTN","RMPR29WO",75,0) ;PPD=1 for previous pending "RTN","RMPR29WO",76,0) I ADATE'="" S CDAY=$$PDAY^RMPREOU(RMPRA) "RTN","RMPR29WO",77,0) ; "RTN","RMPR29WO",78,0) S LINKED=$P($G(^RMPR(668,RMPRA,10,0)),U,4) "RTN","RMPR29WO",79,0) I LINKED="" S LINKED=0 "RTN","RMPR29WO",80,0) ; "RTN","RMPR29WO",81,0) ; Note for list the Variable SSN is in the format NNNNNNNNN^NNN-NN-NNNN "RTN","RMPR29WO",82,0) ; Thus making up 2 pieces of the data string below. "RTN","RMPR29WO",83,0) I RMPROEOI="" S WHO=RMPROEOI_WHO "RTN","RMPR29WO",84,0) S ^TMP($J,RMPR6641)=CDATE_U_DFN_U_WHO_U_SSN_U_TYPE_U_DES "RTN","RMPR29WO",85,0) S ^TMP($J,RMPR6641)=^TMP($J,RMPR6641)_U_RMSTS_U_RMPRA_U_RMPR6641 "RTN","RMPR29WO",86,0) ;Get Work Order Data and add to array "RTN","RMPR29WO",87,0) S RMPRPHCI=$P($G(^RMPR(664.1,RMPR6641,2,1,0)),U,1),RMPRPHCE=$$EXTERNAL^DILFD(661.1,1,"",RMPRPHCI) "RTN","RMPR29WO",88,0) S RMPRWN=$P(WO66410,U,13) "RTN","RMPR29WO",89,0) S RMPRROFF=$$EXTERNAL^DILFD(664.1,13,"",$P(WO66410,U,5)) "RTN","RMPR29WO",90,0) S RMPRTECH=$$EXTERNAL^DILFD(664.1,13,"",$P(WO66410,U,16)) "RTN","RMPR29WO",91,0) S RMPRSOPI=$P(WO66410,U,11),RMPRSOPE=$$EXTERNAL^DILFD(664.1,2,"",RMPRSOPI) "RTN","RMPR29WO",92,0) S RMNPPDSI=$P(WO66410,U,3),RMNPPDSE=$$EXTERNAL^DILFD(664.1,.03,"",RMNPPDSI),RMNPPDSN=$$STATN^RMPRUTIL(RMNPPDSI) "RTN","RMPR29WO",93,0) S RMPRSITE=$O(^RMPR(669.9,"C",RMNPPDSI,0)) "RTN","RMPR29WO",94,0) S RMREQSTI=$P(WO66410,U,4),RMREQSTE=$$EXTERNAL^DILFD(664.1,.04,"",RMREQSTI),RMREQSTN=$$STATN^RMPRUTIL(RMREQSTI) "RTN","RMPR29WO",95,0) S RMRECSTI=$P(WO66410,U,15),RMRECSTE=$$EXTERNAL^DILFD(664.1,.11,"",RMRECSTI),RMRECSTN=$$STATN^RMPRUTIL(RMRECSTI) "RTN","RMPR29WO",96,0) S ^TMP($J,RMPR6641)=^TMP($J,RMPR6641)_U_RMPRPHCE_U_RMPRWN_U_RMPRROFF_U_RMPRTECH_U_RMPRSOPE_U_RMNPPDSN_U_RMNPPDSE_U_RMREQSTN_U_RMREQSTE_U_RMRECSTN_U_RMRECSTE_U_RMPRSITE_U_WDATE_U_RMRDTE "RTN","RMPR29WO",97,0) K CDATE,WHO,SSN,TYPE,DES,PDAY,STATUS,ADATE,RMRDTE "RTN","RMPR29WO",98,0) ;PUT RESULTS IN GLOBAL!! "RTN","RMPR29WO",99,0) Q "RTN","RMPR29WO",100,0) K CDAY,CNT,DATE,DFN,I,LINKED,RMNPPDSE,RMNPPDSI,RMNPPDSN,RMPR6641 "RTN","RMPR29WO",101,0) K RMPRPHCE,RMPRPHCI,RMPRROFF,RMPRSITE,RMPRSOPE,RMPRSOPI,RMPRTECH "RTN","RMPR29WO",102,0) K RMPRWN,RMPRDTI,RMRECSTE,RMRECSTI,RMRECSTN,RMREQSTE,RMREQSTI "RTN","RMPR29WO",103,0) K RMREQSTN,RMSTS,RMWDTI,RRX,SITE,START,STN,STNX,STOP,VALMCNT,WDATE,WO66410,WRKDAY "RTN","RMPR29WO",104,0) EXIT ;common exit point "RTN","RMPR29WO",105,0) S RESULT=$NA(^TMP($J,"RMPRWO")) "RTN","RMPR29WO",106,0) Q "RTN","RMPR9DO") 0^8^B88978694^B87076103 "RTN","RMPR9DO",1,0) RMPR9DO ;HOIFO/HNC - ORDER CONROL PROCESSING-REMOTE PROCEDURE ;9/8/03 07:12 "RTN","RMPR9DO",2,0) ;;3.0;PROSTHETICS;**59,77,90,60**;Feb 09, 1996;Build 18 "RTN","RMPR9DO",3,0) ; "RTN","RMPR9DO",4,0) ;8/5/03 Make sure no dups, HNC patch 77 "RTN","RMPR9DO",5,0) ; "RTN","RMPR9DO",6,0) A1(START,STOP,SITE,SORT,DATE,WHAT) ;entry point for rollup "RTN","RMPR9DO",7,0) ;activated from (option name) "RTN","RMPR9DO",8,0) I WHAT="S" D "RTN","RMPR9DO",9,0) .S STN1=0 "RTN","RMPR9DO",10,0) .F S STN1=$O(^RMPR(669.9,STN1)) Q:STN1'>0 D "RTN","RMPR9DO",11,0) . .S SITE=STN1 "RTN","RMPR9DO",12,0) . .D A2 "RTN","RMPR9DO",13,0) I WHAT="ALL" G A2 "RTN","RMPR9DO",14,0) Q "RTN","RMPR9DO",15,0) EN(RESULT,DUZ,START,STOP,SITE,SORT,DATE,RMPRPRSN) ; -- Broker callback to get list to display "RTN","RMPR9DO",16,0) ;entry to send to PCM, WHAT=ALL or S for Summary Only "RTN","RMPR9DO",17,0) ;RMPRPRSN=P for Purchasing D for Delayed Order Report "RTN","RMPR9DO",18,0) S (WHO,RMPRSC)="" "RTN","RMPR9DO",19,0) I RMPRPRSN="P" S RMPRSC=$O(^RMPR(669.9,"PA",DUZ,RMPRSC)) Q:(RMPRSC="")!(WHO'="") D "RTN","RMPR9DO",20,0) . I '$D(^RMPR(669.9,RMPRSC,0)) Q "RTN","RMPR9DO",21,0) . I '$D(^RMPR(669.9,RMPRSC,5,"B",DUZ)) Q "RTN","RMPR9DO",22,0) . S WHO=$O(^RMPR(669.9,RMPRSC,5,"B",DUZ,"")) "RTN","RMPR9DO",23,0) . I START="" S START=$P(^RMPR(669.9,RMPRSC,5,WHO,0),U,2) "RTN","RMPR9DO",24,0) . I STOP="" S STOP=$P(^RMPR(669.9,RMPRSC,5,WHO,0),U,3) "RTN","RMPR9DO",25,0) A2 N STRING,CLREND,COLUMN,ON,OFF "RTN","RMPR9DO",26,0) Q:SORT="" "RTN","RMPR9DO",27,0) Q:DATE="" "RTN","RMPR9DO",28,0) Q:START="" "RTN","RMPR9DO",29,0) Q:STOP="" "RTN","RMPR9DO",30,0) Q:SITE="" "RTN","RMPR9DO",31,0) I SITE'="ALL" S SITE=$P(^RMPR(669.9,SITE,0),U,2) "RTN","RMPR9DO",32,0) K ^TMP($J) "RTN","RMPR9DO",33,0) N RMPRA,CDATE,X "RTN","RMPR9DO",34,0) K ADATE,PDAY,RMPRCD "RTN","RMPR9DO",35,0) S VALMCNT=0,RRX="" "RTN","RMPR9DO",36,0) ;if sort for open or pending include all regardless of date "RTN","RMPR9DO",37,0) ;if sort for cancelled or closed include from date passed forward "RTN","RMPR9DO",38,0) ; "RTN","RMPR9DO",39,0) ;PPD# status=pending before date, total days create to 1st action "RTN","RMPR9DO",40,0) ;MHD# manual totals days create to 1st action "RTN","RMPR9DO",41,0) ;CHD# consult totals days create to 1st action "RTN","RMPR9DO",42,0) ;PPDD# status=pending before date, total days in pending state, 1st "RTN","RMPR9DO",43,0) ; action to current date "RTN","RMPR9DO",44,0) ; "RTN","RMPR9DO",45,0) S (LINE,MHD1,MHD2,MHD3,MHD4,MHD5,CHD1,CHD2,CHD3,CHD4,CHD5,CLNK,MLNK)=0 "RTN","RMPR9DO",46,0) S (PPDAY,PPD,PPD1,PPD2,PPD3,PPD4,PPD5)=0 "RTN","RMPR9DO",47,0) S (PPDDAY,PPDD1,PPDD2,PPDD3,PPDD4,PPDD5)=0 "RTN","RMPR9DO",48,0) I SORT["O"!(SORT["P") D ALL "RTN","RMPR9DO",49,0) I SORT["C"!(SORT["X") D DTFWD "RTN","RMPR9DO",50,0) ;S LINE=LINE+1 "RTN","RMPR9DO",51,0) S ^TMP($J,"A1")="^^^^^^^^"_MHD1_U_MHD2_U_MHD3_U_MHD4_U_MHD5_"^^^^"_MLNK_U_0 "RTN","RMPR9DO",52,0) I $G(WHAT)="S" S RMPRXM(1)=MHD1_U_MHD2_U_MHD3_U_MHD4_U_MHD5_U_MLNK_U_0 "RTN","RMPR9DO",53,0) ;S LINE=LINE+1 "RTN","RMPR9DO",54,0) S ^TMP($J,"A2")="^^^^^^^^"_CHD1_U_CHD2_U_CHD3_U_CHD4_U_CHD5_"^^^^"_CLNK_U_1 "RTN","RMPR9DO",55,0) I $G(WHAT)="S" S RMPRXM(2)=CHD1_U_CHD2_U_CHD3_U_CHD4_U_CHD5_U_CLNK_U_1 "RTN","RMPR9DO",56,0) ;S LINE=LINE+1 "RTN","RMPR9DO",57,0) I $G(WHAT)="S" S RMPRXM(3)=PPD1_U_PPD2_U_PPD3_U_PPD4_U_PPD5_U_U_2 "RTN","RMPR9DO",58,0) S ^TMP($J,"A3")="^^^^^^^^"_PPDD1_U_PPDD2_U_PPDD3_U_PPDD4_U_PPDD5_"^^^^^"_2 "RTN","RMPR9DO",59,0) ;S LINE=LINE+1 "RTN","RMPR9DO",60,0) S ^TMP($J,"A4")="^^^^^^^^"_PPD1_U_PPD2_U_PPD3_U_PPD4_U_PPD5_"^^^^^"_3 "RTN","RMPR9DO",61,0) ;quarter rollup with full data "RTN","RMPR9DO",62,0) I $G(WHAT)="Q" D MAIL "RTN","RMPR9DO",63,0) ;summary only "RTN","RMPR9DO",64,0) I $G(WHAT)="S" D MAILG "RTN","RMPR9DO",65,0) I $G(WHAT)="ALL" D MAILG,MAIL "RTN","RMPR9DO",66,0) I '$G(WHAT) G EXIT "RTN","RMPR9DO",67,0) Q "RTN","RMPR9DO",68,0) ALL ;all open pending records regardless of date passed "RTN","RMPR9DO",69,0) S RMPRI1=0 "RTN","RMPR9DO",70,0) F RMPRI1=START:1:STOP D "RTN","RMPR9DO",71,0) .I $L(RMPRI1)=1 S RMPRI=0_RMPRI1 "RTN","RMPR9DO",72,0) .E S RMPRI=RMPRI1 "RTN","RMPR9DO",73,0) .S RMPRST="" "RTN","RMPR9DO",74,0) .F S RMPRST=$O(^RMPR(668,"L1",RMPRI,RMPRST)) Q:RMPRST="" D "RTN","RMPR9DO",75,0) . .Q:RMPRST="X" "RTN","RMPR9DO",76,0) . .Q:RMPRST="C" "RTN","RMPR9DO",77,0) . .I SORT'["P"&(RMPRST="P") Q "RTN","RMPR9DO",78,0) . .S RMPRA=0 "RTN","RMPR9DO",79,0) . .F S RMPRA=$O(^RMPR(668,"L1",RMPRI,RMPRST,RMPRA)) Q:RMPRA'>0 D "RTN","RMPR9DO",80,0) . . .S STN=$P(^RMPR(668,RMPRA,0),U,7) "RTN","RMPR9DO",81,0) . . .I SITE'="ALL"&(SITE'=STN) Q "RTN","RMPR9DO",82,0) . . .S STNX=$$STATN^RMPRUTIL(STN) "RTN","RMPR9DO",83,0) . . .I $G(WHAT)="S" S VISNX=$P($G(^RMPR(669.9,STN1,"INV")),U,2) "RTN","RMPR9DO",84,0) . . .S STS=$P(^RMPR(668,RMPRA,0),U,10) "RTN","RMPR9DO",85,0) . . .Q:STS["X" "RTN","RMPR9DO",86,0) . . .Q:STS["C" "RTN","RMPR9DO",87,0) . . .I SORT'["O"&(STS="O") Q "RTN","RMPR9DO",88,0) . . .I SORT'["P"&(STS="P") Q "RTN","RMPR9DO",89,0) . . .D REC "RTN","RMPR9DO",90,0) Q "RTN","RMPR9DO",91,0) DTFWD ;from date passed forward "RTN","RMPR9DO",92,0) S RMPRI1=0 "RTN","RMPR9DO",93,0) F RMPRI1=START:1:STOP D "RTN","RMPR9DO",94,0) .I $L(RMPRI1)=1 S RMPRI=0_RMPRI1 "RTN","RMPR9DO",95,0) .E S RMPRI=RMPRI1 "RTN","RMPR9DO",96,0) .S RMPRDTM="" "RTN","RMPR9DO",97,0) .F S RMPRDTM=$O(^RMPR(668,"L",RMPRI,RMPRDTM)) Q:RMPRDTM="" D "RTN","RMPR9DO",98,0) ..Q:RMPRDTM="" "RTN","RMPR9DO",99,0) ..Q:RMPRDTM0 D "RTN","RMPR9DO",108,0) .. . .Q:RMPRA="" "RTN","RMPR9DO",109,0) .. . .S STN=$P(^RMPR(668,RMPRA,0),U,7) "RTN","RMPR9DO",110,0) .. . .I SITE'="ALL"&(SITE'=STN) Q "RTN","RMPR9DO",111,0) .. . .S STNX=$$STATN^RMPRUTIL(STN) "RTN","RMPR9DO",112,0) .. . .I $G(WHAT)'="" S VISNX=$P($G(^RMPR(669.9,SITE,"INV")),U,2) "RTN","RMPR9DO",113,0) .. . .S STS=$P(^RMPR(668,RMPRA,0),U,10) "RTN","RMPR9DO",114,0) .. . .Q:STS["O" "RTN","RMPR9DO",115,0) .. . .Q:STS["P" "RTN","RMPR9DO",116,0) .. . .I SORT'["C"&(STS="C") Q "RTN","RMPR9DO",117,0) .. . .I SORT'["X"&(STS="X") Q "RTN","RMPR9DO",118,0) .. . .D REC "RTN","RMPR9DO",119,0) S RMPRDTC=$P(DATE,".",1) "RTN","RMPR9DO",120,0) F S RMPRDTC=$O(^RMPR(668,"CD",RMPRDTC)) Q:RMPRDTC="" D "RTN","RMPR9DO",121,0) .Q:RMPRDTC5 "RTN","RMPR9DO",125,0) . .S RMPRA=0 "RTN","RMPR9DO",126,0) . .F S RMPRA=$O(^RMPR(668,"CD",RMPRDTC,RMPRDYS,RMPRA)) Q:RMPRA'>0 D "RTN","RMPR9DO",127,0) . . .;check site "RTN","RMPR9DO",128,0) . . .S STN=$P(^RMPR(668,RMPRA,0),U,7) "RTN","RMPR9DO",129,0) . . .I SITE'="ALL"&(SITE'=STN) Q "RTN","RMPR9DO",130,0) . . .S STNX=$$STATN^RMPRUTIL(STN) "RTN","RMPR9DO",131,0) . . .;check status "RTN","RMPR9DO",132,0) . . .S STS=$P(^RMPR(668,RMPRA,0),U,10) "RTN","RMPR9DO",133,0) . . .I SORT'["O"&(STS="O") Q "RTN","RMPR9DO",134,0) . . .I SORT'["P"&(STS="P") Q "RTN","RMPR9DO",135,0) . . .I SORT'["C"&(STS="C") Q "RTN","RMPR9DO",136,0) . . .I SORT'["X"&(STS="X") Q "RTN","RMPR9DO",137,0) . . .;ssn range filter "RTN","RMPR9DO",138,0) . . .S DFN=$P(^RMPR(668,RMPRA,0),U,2) "RTN","RMPR9DO",139,0) . . .D DEM^VADPT "RTN","RMPR9DO",140,0) . . .S SSNEN=$E($P(VADM(2),"^",2),10,11) "RTN","RMPR9DO",141,0) . . .I SSNEN>STOP Q "RTN","RMPR9DO",142,0) . . .I SSNEN0:"",VASV(12)>0:"",VASV(13)>0:"",1:0) "RTN","RMPR9DO",165,0) D KVAR^VADPT "RTN","RMPR9DO",166,0) ;type "RTN","RMPR9DO",167,0) S TYPE=$$TYPE^RMPREOU(RMPRA,8) "RTN","RMPR9DO",168,0) ;display description if manual "RTN","RMPR9DO",169,0) S DES=$$DES^RMPREOU(RMPRA,22) "RTN","RMPR9DO",170,0) S DES=$TR(DES,"^","*") "RTN","RMPR9DO",171,0) S DES=$TR(DES,"""","'") "RTN","RMPR9DO",172,0) ;init action date "RTN","RMPR9DO",173,0) S ADATE="",PDAY="",WRKDAY="" "RTN","RMPR9DO",174,0) S ADATE=$P(^RMPR(668,RMPRA,0),U,9) "RTN","RMPR9DO",175,0) ;PPD=1 for previous pending "RTN","RMPR9DO",176,0) I ADATE'="" S (PDAY,WRKDAY)=$$WRKDAY^RMPREOU(RMPRA) "RTN","RMPR9DO",177,0) I ADATE="" S (PDAY,WRKDAY)=$$CWRKDAY^RMPREOU(RMPRA) "RTN","RMPR9DO",178,0) I ADATE'="" S CDAY=$$PDAY^RMPREOU(RMPRA) "RTN","RMPR9DO",179,0) S STATUS=$$STATUS^RMPREOU(RMPRA) "RTN","RMPR9DO",180,0) I STATUS["PENDING" D "RTN","RMPR9DO",181,0) .I ADATE'=""&(ADATE0)&(PDAY<6)!(PDAY=0) S HD1=PDAY,DH6="NO" "RTN","RMPR9DO",193,0) I (PPDAY>0)&(PPDAY<6)!(PPDAY=0) S SD1=PPDAY "RTN","RMPR9DO",194,0) I (PDAY>0)&(PDAY<6)&(TYPE["MANUAL")!(PDAY=0)&(TYPE["MANUAL") S MHD1=MHD1+1 "RTN","RMPR9DO",195,0) I (PDAY>0)&(PDAY<6)&(TYPE'["MANUAL")!(PDAY=0)&(TYPE'["MANUAL") S CHD1=CHD1+1 "RTN","RMPR9DO",196,0) I (PPDAY>0)&(PPDAY<6)&(STATUS["PENDING") S PPDD1=PPDD1+1 "RTN","RMPR9DO",197,0) I (PDAY>0)&(PDAY<6)&(PPD=1) S PPD1=PPD1+1 "RTN","RMPR9DO",198,0) I HD1="" S HD1=0 "RTN","RMPR9DO",199,0) I (PDAY>5)&(PDAY<10) S HD2=PDAY,DH6="YES" "RTN","RMPR9DO",200,0) I (PPDAY>5)&(PPDAY<10) S SD2=PPDAY "RTN","RMPR9DO",201,0) I (PDAY>5)&(PDAY<10)&(TYPE["MANUAL") S MHD2=MHD2+1 "RTN","RMPR9DO",202,0) I (PDAY>5)&(PDAY<10)&(TYPE'["MANUAL") S CHD2=CHD2+1 "RTN","RMPR9DO",203,0) I (PPDAY>5)&(PPDAY<10)&(STATUS["PENDING") S PPDD2=PPDD2+1 "RTN","RMPR9DO",204,0) I (PDAY>5)&(PDAY<10)&(PPD=1) S PPD2=PPD2+1 "RTN","RMPR9DO",205,0) I HD2="" S HD2=0 "RTN","RMPR9DO",206,0) I (PDAY>9)&(PDAY<30) S HD3=PDAY,DH6="YES" "RTN","RMPR9DO",207,0) I (PPDAY>9)&(PPDAY<30) S SD3=PPDAY "RTN","RMPR9DO",208,0) I (PDAY>9)&(PDAY<30)&(TYPE["MANUAL") S MHD3=MHD3+1 "RTN","RMPR9DO",209,0) I (PDAY>9)&(PDAY<30)&(TYPE'["MANUAL") S CHD3=CHD3+1 "RTN","RMPR9DO",210,0) I (PPDAY>9)&(PPDAY<30)&(STATUS["PENDING") S PPDD3=PPDD3+1 "RTN","RMPR9DO",211,0) I (PDAY>9)&(PDAY<30)&(PPD=1) S PPD3=PPD3+1 "RTN","RMPR9DO",212,0) I HD3="" S HD3=0 "RTN","RMPR9DO",213,0) I (PDAY>29)&(PDAY<90) S HD4=PDAY,DH6="YES" "RTN","RMPR9DO",214,0) I (PPDAY>29)&(PPDAY<90) S SD4=PPDAY "RTN","RMPR9DO",215,0) I (PDAY>29)&(PDAY<90)&(TYPE["MANUAL") S MHD4=MHD4+1 "RTN","RMPR9DO",216,0) I (PDAY>29)&(PDAY<90)&(TYPE'["MANUAL") S CHD4=CHD4+1 "RTN","RMPR9DO",217,0) I (PPDAY>29)&(PPDAY<90)&(STATUS["PENDING") S PPDD4=PPDD4+1 "RTN","RMPR9DO",218,0) I (PDAY>29)&(PDAY<90)&(PPD=1) S PPD4=PPD4+1 "RTN","RMPR9DO",219,0) I HD4="" S HD4=0 "RTN","RMPR9DO",220,0) I PDAY>89 S HD5=PDAY,DH6="YES" "RTN","RMPR9DO",221,0) I PPDAY>89 S SD5=PPDAY "RTN","RMPR9DO",222,0) I (PDAY>89)&(TYPE["MANUAL") S MHD5=MHD5+1 "RTN","RMPR9DO",223,0) I (PDAY>89)&(TYPE'["MANUAL") S CHD5=CHD5+1 "RTN","RMPR9DO",224,0) I (PPDAY>89)&(STATUS["PENDING") S PPDD5=PPDD5+1 "RTN","RMPR9DO",225,0) I (PDAY>89)&(PPD=1) S PPD5=PPD5+1 "RTN","RMPR9DO",226,0) I HD5="" S HD5=0 "RTN","RMPR9DO",227,0) S (PPD,PPDAY)=0 "RTN","RMPR9DO",228,0) I LINKED'=0&(TYPE["MANUAL") S MLNK=MLNK+1 "RTN","RMPR9DO",229,0) I LINKED'=0&(TYPE'["MANUAL") S CLNK=CLNK+1 "RTN","RMPR9DO",230,0) S ^TMP($J,RMPRA)=^TMP($J,RMPRA)_STOPDT_U_DH6_U_HD1_U_HD2_U_HD3_U_HD4_U_HD5 "RTN","RMPR9DO",231,0) S ^TMP($J,RMPRA)=^TMP($J,RMPRA)_U_STATUS_U_RMPRA_U_STNX_U_LINKED "RTN","RMPR9DO",232,0) S ^TMP($J,RMPRA)=^TMP($J,RMPRA)_U_U_SD1_U_SD2_U_SD3_U_SD4_U_SD5 "RTN","RMPR9DO",233,0) K CDATE,WHO,SSN,TYPE,DES,PDAY,STATUS,ADATE "RTN","RMPR9DO",234,0) ;PUT RESULTS IN GLOBAL!! "RTN","RMPR9DO",235,0) Q "RTN","RMPR9DO",236,0) EXIT ;common exit point "RTN","RMPR9DO",237,0) S RESULT=$NA(^TMP($J)) "RTN","RMPR9DO",238,0) Q "RTN","RMPR9DO",239,0) MAIL ;send to PCM full dataset "RTN","RMPR9DO",240,0) S XMY("G.RMPR SERVER")="" "RTN","RMPR9DO",241,0) S XMY("G.PROSTHETICS@PSAS.MED.VA.GOV")="" "RTN","RMPR9DO",242,0) S XMDUZ=.5 "RTN","RMPR9DO",243,0) S XMSUB="Full DOR From Station: "_STNX "RTN","RMPR9DO",244,0) N LASTIEN "RTN","RMPR9DO",245,0) S LASTIEN="A1",LASTIEN=$O(^TMP($J,LASTIEN),-1) "RTN","RMPR9DO",246,0) S ^TMP($J,LASTIEN+1)=^TMP($J,"A1") "RTN","RMPR9DO",247,0) S ^TMP($J,LASTIEN+2)=^TMP($J,"A2") "RTN","RMPR9DO",248,0) S ^TMP($J,LASTIEN+3)=^TMP($J,"A3") "RTN","RMPR9DO",249,0) S ^TMP($J,LASTIEN+4)=^TMP($J,"A4") "RTN","RMPR9DO",250,0) K ^TMP($J,"A1") "RTN","RMPR9DO",251,0) K ^TMP($J,"A2") "RTN","RMPR9DO",252,0) K ^TMP($J,"A3") "RTN","RMPR9DO",253,0) K ^TMP($J,"A4") "RTN","RMPR9DO",254,0) S XMTEXT="^TMP($J," "RTN","RMPR9DO",255,0) D ^XMD "RTN","RMPR9DO",256,0) Q "RTN","RMPR9DO",257,0) MAILG ;Mail message to local staff "RTN","RMPR9DO",258,0) S XMDUZ=.5 "RTN","RMPR9DO",259,0) S XMY("G.RMPR SERVER")="" "RTN","RMPR9DO",260,0) S XMY("VHACOPSASPIPReport@MED.VA.GOV")="" "RTN","RMPR9DO",261,0) S XMSUB="DOR From Station: "_STNX "RTN","RMPR9DO",262,0) S RMPRMSG(1)="The Automated Delayed Order Report has transmitted to Prosthetics HQ." "RTN","RMPR9DO",263,0) S RMPRMSG(2)="This was activated by "_$P(XMFROM,"@",1) "RTN","RMPR9DO",264,0) S RMPRMSG(3)="" "RTN","RMPR9DO",265,0) S RMPRMSG(4)="Summary Data Transmitted, includes the following:" "RTN","RMPR9DO",266,0) S RMPRMSG(5)="Totals for site "_STNX_" listed in the order of 0-5, 6-9, 10-29, 30-89, 90+" "RTN","RMPR9DO",267,0) S RMPRMSG(6)="Seperated by ;" "RTN","RMPR9DO",268,0) S RMPRMSG(7)="***Number of MANUALS ;;"_STNX_";"_MHD1_";"_MHD2_";"_MHD3_";"_MHD4_";"_MHD5 "RTN","RMPR9DO",269,0) S RMPRMSG(8)="***Number of CONSULTS ;;"_STNX_";"_CHD1_";"_CHD2_";"_CHD3_";"_CHD4_";"_CHD5 "RTN","RMPR9DO",270,0) S RMPRMSG(9)="***Minus Previous Pending ;;"_STNX_";"_PPD1_";"_PPD2_";"_PPD3_";"_PPD4_";"_PPD5 "RTN","RMPR9DO",271,0) S RMPRMSG(10)="" "RTN","RMPR9DO",272,0) S XMTEXT="RMPRMSG(" "RTN","RMPR9DO",273,0) D ^XMD "RTN","RMPR9DO",274,0) Q "RTN","RMPR9LN1") 0^5^B9416364^B7935718 "RTN","RMPR9LN1",1,0) RMPR9LN1 ;HOIFO/HNC - FLEX FIELD SORT;9/18/02 11:38 "RTN","RMPR9LN1",2,0) ;;3.0;PROSTHETICS;**90,75,60**;Feb 09, 1996;Build 18 "RTN","RMPR9LN1",3,0) ;SPS - Patch 75 added DALC section at the end. "RTN","RMPR9LN1",4,0) EN(RESULT) ; "RTN","RMPR9LN1",5,0) ;RESULT passed to broker in ^TMP($J, "RTN","RMPR9LN1",6,0) ;delimited by "^" "RTN","RMPR9LN1",7,0) K ^TMP($J) "RTN","RMPR9LN1",8,0) N RMPRII,RMPRLN "RTN","RMPR9LN1",9,0) S CNT=0 "RTN","RMPR9LN1",10,0) F RMPRII=1:1 S RMPRLN=$P($T(HLST+RMPRII),";",4) Q:RMPRLN="" D "RTN","RMPR9LN1",11,0) .S RMPRFLD=$P($T(HLST+RMPRII),";",3) "RTN","RMPR9LN1",12,0) .S CNT=CNT+1 "RTN","RMPR9LN1",13,0) .S ^TMP($J,"RMPR",CNT)=RMPRLN_U_RMPRFLD "RTN","RMPR9LN1",14,0) S RESULT=$NA(^TMP($J)) "RTN","RMPR9LN1",15,0) Q "RTN","RMPR9LN1",16,0) HLST ;pick list "RTN","RMPR9LN1",17,0) ;;0;*** COMMON/PURCHASING *** "RTN","RMPR9LN1",18,0) ;;1;Date Item Added To PO "RTN","RMPR9LN1",19,0) ;;2;Type Of Transaction "RTN","RMPR9LN1",20,0) ;;4;Billing Item "RTN","RMPR9LN1",21,0) ;;10;Delivery Date "RTN","RMPR9LN1",22,0) ;;11;Form "RTN","RMPR9LN1",23,0) ;;12;Souce "RTN","RMPR9LN1",24,0) ;;14;Total Cost "RTN","RMPR9LN1",25,0) ;;16;Remarks "RTN","RMPR9LN1",26,0) ;;23;Transaction Number or PO Number "RTN","RMPR9LN1",27,0) ;;24;Brief Description "RTN","RMPR9LN1",28,0) ;;25;Deliver To "RTN","RMPR9LN1",29,0) ;;27;Initiator "RTN","RMPR9LN1",30,0) ;;38.1;Exclude/Waiver "RTN","RMPR9LN1",31,0) ;;38.7;Contract # "RTN","RMPR9LN1",32,0) ;;62;Patient Category "RTN","RMPR9LN1",33,0) ;;63;Special Category "RTN","RMPR9LN1",34,0) ;;34;OIF/OEF "RTN","RMPR9LN1",35,0) ;;78;Unit Of Issue "RTN","RMPR9LN1",36,0) ;;89;Saved Item Description "RTN","RMPR9LN1",37,0) ;;0;*** INVENTORY *** "RTN","RMPR9LN1",38,0) ;;4.6;Stock Issue Date "RTN","RMPR9LN1",39,0) ;;37;PIP Item Description "RTN","RMPR9LN1",40,0) ;;38;HCPCS PIP Description "RTN","RMPR9LN1",41,0) ;;0;*** PRODUCT INFORMATION *** "RTN","RMPR9LN1",42,0) ;;4.9;Coding Error Flag "RTN","RMPR9LN1",43,0) ;;4.91;Coding Flag Date "RTN","RMPR9LN1",44,0) ;;8.12;PCE "RTN","RMPR9LN1",45,0) ;;8.13;PCE Date "RTN","RMPR9LN1",46,0) ;;9;Serial Number "RTN","RMPR9LN1",47,0) ;;9.1;Product Description "RTN","RMPR9LN1",48,0) ;;9.2;Product Model "RTN","RMPR9LN1",49,0) ;;21;Lot Number "RTN","RMPR9LN1",50,0) ;;35;Who Edit 2319 "RTN","RMPR9LN1",51,0) ;;36;Date of Edit 2319 "RTN","RMPR9LN1",52,0) ;;0;*** SUSPENSE *** "RTN","RMPR9LN1",53,0) ;;8.1;Suspense Date "RTN","RMPR9LN1",54,0) ;;8.11;Suspense Station "RTN","RMPR9LN1",55,0) ;;8.14;Suspense Status "RTN","RMPR9LN1",56,0) ;;8.2;Date RX Written "RTN","RMPR9LN1",57,0) ;;8.3;Initial Action Date "RTN","RMPR9LN1",58,0) ;;8.4;Completion Date "RTN","RMPR9LN1",59,0) ;;8.5;Type of Request "RTN","RMPR9LN1",60,0) ;;8.6;Suspense Requestor "RTN","RMPR9LN1",61,0) ;;8.61;Consult Request Service "RTN","RMPR9LN1",62,0) ;;8.7;Provisional Diagnosis "RTN","RMPR9LN1",63,0) ;;8.8;Suspense ICD9 "RTN","RMPR9LN1",64,0) ;;8.9;Consult Date "RTN","RMPR9LN1",65,0) ;;0;*** RETURNED ITEMS *** "RTN","RMPR9LN1",66,0) ;;13;Action "RTN","RMPR9LN1",67,0) ;;17;Returned Status "RTN","RMPR9LN1",68,0) ;;17.5;Retruned Status Date "RTN","RMPR9LN1",69,0) ;;0;*** ORTHO LAB *** "RTN","RMPR9LN1",70,0) ;;40;Lab Requesting Station "RTN","RMPR9LN1",71,0) ;;45;Total Lab Labor Hours "RTN","RMPR9LN1",72,0) ;;46;Total Lab Labor Cost "RTN","RMPR9LN1",73,0) ;;47;Total Lab Material Cost "RTN","RMPR9LN1",74,0) ;;48;Total Lab Cost "RTN","RMPR9LN1",75,0) ;;50;Lab Completion Date "RTN","RMPR9LN1",76,0) ;;51;Lab Remarks "RTN","RMPR9LN1",77,0) ;;69;Source of Procurement "RTN","RMPR9LN1",78,0) ;;70;Receiving Station "RTN","RMPR9LN1",79,0) ;;71;Work Order Number "RTN","RMPR9LN1",80,0) ;;72;2529-3 Date "RTN","RMPR9LN1",81,0) ;;4.92;HIGH TECH ITEM "RTN","RMPR9LN1",82,0) ;;72.5;FREE TEXT WO # "RTN","RMPR9LN1",83,0) ;;80;Lab Work for Other Station "RTN","RMPR9LN1",84,0) ;;81;NO ADMIN COUNT "RTN","RMPR9LN1",85,0) ;;0;*** DALC *** "RTN","RMPR9LN1",86,0) ;;89.1;DALC REFERENCE NUMBER "RTN","RMPR9LN1",87,0) ;;89.2;DALC BILLING DATE "RTN","RMPR9LN1",88,0) ;;89;DALC ITEM "RTN","RMPR9LN1",89,0) ;;4.2;WHO PLACED ORDER "RTN","RMPR9LN1",90,0) ;;89.3;DALC ORDERING STATION "RTN","RMPR9LN1",91,0) ;;90;DALC BILLING STATION "RTN","RMPR9LN1",92,0) ;;91;DALC VENDOR "RTN","RMPR9LN1",93,0) ;;92;DALC DUNS "RTN","RMPR9LN1",94,0) ;;93;DALC TAXID "RTN","RMPR9LN1",95,0) ;END "RTN","RMPR9LNP") 0^4^B11485144^B10235375 "RTN","RMPR9LNP",1,0) RMPR9LNP ;Hines OIFO/HNC - REMOTE PROCEDURE, LIST NPPD DATA ;9/8/03 07:23 "RTN","RMPR9LNP",2,0) ;;3.0;PROSTHETICS;**71,77,90,75,60**;Feb 09, 1996;Build 18 "RTN","RMPR9LNP",3,0) ; "RTN","RMPR9LNP",4,0) ; HNC - Sept 2, 2003 - patch 77 remove the " for Excel CSV "RTN","RMPR9LNP",5,0) ; HNC - Feb 14, 2005 - patch 90 add flex field to GUI display "RTN","RMPR9LNP",6,0) ; HNC - Nov 15, 2005 - patch 75 add 2 additional flex field to gui "RTN","RMPR9LNP",7,0) ; "RTN","RMPR9LNP",8,0) ;RESULTS passed to broker in ^TMP($J, "RTN","RMPR9LNP",9,0) ;delimited by "^" "RTN","RMPR9LNP",10,0) ;piece 1 = ENTRY DATE "RTN","RMPR9LNP",11,0) ;piece 2 = PATIENT NAME IF OEF/OIF PRECEDES THE NAME "RTN","RMPR9LNP",12,0) ;piece 3 = PSAS HCPCS with * if hcpcs has Calculation Flag "RTN","RMPR9LNP",13,0) ;piece 4 = QTY "RTN","RMPR9LNP",14,0) ;piece 5 = VENDOR "RTN","RMPR9LNP",15,0) ;piece 6 = INITIAL ACTION DATE "RTN","RMPR9LNP",16,0) ;piece 7 = TOTAL COST "RTN","RMPR9LNP",17,0) ;piece 8 = DESCRIPTION "RTN","RMPR9LNP",18,0) ;piece 9 = INITIATOR "RTN","RMPR9LNP",19,0) ;piece 10 = NPPD LINE BEFORE GROUPER "RTN","RMPR9LNP",20,0) ;piece 11 = STATION "RTN","RMPR9LNP",21,0) ;piece 12 = GROUPER NUMBER "RTN","RMPR9LNP",22,0) ;piece 13 = FORM REQUESTED ON "RTN","RMPR9LNP",23,0) ;piece 14 = TYPE OF TRANSACTION "RTN","RMPR9LNP",24,0) ;piece 15 = SSN "RTN","RMPR9LNP",25,0) ;piece 16 = IEN TO FILE 660 "RTN","RMPR9LNP",26,0) ;piece 17 = HCPCS SHORT DESCRIPTION "RTN","RMPR9LNP",27,0) ;piece 18 = SOURCE "RTN","RMPR9LNP",28,0) ;piece 19 = Optional Flex Field "RTN","RMPR9LNP",29,0) ;piece 20 = Optional Flex Field "RTN","RMPR9LNP",30,0) ;piece 21 = Optional Flex Field "RTN","RMPR9LNP",31,0) Q "RTN","RMPR9LNP",32,0) ; "RTN","RMPR9LNP",33,0) EN(RESULT,DATE1,DATE2,FLEXF,FLEX2,FLEX3) ;broker entry point "RTN","RMPR9LNP",34,0) ; "RTN","RMPR9LNP",35,0) K ^TMP($J) "RTN","RMPR9LNP",36,0) I '$D(DATE1)!('$D(DATE2)) G EXIT "RTN","RMPR9LNP",37,0) S DATE=DATE1-1 "RTN","RMPR9LNP",38,0) F S DATE=$O(^RMPR(660,"B",DATE)) Q:(DATE="")!($P(DATE,".",1)>DATE2) D "RTN","RMPR9LNP",39,0) .S RMPRB=0 "RTN","RMPR9LNP",40,0) .F S RMPRB=$O(^RMPR(660,"B",DATE,RMPRB)) Q:RMPRB="" D "RTN","RMPR9LNP",41,0) ..I $P(^RMPR(660,RMPRB,0),U,15)["*" Q:$P($G(^RMPR(660,RMPRB,"HSTV1")),U,3)="" "RTN","RMPR9LNP",42,0) ..S PHCPCS=$P($G(^RMPR(660,RMPRB,1)),U,4) "RTN","RMPR9LNP",43,0) ..Q:PHCPCS="" "RTN","RMPR9LNP",44,0) ..Q:PHCPCS'>0 "RTN","RMPR9LNP",45,0) ..S HDES=$P(^RMPR(661.1,PHCPCS,0),U,2) "RTN","RMPR9LNP",46,0) ..S TYPE=$P($G(^RMPR(660,RMPRB,0)),U,4) "RTN","RMPR9LNP",47,0) ..I TYPE'="X" S LINE=$P(^RMPR(661.1,PHCPCS,0),U,7) "RTN","RMPR9LNP",48,0) ..I TYPE="X" S LINE=$P(^RMPR(661.1,PHCPCS,0),U,6) "RTN","RMPR9LNP",49,0) ..S CAL=$P(^RMPR(661.1,PHCPCS,0),U,8) "RTN","RMPR9LNP",50,0) ..I CAL'="" S CAL="*" "RTN","RMPR9LNP",51,0) ..S DFN=$P(^RMPR(660,RMPRB,0),U,2) "RTN","RMPR9LNP",52,0) ..D DEM^VADPT,SVC^VADPT "RTN","RMPR9LNP",53,0) ..S RMPROEOI=$S(VASV(11)>0:"",VASV(12)>0:"",VASV(13)>0:"",1:0) "RTN","RMPR9LNP",54,0) ..D DATA "RTN","RMPR9LNP",55,0) S RESULT=$NA(^TMP($J)) "RTN","RMPR9LNP",56,0) K DATE,DFN,HDES,LINE,PHCPCS,RMPRB,RMPRFLD,TYPE,B "RTN","RMPR9LNP",57,0) Q "RTN","RMPR9LNP",58,0) ; "RTN","RMPR9LNP",59,0) DATA ; "RTN","RMPR9LNP",60,0) S B=RMPRB "RTN","RMPR9LNP",61,0) I FLEXF'="" S RMPRFLD=".01;.02;4.5;5;7;8;8.3;11;12;14;24;27;68;"_FLEXF "RTN","RMPR9LNP",62,0) I FLEXF="" S RMPRFLD=".01;.02;4.5;5;7;8;8.3;11;12;14;24;27;68" "RTN","RMPR9LNP",63,0) I FLEX2'="" S RMPRFLD=RMPRFLD_";"_FLEX2 "RTN","RMPR9LNP",64,0) I FLEX3'="" S RMPRFLD=RMPRFLD_";"_FLEX3 "RTN","RMPR9LNP",65,0) D GETS^DIQ(660,B,RMPRFLD,"","RMXM") "RTN","RMPR9LNP",66,0) S RMPRPTNM=$G(RMXM(660,B_",",.02)) "RTN","RMPR9LNP",67,0) I RMPROEOI["<" S RMPRPTNM=RMPROEOI_RMPRPTNM "RTN","RMPR9LNP",68,0) S $P(^TMP($J,B),U,1)=$G(RMXM(660,B_",",.01)) "RTN","RMPR9LNP",69,0) S $P(^TMP($J,B),U,2)=RMPRPTNM "RTN","RMPR9LNP",70,0) S $P(^TMP($J,B),U,3)=$G(RMXM(660,B_",",4.5))_CAL "RTN","RMPR9LNP",71,0) S $P(^TMP($J,B),U,4)=$G(RMXM(660,B_",",5)) "RTN","RMPR9LNP",72,0) S $P(^TMP($J,B),U,5)=$G(RMXM(660,B_",",7)) "RTN","RMPR9LNP",73,0) S $P(^TMP($J,B),U,6)=$G(RMXM(660,B_",",8.3)) "RTN","RMPR9LNP",74,0) S $P(^TMP($J,B),U,7)=$G(RMXM(660,B_",",14)) "RTN","RMPR9LNP",75,0) ;patch 77 remove the " for Excel CSV "RTN","RMPR9LNP",76,0) S $P(^TMP($J,B),U,8)=$TR($G(RMXM(660,B_",",24)),"""","'") "RTN","RMPR9LNP",77,0) S $P(^TMP($J,B),U,9)=$G(RMXM(660,B_",",27)) "RTN","RMPR9LNP",78,0) S $P(^TMP($J,B),U,10)=LINE "RTN","RMPR9LNP",79,0) S $P(^TMP($J,B),U,11)=$G(RMXM(660,B_",",8)) "RTN","RMPR9LNP",80,0) S $P(^TMP($J,B),U,12)=$G(RMXM(660,B_",",68)) "RTN","RMPR9LNP",81,0) S $P(^TMP($J,B),U,13)=$G(RMXM(660,B_",",11)) "RTN","RMPR9LNP",82,0) S $P(^TMP($J,B),U,14)=TYPE "RTN","RMPR9LNP",83,0) S $P(^TMP($J,B),U,15)=$P(VADM(2),U,2) "RTN","RMPR9LNP",84,0) S $P(^TMP($J,B),U,16)=B "RTN","RMPR9LNP",85,0) S $P(^TMP($J,B),U,17)=HDES "RTN","RMPR9LNP",86,0) S $P(^TMP($J,B),U,18)=$E($G(RMXM(660,B_",",12)),0,1) "RTN","RMPR9LNP",87,0) I FLEXF'="" S $P(^TMP($J,B),U,19)=$G(RMXM(660,B_",",FLEXF)) "RTN","RMPR9LNP",88,0) I FLEXF="" S $P(^TMP($J,B),U,19)="" "RTN","RMPR9LNP",89,0) I FLEX2'="" S $P(^TMP($J,B),U,20)=$G(RMXM(660,B_",",FLEX2)) "RTN","RMPR9LNP",90,0) I FLEX2="" S $P(^TMP($J,B),U,20)="" "RTN","RMPR9LNP",91,0) I FLEX3'="" S $P(^TMP($J,B),U,21)=$G(RMXM(660,B_",",FLEX3)) "RTN","RMPR9LNP",92,0) I FLEX3="" S $P(^TMP($J,B),U,21)="" "RTN","RMPR9LNP",93,0) K RMXM,VADM,CAL "RTN","RMPR9LNP",94,0) Q "RTN","RMPR9LNP",95,0) EXIT ;common exit point "RTN","RMPR9LNP",96,0) Q "RTN","RMPR9LNP",97,0) ;END "RTN","RMPR9PU") 0^6^B66397564^B63675853 "RTN","RMPR9PU",1,0) RMPR9PU ;HOIFO/HNC/SPS - PURCHASE ORDER CONROL PROCESSING-REMOTE PROCEDURE ;9/8/03 07:12 "RTN","RMPR9PU",2,0) ;;3.0;PROSTHETICS;**75,60**;Feb 09, 1996;Build 18 "RTN","RMPR9PU",3,0) ; "RTN","RMPR9PU",4,0) ;CLONED AND EDITED FROM RMPR9DO TO SEPERATE DELAYED ORDER REPORT "RTN","RMPR9PU",5,0) ; "RTN","RMPR9PU",6,0) EN(RESULT,DUZ,START,STOP,SITE,SORT,DATE,RMPRPRSN) ; -- Broker callback to get list to display "RTN","RMPR9PU",7,0) ;entry to send to PCM, WHAT=ALL or S for Summary Only "RTN","RMPR9PU",8,0) ;RMPRPRSN=P for Purchasing D for Delayed Order Report "RTN","RMPR9PU",9,0) S (WHO,RMPRSC)="" "RTN","RMPR9PU",10,0) I RMPRPRSN="P" S RMPRSC=$O(^RMPR(669.9,"PA",DUZ,RMPRSC)) Q:(RMPRSC="")!(WHO'="") D "RTN","RMPR9PU",11,0) . I '$D(^RMPR(669.9,RMPRSC,0)) Q "RTN","RMPR9PU",12,0) . I '$D(^RMPR(669.9,RMPRSC,5,"B",DUZ)) Q "RTN","RMPR9PU",13,0) . S WHO=$O(^RMPR(669.9,RMPRSC,5,"B",DUZ,"")) "RTN","RMPR9PU",14,0) . I START="" S START=$P(^RMPR(669.9,RMPRSC,5,WHO,0),U,2) "RTN","RMPR9PU",15,0) . I STOP="" S STOP=$P(^RMPR(669.9,RMPRSC,5,WHO,0),U,3) "RTN","RMPR9PU",16,0) A2 N STRING,CLREND,COLUMN,ON,OFF "RTN","RMPR9PU",17,0) Q:SORT="" "RTN","RMPR9PU",18,0) Q:DATE="" "RTN","RMPR9PU",19,0) Q:START="" "RTN","RMPR9PU",20,0) Q:STOP="" "RTN","RMPR9PU",21,0) Q:SITE="" "RTN","RMPR9PU",22,0) I SITE'="ALL" S SITE=$P(^RMPR(669.9,SITE,0),U,2) "RTN","RMPR9PU",23,0) K ^TMP($J) "RTN","RMPR9PU",24,0) N RMPRA,CDATE,X "RTN","RMPR9PU",25,0) K ADATE,PDAY,RMPRCD "RTN","RMPR9PU",26,0) S VALMCNT=0,RRX="" "RTN","RMPR9PU",27,0) ;if sort for open or pending include all regardless of date "RTN","RMPR9PU",28,0) ;if sort for cancelled or closed include from date passed forward "RTN","RMPR9PU",29,0) ; "RTN","RMPR9PU",30,0) ;PPD# status=pending before date, total days create to 1st action "RTN","RMPR9PU",31,0) ;MHD# manual totals days create to 1st action "RTN","RMPR9PU",32,0) ;CHD# consult totals days create to 1st action "RTN","RMPR9PU",33,0) ;PPDD# status=pending before date, total days in pending state, 1st "RTN","RMPR9PU",34,0) ; action to current date "RTN","RMPR9PU",35,0) ; "RTN","RMPR9PU",36,0) S (LINE,MHD1,MHD2,MHD3,MHD4,MHD5,CHD1,CHD2,CHD3,CHD4,CHD5,CLNK,MLNK)=0 "RTN","RMPR9PU",37,0) S (PPDAY,PPD,PPD1,PPD2,PPD3,PPD4,PPD5)=0 "RTN","RMPR9PU",38,0) S (PPDDAY,PPDD1,PPDD2,PPDD3,PPDD4,PPDD5)=0 "RTN","RMPR9PU",39,0) I SORT["O"!(SORT["P") D ALL "RTN","RMPR9PU",40,0) I SORT["C"!(SORT["X") D DTFWD "RTN","RMPR9PU",41,0) S ^TMP($J,"A1")="^^^^^^^^"_MHD1_U_MHD2_U_MHD3_U_MHD4_U_MHD5_"^^^^"_MLNK_U_0 "RTN","RMPR9PU",42,0) S ^TMP($J,"A2")="^^^^^^^^"_CHD1_U_CHD2_U_CHD3_U_CHD4_U_CHD5_"^^^^"_CLNK_U_1 "RTN","RMPR9PU",43,0) S ^TMP($J,"A3")="^^^^^^^^"_PPDD1_U_PPDD2_U_PPDD3_U_PPDD4_U_PPDD5_"^^^^^"_2 "RTN","RMPR9PU",44,0) S ^TMP($J,"A4")="^^^^^^^^"_PPD1_U_PPD2_U_PPD3_U_PPD4_U_PPD5_"^^^^^"_3 "RTN","RMPR9PU",45,0) G EXIT "RTN","RMPR9PU",46,0) Q "RTN","RMPR9PU",47,0) ALL ;all open pending records regardless of date passed "RTN","RMPR9PU",48,0) S RMPRI1=0 "RTN","RMPR9PU",49,0) F RMPRI1=START:1:STOP D "RTN","RMPR9PU",50,0) .I $L(RMPRI1)=1 S RMPRI=0_RMPRI1 "RTN","RMPR9PU",51,0) .E S RMPRI=RMPRI1 "RTN","RMPR9PU",52,0) .S RMPRST="" "RTN","RMPR9PU",53,0) .F S RMPRST=$O(^RMPR(668,"L1",RMPRI,RMPRST)) Q:RMPRST="" D "RTN","RMPR9PU",54,0) . .Q:RMPRST="X" "RTN","RMPR9PU",55,0) . .Q:RMPRST="C" "RTN","RMPR9PU",56,0) . .I SORT'["P"&(RMPRST="P") Q "RTN","RMPR9PU",57,0) . .S RMPRA=0 "RTN","RMPR9PU",58,0) . .F S RMPRA=$O(^RMPR(668,"L1",RMPRI,RMPRST,RMPRA)) Q:RMPRA'>0 D "RTN","RMPR9PU",59,0) . . .S STN=$P(^RMPR(668,RMPRA,0),U,7) "RTN","RMPR9PU",60,0) . . .I SITE'="ALL"&(SITE'=STN) Q "RTN","RMPR9PU",61,0) . . .S STNX=$$STATN^RMPRUTIL(STN) "RTN","RMPR9PU",62,0) . . .I $G(WHAT)="S" S VISNX=$P($G(^RMPR(669.9,STN1,"INV")),U,2) "RTN","RMPR9PU",63,0) . . .S STS=$P(^RMPR(668,RMPRA,0),U,10) "RTN","RMPR9PU",64,0) . . .Q:STS["X" "RTN","RMPR9PU",65,0) . . .Q:STS["C" "RTN","RMPR9PU",66,0) . . .I SORT'["O"&(STS="O") Q "RTN","RMPR9PU",67,0) . . .I SORT'["P"&(STS="P") Q "RTN","RMPR9PU",68,0) . . .D REC "RTN","RMPR9PU",69,0) Q "RTN","RMPR9PU",70,0) DTFWD ;from date passed forward "RTN","RMPR9PU",71,0) S RMPRI1=0 "RTN","RMPR9PU",72,0) F RMPRI1=START:1:STOP D "RTN","RMPR9PU",73,0) .I $L(RMPRI1)=1 S RMPRI=0_RMPRI1 "RTN","RMPR9PU",74,0) .E S RMPRI=RMPRI1 "RTN","RMPR9PU",75,0) .S RMPRDTM="" "RTN","RMPR9PU",76,0) .F S RMPRDTM=$O(^RMPR(668,"L",RMPRI,RMPRDTM)) Q:RMPRDTM="" D "RTN","RMPR9PU",77,0) ..Q:RMPRDTM="" "RTN","RMPR9PU",78,0) ..Q:RMPRDTM0 D "RTN","RMPR9PU",87,0) .. . .Q:RMPRA="" "RTN","RMPR9PU",88,0) .. . .S STN=$P(^RMPR(668,RMPRA,0),U,7) "RTN","RMPR9PU",89,0) .. . .I SITE'="ALL"&(SITE'=STN) Q "RTN","RMPR9PU",90,0) .. . .S STNX=$$STATN^RMPRUTIL(STN) "RTN","RMPR9PU",91,0) .. . .I $G(WHAT)'="" S VISNX=$P($G(^RMPR(669.9,SITE,"INV")),U,2) "RTN","RMPR9PU",92,0) .. . .S STS=$P(^RMPR(668,RMPRA,0),U,10) "RTN","RMPR9PU",93,0) .. . .Q:STS["O" "RTN","RMPR9PU",94,0) .. . .Q:STS["P" "RTN","RMPR9PU",95,0) .. . .I SORT'["C"&(STS="C") Q "RTN","RMPR9PU",96,0) .. . .I SORT'["X"&(STS="X") Q "RTN","RMPR9PU",97,0) .. . .D REC "RTN","RMPR9PU",98,0) S RMPRDTC=$P(DATE,".",1) "RTN","RMPR9PU",99,0) F S RMPRDTC=$O(^RMPR(668,"CD",RMPRDTC)) Q:RMPRDTC="" D "RTN","RMPR9PU",100,0) .Q:RMPRDTC5 "RTN","RMPR9PU",104,0) . .S RMPRA=0 "RTN","RMPR9PU",105,0) . .F S RMPRA=$O(^RMPR(668,"CD",RMPRDTC,RMPRDYS,RMPRA)) Q:RMPRA'>0 D "RTN","RMPR9PU",106,0) . . .;check site "RTN","RMPR9PU",107,0) . . .S STN=$P(^RMPR(668,RMPRA,0),U,7) "RTN","RMPR9PU",108,0) . . .I SITE'="ALL"&(SITE'=STN) Q "RTN","RMPR9PU",109,0) . . .S STNX=$$STATN^RMPRUTIL(STN) "RTN","RMPR9PU",110,0) . . .;check status "RTN","RMPR9PU",111,0) . . .S STS=$P(^RMPR(668,RMPRA,0),U,10) "RTN","RMPR9PU",112,0) . . .I SORT'["O"&(STS="O") Q "RTN","RMPR9PU",113,0) . . .I SORT'["P"&(STS="P") Q "RTN","RMPR9PU",114,0) . . .I SORT'["C"&(STS="C") Q "RTN","RMPR9PU",115,0) . . .I SORT'["X"&(STS="X") Q "RTN","RMPR9PU",116,0) . . .;ssn range filter "RTN","RMPR9PU",117,0) . . .S DFN=$P(^RMPR(668,RMPRA,0),U,2) "RTN","RMPR9PU",118,0) . . .D DEM^VADPT "RTN","RMPR9PU",119,0) . . .S SSNEN=$E($P(VADM(2),"^",2),10,11) "RTN","RMPR9PU",120,0) . . .I SSNEN>STOP Q "RTN","RMPR9PU",121,0) . . .I SSNEN0:"",VASV(12)>0:"",VASV(13)>0:"",1:0) "RTN","RMPR9PU",144,0) D KVAR^VADPT "RTN","RMPR9PU",145,0) ; Added line below for OIF/OEF field 15 file 668 "RTN","RMPR9PU",146,0) I RMPROEOI="" S $P(^RMPR(668,RMPRA,7),U,1)=1 "RTN","RMPR9PU",147,0) ;type "RTN","RMPR9PU",148,0) S TYPE=$$TYPE^RMPREOU(RMPRA,8) "RTN","RMPR9PU",149,0) ;display description if manual "RTN","RMPR9PU",150,0) S DES=$$DES^RMPREOU(RMPRA,22) "RTN","RMPR9PU",151,0) S DES=$TR(DES,"^","*") "RTN","RMPR9PU",152,0) S DES=$TR(DES,"""","'") "RTN","RMPR9PU",153,0) ;init action date "RTN","RMPR9PU",154,0) S ADATE="",PDAY="",WRKDAY="" "RTN","RMPR9PU",155,0) S ADATE=$P(^RMPR(668,RMPRA,0),U,9) "RTN","RMPR9PU",156,0) ;PPD=1 for previous pending "RTN","RMPR9PU",157,0) I ADATE'="" S (PDAY,WRKDAY)=$$WRKDAY^RMPREOU(RMPRA) "RTN","RMPR9PU",158,0) I ADATE="" S (PDAY,WRKDAY)=$$CWRKDAY^RMPREOU(RMPRA) "RTN","RMPR9PU",159,0) I ADATE'="" S CDAY=$$PDAY^RMPREOU(RMPRA) "RTN","RMPR9PU",160,0) ; "RTN","RMPR9PU",161,0) S STATUS=$$STATUS^RMPREOU(RMPRA) "RTN","RMPR9PU",162,0) I STATUS["PENDING" D "RTN","RMPR9PU",163,0) .I ADATE'=""&(ADATE0 S:$D(^RMPR(664.1,RMPR6641,0)) RMATECH=$P(^RMPR(664.1,RMPR6641,0),U,16),RMPRWON=$P(^(0),U,13) "RTN","RMPR9PU",172,0) I RMPROEOI="" S WHO=RMPROEOI_WHO "RTN","RMPR9PU",173,0) S ^TMP($J,RMPRA)=CDATE_U_WHO_U_SSN_U_TYPE_U_DES_U "RTN","RMPR9PU",174,0) ;look at pday and parse "RTN","RMPR9PU",175,0) S (HD1,HD2,HD3,HD4,HD5,DH6)="" "RTN","RMPR9PU",176,0) ;SD Working Days in Pending Status "RTN","RMPR9PU",177,0) S (SD1,SD2,SD3,SD4,SD5)=0 "RTN","RMPR9PU",178,0) I (PDAY>0)&(PDAY<6)!(PDAY=0) S HD1=PDAY,DH6="NO" "RTN","RMPR9PU",179,0) I (PPDAY>0)&(PPDAY<6)!(PPDAY=0) S SD1=PPDAY "RTN","RMPR9PU",180,0) I (PDAY>0)&(PDAY<6)&(TYPE["MANUAL")!(PDAY=0)&(TYPE["MANUAL") S MHD1=MHD1+1 "RTN","RMPR9PU",181,0) I (PDAY>0)&(PDAY<6)&(TYPE'["MANUAL")!(PDAY=0)&(TYPE'["MANUAL") S CHD1=CHD1+1 "RTN","RMPR9PU",182,0) I (PPDAY>0)&(PPDAY<6)&(STATUS["PENDING") S PPDD1=PPDD1+1 "RTN","RMPR9PU",183,0) I (PDAY>0)&(PDAY<6)&(PPD=1) S PPD1=PPD1+1 "RTN","RMPR9PU",184,0) I HD1="" S HD1=0 "RTN","RMPR9PU",185,0) I (PDAY>5)&(PDAY<10) S HD2=PDAY,DH6="YES" "RTN","RMPR9PU",186,0) I (PPDAY>5)&(PPDAY<10) S SD2=PPDAY "RTN","RMPR9PU",187,0) I (PDAY>5)&(PDAY<10)&(TYPE["MANUAL") S MHD2=MHD2+1 "RTN","RMPR9PU",188,0) I (PDAY>5)&(PDAY<10)&(TYPE'["MANUAL") S CHD2=CHD2+1 "RTN","RMPR9PU",189,0) I (PPDAY>5)&(PPDAY<10)&(STATUS["PENDING") S PPDD2=PPDD2+1 "RTN","RMPR9PU",190,0) I (PDAY>5)&(PDAY<10)&(PPD=1) S PPD2=PPD2+1 "RTN","RMPR9PU",191,0) I HD2="" S HD2=0 "RTN","RMPR9PU",192,0) I (PDAY>9)&(PDAY<30) S HD3=PDAY,DH6="YES" "RTN","RMPR9PU",193,0) I (PPDAY>9)&(PPDAY<30) S SD3=PPDAY "RTN","RMPR9PU",194,0) I (PDAY>9)&(PDAY<30)&(TYPE["MANUAL") S MHD3=MHD3+1 "RTN","RMPR9PU",195,0) I (PDAY>9)&(PDAY<30)&(TYPE'["MANUAL") S CHD3=CHD3+1 "RTN","RMPR9PU",196,0) I (PPDAY>9)&(PPDAY<30)&(STATUS["PENDING") S PPDD3=PPDD3+1 "RTN","RMPR9PU",197,0) I (PDAY>9)&(PDAY<30)&(PPD=1) S PPD3=PPD3+1 "RTN","RMPR9PU",198,0) I HD3="" S HD3=0 "RTN","RMPR9PU",199,0) I (PDAY>29)&(PDAY<90) S HD4=PDAY,DH6="YES" "RTN","RMPR9PU",200,0) I (PPDAY>29)&(PPDAY<90) S SD4=PPDAY "RTN","RMPR9PU",201,0) I (PDAY>29)&(PDAY<90)&(TYPE["MANUAL") S MHD4=MHD4+1 "RTN","RMPR9PU",202,0) I (PDAY>29)&(PDAY<90)&(TYPE'["MANUAL") S CHD4=CHD4+1 "RTN","RMPR9PU",203,0) I (PPDAY>29)&(PPDAY<90)&(STATUS["PENDING") S PPDD4=PPDD4+1 "RTN","RMPR9PU",204,0) I (PDAY>29)&(PDAY<90)&(PPD=1) S PPD4=PPD4+1 "RTN","RMPR9PU",205,0) I HD4="" S HD4=0 "RTN","RMPR9PU",206,0) I PDAY>89 S HD5=PDAY,DH6="YES" "RTN","RMPR9PU",207,0) I PPDAY>89 S SD5=PPDAY "RTN","RMPR9PU",208,0) I (PDAY>89)&(TYPE["MANUAL") S MHD5=MHD5+1 "RTN","RMPR9PU",209,0) I (PDAY>89)&(TYPE'["MANUAL") S CHD5=CHD5+1 "RTN","RMPR9PU",210,0) I (PPDAY>89)&(STATUS["PENDING") S PPDD5=PPDD5+1 "RTN","RMPR9PU",211,0) I (PDAY>89)&(PPD=1) S PPD5=PPD5+1 "RTN","RMPR9PU",212,0) I HD5="" S HD5=0 "RTN","RMPR9PU",213,0) S (PPD,PPDAY)=0 "RTN","RMPR9PU",214,0) I LINKED'=0&(TYPE["MANUAL") S MLNK=MLNK+1 "RTN","RMPR9PU",215,0) I LINKED'=0&(TYPE'["MANUAL") S CLNK=CLNK+1 "RTN","RMPR9PU",216,0) S ^TMP($J,RMPRA)=^TMP($J,RMPRA)_STOPDT_U_DH6_U_HD1_U_HD2_U_HD3_U_HD4_U_HD5 "RTN","RMPR9PU",217,0) S ^TMP($J,RMPRA)=^TMP($J,RMPRA)_U_STATUS_U_RMPRA_U_STNX_U_LINKED "RTN","RMPR9PU",218,0) S ^TMP($J,RMPRA)=^TMP($J,RMPRA)_U_U_SD1_U_SD2_U_SD3_U_SD4_U_SD5_U_DFN "RTN","RMPR9PU",219,0) S ^TMP($J,RMPRA)=^TMP($J,RMPRA)_U_RMPR6641_U_RMPRWON_U_RMATECH "RTN","RMPR9PU",220,0) K CDATE,WHO,SSN,TYPE,DES,PDAY,STATUS,ADATE "RTN","RMPR9PU",221,0) ;PUT RESULTS IN GLOBAL!! "RTN","RMPR9PU",222,0) Q "RTN","RMPR9PU",223,0) K CDAY,CHD1,CHD2,CHD3,CHD4,CHD5,CLNK,DA,DFN,DH6,HD1,HD2,HD3,HD4,HD5,LINE "RTN","RMPR9PU",224,0) K LINKED,MHD1,MHD2,MHD3,MHD4,MHD5,MLNK,PPD,PPD1,PPD2,PPD3,PPD4,PPD5 "RTN","RMPR9PU",225,0) K PPDAY,PPDD1,PPDD2,PPDD3,PPDD4,PPDD5,PPDDAY,RMPR6641,RMPRDTC,RMPRDTM "RTN","RMPR9PU",226,0) K RMPRDYS,RMPRI,RMPRI1,RMPRSC,RMPRST,RMPRWON,RRX,SD1,SD2,SD3,SD4,SD5,STN,STN1,STNX,STS,VALMCNT,VISNX,WHAT,WRKDAY "RTN","RMPR9PU",227,0) EXIT ;common exit point "RTN","RMPR9PU",228,0) S RESULT=$NA(^TMP($J)) "RTN","RMPR9PU",229,0) Q "RTN","RMPRDDC") 0^1^B26052181^n/a "RTN","RMPRDDC",1,0) RMPRDDC ;VACO/HNC - SERVER ROUTINE FOR DALC RECORD IN 660 ; 11/01/2006 "RTN","RMPRDDC",2,0) ;;3.0;PROSTHETICS;**60**;Feb 09, 1996;Build 18 "RTN","RMPRDDC",3,0) ;Per VHA Directive 10-93-142, this routine should not be modified. "RTN","RMPRDDC",4,0) ; "RTN","RMPRDDC",5,0) ;DBIA # 10072 - for routine REMSBMSG^XMA1C "RTN","RMPRDDC",6,0) ;DBIA # ????? - for D FIND^DIC(2,,".09" "RTN","RMPRDDC",7,0) ; "RTN","RMPRDDC",8,0) MAIN ;main entry point "RTN","RMPRDDC",9,0) ;loop msg "RTN","RMPRDDC",10,0) K RMPRMSG "RTN","RMPRDDC",11,0) S RMPRCNT=0 "RTN","RMPRDDC",12,0) S RMPRMSGC=0 "RTN","RMPRDDC",13,0) F X XMREC Q:XMRG="" D "RTN","RMPRDDC",14,0) .S RMPRDATA=XMRG "RTN","RMPRDDC",15,0) .Q:RMPRDATA="ENCRYPTED STRING" "RTN","RMPRDDC",16,0) .S (RMPRTD,RMPRMPI,RMPRSSN,RMPRNAM,RMPRTRAN,RMPRCAT,RMPRPP,RMPRICD,RMPRITM,RMPRHCPE,RMPRHCP,RMPRSTN,RMPRCMT,RMPRCOST,RMPRQTY,RMPRREF,RMPRSRL,RMPRVND,RMPRDUN,RMPRTAX,RMPRRT,DFN)="" "RTN","RMPRDDC",17,0) .;parse data string "RTN","RMPRDDC",18,0) .S RMPRNPMN=$P(XQSUB,"#",2) "RTN","RMPRDDC",19,0) .S RMPRMSGC=RMPRMSGC+1 "RTN","RMPRDDC",20,0) .S RMPRCNT=RMPRCNT+1 "RTN","RMPRDDC",21,0) .S RMPRFLG=$P($G(RMPRDATA),U,21) ;retransmission flag Y or N "RTN","RMPRDDC",22,0) .S X=$P($P($G(RMPRDATA),U,1),".",1) ;transaction date "RTN","RMPRDDC",23,0) .S X=$E(X,5,6)_"/"_$E(X,7,8)_"/"_$E(X,3,4) D ^%DT S RMPRTD=Y "RTN","RMPRDDC",24,0) .I RMPRTD=-1 S RMPRTD="" "RTN","RMPRDDC",25,0) .S RMPRMPI=$P($G(RMPRDATA),U,2) ;MPI "RTN","RMPRDDC",26,0) .S RMPRSSN=$P($G(RMPRDATA),U,3) ;SSN "RTN","RMPRDDC",27,0) .S RMPRPNAM=$P($G(RMPRDATA),U,4) ;Patient Name "RTN","RMPRDDC",28,0) .S RMPRTRAN=$P($G(RMPRDATA),U,5) ;Type New or Repair "RTN","RMPRDDC",29,0) .I RMPRTRAN="N" S RMPRTRAN="I" ;new trans "RTN","RMPRDDC",30,0) .I RMPRTRAN="R" S RMPRTRAN="X" ;repair trans "RTN","RMPRDDC",31,0) .S RMPRCAT=$P($G(RMPRDATA),U,6) ;category NSC or SC "RTN","RMPRDDC",32,0) .I RMPRCAT="NSC" S RMPRCAT=4 "RTN","RMPRDDC",33,0) .I RMPRCAT="SC" S RMPRCAT=1 "RTN","RMPRDDC",34,0) .S RMPRPP=$P($G(RMPRDATA),U,7) ;Person placing order DALC STAFF or VET "RTN","RMPRDDC",35,0) .S RMPRICD=$P($G(RMPRDATA),U,8) ;ICD9 blank for now "RTN","RMPRDDC",36,0) .S RMPRITM=$P($G(RMPRDATA),U,9) ;Item HCPCS short desc "RTN","RMPRDDC",37,0) .S RMPRHCPE=$P($G(RMPRDATA),U,10) ;hcpcs "RTN","RMPRDDC",38,0) .S RMPRHCP="" "RTN","RMPRDDC",39,0) .S RMPRHCP=$O(^RMPR(661.1,"B",RMPRHCPE,RMPRHCP)) "RTN","RMPRDDC",40,0) .I RMPRHCP="" S RMPRITM=RMPRITM_" *NOT VALID" "RTN","RMPRDDC",41,0) .S RMPRSTN=$P($G(RMPRDATA),U,11) ;station billing number "RTN","RMPRDDC",42,0) .S RMPRCMT=$P($G(RMPRDATA),U,12) ;comment "RTN","RMPRDDC",43,0) .S RMPRCOST=$P($G(RMPRDATA),U,13) ;total cost "RTN","RMPRDDC",44,0) .S RMPRQTY=$P($G(RMPRDATA),U,14) ;qty "RTN","RMPRDDC",45,0) .S RMPRREF=$P($G(RMPRDATA),U,15) ;ddc internal reference "RTN","RMPRDDC",46,0) .S RMPRSRL=$P($G(RMPRDATA),U,16) ;serial number "RTN","RMPRDDC",47,0) .S RMPRVND=$P($G(RMPRDATA),U,17) ;vendor as text "RTN","RMPRDDC",48,0) .S RMPRDUN=$P($G(RMPRDATA),U,18) ;dun "RTN","RMPRDDC",49,0) .S RMPRTAX=$P($G(RMPRDATA),U,19) ;tax "RTN","RMPRDDC",50,0) .; RMPRDAT,U,21 IS RESERVED FOR A RETURN NUMBER TBD SKIPPED "RTN","RMPRDDC",51,0) .S RMPROS=$P($G(RMPRDATA),U,22) ;ordering station "RTN","RMPRDDC",52,0) .S X=$P($G(RMPRDATA),U,20) ;return date "RTN","RMPRDDC",53,0) .S X=$E(X,5,6)_"/"_$E(X,7,8)_"/"_$E(X,3,4) D ^%DT S RMPRRT=Y "RTN","RMPRDDC",54,0) .I RMPRRT=-1 S RMPRRT="" "RTN","RMPRDDC",55,0) .;file "RTN","RMPRDDC",56,0) .D NOW^%DTC S RMPRWHN=$P(%,".",1) "RTN","RMPRDDC",57,0) .;check to see if new "RTN","RMPRDDC",58,0) .I $D(^RMPR(660,"DDC",RMPRREF)) S RMPRMSG(RMPRMSGC)="Record already on file, Not Processed: "_RMPRREF Q "RTN","RMPRDDC",59,0) .;find patient "RTN","RMPRDDC",60,0) .D FIND^DIC(2,,".09","PS",RMPRSSN,3,"SSN","","","RMPROUT") "RTN","RMPRDDC",61,0) .I '$G(RMPROUT("DILIST","1",0)) S RMPRMSG(RMPRMSGC)="Patient Not Found Not Processed: "_RMPRREF Q "RTN","RMPRDDC",62,0) .I $G(RMPROUT("DISLIST",2,0)) S RMPRMSG(RMPRMSGC)="More than one Patient with Same SSN, Patient Not Processed: "_RMPRREF Q ;more than one with same ssn "RTN","RMPRDDC",63,0) .S DFN=$P(RMPROUT("DILIST",1,0),U,1) "RTN","RMPRDDC",64,0) .;check 665 if not there add it "RTN","RMPRDDC",65,0) .;array to file "RTN","RMPRDDC",66,0) .K RMPRERR,RMPR660 "RTN","RMPRDDC",67,0) .S RMPR660(660,"+1,",.01)=RMPRWHN "RTN","RMPRDDC",68,0) .S RMPR660(660,"+1,",.02)=DFN "RTN","RMPRDDC",69,0) .S RMPR660(660,"+1,",1)=RMPRTD "RTN","RMPRDDC",70,0) .S RMPR660(660,"+1,",89.2)=RMPRTD "RTN","RMPRDDC",71,0) .S RMPR660(660,"+1,",2)=RMPRTRAN "RTN","RMPRDDC",72,0) .S RMPR660(660,"+1,",4.2)=RMPRPP "RTN","RMPRDDC",73,0) .S RMPR660(660,"+1,",62)=RMPRCAT "RTN","RMPRDDC",74,0) .S RMPR660(660,"+1,",89)=RMPRITM "RTN","RMPRDDC",75,0) .S RMPR660(660,"+1,",24)=RMPRITM "RTN","RMPRDDC",76,0) .S RMPR660(660,"+1,",16)=RMPRCMT "RTN","RMPRDDC",77,0) .S RMPR660(660,"+1,",14)=RMPRCOST "RTN","RMPRDDC",78,0) .S RMPR660(660,"+1,",5)=RMPRQTY "RTN","RMPRDDC",79,0) .S RMPR660(660,"+1,",9)=RMPRSRL "RTN","RMPRDDC",80,0) .S RMPR660(660,"+1,",91)=RMPRVND "RTN","RMPRDDC",81,0) .S RMPR660(660,"+1,",92)=RMPRDUN "RTN","RMPRDDC",82,0) .S RMPR660(660,"+1,",93)=RMPRTAX "RTN","RMPRDDC",83,0) .S RMPR660(660,"+1,",17.5)=RMPRRT "RTN","RMPRDDC",84,0) .S RMPR660(660,"+1,",17)=1 "RTN","RMPRDDC",85,0) .S RMPR660(660,"+1,",89.3)=RMPROS "RTN","RMPRDDC",86,0) .S RMPR660(660,"+1,",90)=RMPRSTN "RTN","RMPRDDC",87,0) .S RMPR660(660,"+1,",4.5)=RMPRHCP "RTN","RMPRDDC",88,0) .S RMPR660(660,"+1,",89.1)=RMPRREF "RTN","RMPRDDC",89,0) .S RMPR660(660,"+1,",11)=16 "RTN","RMPRDDC",90,0) .S RMPR660(660,"+1,",12)="V" ;source "RTN","RMPRDDC",91,0) .S RMPR660(660,"+1,",15)="*" ;historical data flag "RTN","RMPRDDC",92,0) .D UPDATE^DIE("","RMPR660","","RMPRERR") "RTN","RMPRDDC",93,0) .I $D(RMPRERR) D "RTN","RMPRDDC",94,0) . .S RMPRMSG(RMPRMSGC)=$G(RMPRERR("DIERR","1","TEXT",1))_"Error Not Processed: "_RMPRREF "RTN","RMPRDDC",95,0) . .;S RMPRMSG(RMPRMSGC)="Error Not Processed: "_RMPRREF "RTN","RMPRDDC",96,0) . .S XMY("G.RMPR SERVER")="" "RTN","RMPRDDC",97,0) .S RMPRMSG(RMPRMSGC)="Done: "_RMPRREF "RTN","RMPRDDC",98,0) ;Send email to ddc with number of records processed "RTN","RMPRDDC",99,0) S XMDUZ=.5 "RTN","RMPRDDC",100,0) S XMY("G.RMPR SERVER")="" "RTN","RMPRDDC",101,0) S XMY("S.RMPRACKDALC@DDC.VA.GOV")="" "RTN","RMPRDDC",102,0) S XMSUB="Prosthetics - DALC Interface Summary NPNM #"_RMPRNPMN "RTN","RMPRDDC",103,0) S RMPRMSGC=RMPRMSGC+1 "RTN","RMPRDDC",104,0) S RMPRMSG(RMPRMSGC)="Total Records Received: "_RMPRCNT "RTN","RMPRDDC",105,0) S XMTEXT="RMPRMSG(" "RTN","RMPRDDC",106,0) D ^XMD "RTN","RMPRDDC",107,0) ; "RTN","RMPRDDC",108,0) EXIT ;main exit point "RTN","RMPRDDC",109,0) K RMPRTD,RMPRMPI,RMPRSSN,RMPRNAM,RMPRTRAN,RMPRCAT,RMPRPP,RMPRICD "RTN","RMPRDDC",110,0) K RMPRITM,RMPRHCPE,RMPRHCP,RMPRSTN,RMPRCMT,RMPRCOST,RMPRQTY,RMPRREF "RTN","RMPRDDC",111,0) K RMPRSRL,RMPRVND,RMPRDUN,RMPRTAX,RMPRRT,DFN,RMPR(660),RMPRCNT,RMPRDATA "RTN","RMPRDDC",112,0) K RMPRFLG,RMPROUT,RMPRNAM,RMPRWHN,RMPRMSGC,RMPRPNAM,RMPRNPMN "RTN","RMPRDDC",113,0) ;purge server message "RTN","RMPRDDC",114,0) S XMSER="S."_XQSOP,XMZ=XQMSG D REMSBMSG^XMA1C "RTN","RMPRDDC",115,0) Q "RTN","RMPRDDC",116,0) ;END "RTN","RMPRPFFS") 0^12^B29300840^B27596757 "RTN","RMPRPFFS",1,0) RMPRPFFS ;Hines OIFO/HNC - REMOTE PROCEDURE, LIST NPPD DATA ;9/8/03 07:23 "RTN","RMPRPFFS",2,0) ;;3.0;PROSTHETICS;**96,60**;Feb 09, 1996;Build 18 "RTN","RMPRPFFS",3,0) ; "RTN","RMPRPFFS",4,0) ; patch 96 - HNC "RTN","RMPRPFFS",5,0) ; -DBIA #4419 for INSUR^IBBAPI "RTN","RMPRPFFS",6,0) ; -DBIA #3990 for ICDDX^ICDCODE "RTN","RMPRPFFS",7,0) ; -DBIA #1997 for STATCHK^ICPTAPIU "RTN","RMPRPFFS",8,0) ; -DBIA #3823 for read file 355.3, field .04 "RTN","RMPRPFFS",9,0) ;RESULTS passed to broker in ^TMP($J, "RTN","RMPRPFFS",10,0) ;delimited by "^" "RTN","RMPRPFFS",11,0) ;piece 1 = ENTRY DATE "RTN","RMPRPFFS",12,0) ;piece 2 = PATIENT NAME "RTN","RMPRPFFS",13,0) ;piece 3 = PSAS HCPCS with * if hcpcs has Calculation Flag "RTN","RMPRPFFS",14,0) ;piece 4 = QTY "RTN","RMPRPFFS",15,0) ;piece 5 = Insurance with * if more insurance info available "RTN","RMPRPFFS",16,0) ;piece 6 = Insurance Effective Date "RTN","RMPRPFFS",17,0) ;piece 7 = TOTAL COST "RTN","RMPRPFFS",18,0) ;piece 8 = DESCRIPTION (ITEM, BRIEF DESCRIPTION WITH ~R~ FOR REPAIR) "RTN","RMPRPFFS",19,0) ;piece 9 = Coding Errors "RTN","RMPRPFFS",20,0) ;piece 10 = Insurance Holder "RTN","RMPRPFFS",21,0) ;piece 11 = STATION "RTN","RMPRPFFS",22,0) ;piece 12 = ICD9 Description "RTN","RMPRPFFS",23,0) ;piece 13 = Billing Group Number "RTN","RMPRPFFS",24,0) ;piece 14 = Subscriber ID "RTN","RMPRPFFS",25,0) ;piece 15 = SSN "RTN","RMPRPFFS",26,0) ;piece 16 = IEN TO FILE 660 "RTN","RMPRPFFS",27,0) ;piece 17 = HCPCS SHORT DESCRIPTION "RTN","RMPRPFFS",28,0) ;piece 18 = ICD9 code "RTN","RMPRPFFS",29,0) ;piece 19 = Delivery Date "RTN","RMPRPFFS",30,0) ;piece 20 = Expiration Insurance Date "RTN","RMPRPFFS",31,0) ;piece 21 = Hcpcs-Icd9 Flag, this routine will set field 4.9 in file 660 "RTN","RMPRPFFS",32,0) ;all records will have a 1 "RTN","RMPRPFFS",33,0) ;ICD9, 2 "RTN","RMPRPFFS",34,0) ;HCPCS, 3 "RTN","RMPRPFFS",35,0) ;Not Billable 4 "RTN","RMPRPFFS",36,0) ; "RTN","RMPRPFFS",37,0) ;No errors, number 1. "RTN","RMPRPFFS",38,0) ;PSAS HCPCS, Not Billable Item, number 14. "RTN","RMPRPFFS",39,0) ;ICD9 error, number 12. "RTN","RMPRPFFS",40,0) ;HCPCS error, number 13. "RTN","RMPRPFFS",41,0) ;Both ICD9 and HCPCS error, number 132. "RTN","RMPRPFFS",42,0) ;Both ICD9 error and Not Billable Item, number 142. "RTN","RMPRPFFS",43,0) Q "RTN","RMPRPFFS",44,0) ; "RTN","RMPRPFFS",45,0) EN(RESULT,DATE1,DATE2) ;broker entry point "RTN","RMPRPFFS",46,0) ; "RTN","RMPRPFFS",47,0) K ^TMP($J) "RTN","RMPRPFFS",48,0) I '$D(DATE1)!('$D(DATE2)) G EXIT "RTN","RMPRPFFS",49,0) S DATE=DATE1-1 "RTN","RMPRPFFS",50,0) F S DATE=$O(^RMPR(660,"B",DATE)) Q:(DATE="")!($P(DATE,".",1)>DATE2) D "RTN","RMPRPFFS",51,0) .S RMPRB=0 "RTN","RMPRPFFS",52,0) .F S RMPRB=$O(^RMPR(660,"B",DATE,RMPRB)) Q:RMPRB="" D "RTN","RMPRPFFS",53,0) ..Q:$P(^RMPR(660,RMPRB,0),U,15)["*" "RTN","RMPRPFFS",54,0) ..Q:$P(^RMPR(660,RMPRB,0),U,14)'["C" "RTN","RMPRPFFS",55,0) ..;Q:$P(^RMPR(660,RMPRB,0),U,12)="" "RTN","RMPRPFFS",56,0) ..Q:$P($G(^RMPR(660,RMPRB,"AM")),U,3)<2 "RTN","RMPRPFFS",57,0) ..;end of filter "RTN","RMPRPFFS",58,0) ..S PHCPCS=$P($G(^RMPR(660,RMPRB,1)),U,4) "RTN","RMPRPFFS",59,0) ..Q:PHCPCS="" "RTN","RMPRPFFS",60,0) ..Q:PHCPCS'>0 "RTN","RMPRPFFS",61,0) ..S HDES=$P(^RMPR(661.1,PHCPCS,0),U,2) "RTN","RMPRPFFS",62,0) ..;code set versioning check "RTN","RMPRPFFS",63,0) ..S RICP="" "RTN","RMPRPFFS",64,0) ..S RICP=$P(^RMPR(661.1,PHCPCS,0),U,1) "RTN","RMPRPFFS",65,0) ..S RICPP="",CODERR="Alert",CODEFLG=1 "RTN","RMPRPFFS",66,0) ..I RICP'="" D "RTN","RMPRPFFS",67,0) ...I $A($E(RICP,2,2))>64 S CODERR=" Non Billable Item",CODEFLG=CODEFLG_4 Q "RTN","RMPRPFFS",68,0) ...I $A($E(RICP,2,2))<65 S RICPP=$$STATCHK^ICPTAPIU(RICP,$P(^RMPR(660,RMPRB,0),U,1)) "RTN","RMPRPFFS",69,0) ..I RICPP'="" D "RTN","RMPRPFFS",70,0) ...I $P(RICPP,U,1)=0 S CODERR=CODERR_" HCPCS Inactive",CODEFLG=CODEFLG_3 "RTN","RMPRPFFS",71,0) ..S TYPE=$P($G(^RMPR(660,RMPRB,0)),U,4) "RTN","RMPRPFFS",72,0) ..I TYPE'="X" S LINE=$P(^RMPR(661.1,PHCPCS,0),U,7) "RTN","RMPRPFFS",73,0) ..I TYPE="X" S LINE=$P(^RMPR(661.1,PHCPCS,0),U,6) "RTN","RMPRPFFS",74,0) ..S CAL=$P(^RMPR(661.1,PHCPCS,0),U,8) "RTN","RMPRPFFS",75,0) ..I CAL'="" S CAL="*" "RTN","RMPRPFFS",76,0) ..S DFN=$P(^RMPR(660,RMPRB,0),U,2) "RTN","RMPRPFFS",77,0) ..D DEM^VADPT "RTN","RMPRPFFS",78,0) ..D SVC^VADPT "RTN","RMPRPFFS",79,0) ..S RMPROEOI=$S(VASV(11)>0:"",VASV(12)>0:"",VASV(13)>0:"",1:0) "RTN","RMPRPFFS",80,0) ..S (RMI,HOLDER,SUBID,INSUR,INSURE,INSURG,INSURGG,INICD9D,INICD9E,RMPRDELD,RMPRIND,RMPRDEL)="" "RTN","RMPRPFFS",81,0) ..S RMPRDELD=$P(^RMPR(660,RMPRB,0),U,12) "RTN","RMPRPFFS",82,0) ..I RMPRDELD'="" S RMPRDEL=$E(RMPRDELD,4,5)_"/"_$E(RMPRDELD,6,7)_"/"_(($E(RMPRDELD,1,3))+1700) "RTN","RMPRPFFS",83,0) ..S X=$$INSUR^IBBAPI(DFN,,"RBA",.RMI,"*") I $D(RMI) D "RTN","RMPRPFFS",84,0) ...;format the RMI array "RTN","RMPRPFFS",85,0) ...;look for primary insurance "RTN","RMPRPFFS",86,0) ...;RMI("IBBAPI","INSUR",n,7)=1^PRIMARY "RTN","RMPRPFFS",87,0) ...S X="" F S X=$O(RMI("IBBAPI","INSUR",X)) Q:'X D "RTN","RMPRPFFS",88,0) ....;I $P(RMI("IBBAPI","INSUR",X,7),U,2)'="PRIMARY" Q "RTN","RMPRPFFS",89,0) ....S INSUR=$P(RMI("IBBAPI","INSUR",X,1),U,2) "RTN","RMPRPFFS",90,0) ....I X>1 S INSUR="*"_INSUR "RTN","RMPRPFFS",91,0) ....S SUBID=$P(RMI("IBBAPI","INSUR",X,14),U,1) "RTN","RMPRPFFS",92,0) ....S HOLDER=$P(RMI("IBBAPI","INSUR",X,12),U,2) "RTN","RMPRPFFS",93,0) ....S RMPRIND=$P(RMI("IBBAPI","INSUR",X,11),U,1) "RTN","RMPRPFFS",94,0) ....I RMPRIND'="" S RMPRIND=$E(RMPRIND,4,5)_"/"_$E(RMPRIND,6,7)_"/"_(($E(RMPRIND,1,3))+1700) "RTN","RMPRPFFS",95,0) ....S INSURE=$P(RMI("IBBAPI","INSUR",X,10),U,1) "RTN","RMPRPFFS",96,0) ....I INSURE'="" S INSURE=$E(INSURE,4,5)_"/"_$E(INSURE,6,7)_"/"_(($E(INSURE,1,3))+1700) "RTN","RMPRPFFS",97,0) ....S INSURG=$P(RMI("IBBAPI","INSUR",X,8),U,1) "RTN","RMPRPFFS",98,0) ....S INSURGG=$$GET1^DIQ(355.3,INSURG_",",.04) "RTN","RMPRPFFS",99,0) ..I '$D(RMI) D "RTN","RMPRPFFS",100,0) ...S INSUR="No Insurance Information" "RTN","RMPRPFFS",101,0) ...S SUBID="" "RTN","RMPRPFFS",102,0) ...S HOLDER="" "RTN","RMPRPFFS",103,0) ...S INSURE="" "RTN","RMPRPFFS",104,0) ...S INSURGG="" "RTN","RMPRPFFS",105,0) ...S RMPRIND="" "RTN","RMPRPFFS",106,0) ..;get icd9 data "RTN","RMPRPFFS",107,0) ..S INICD9I=$P($G(^RMPR(660,RMPRB,10)),U,8) "RTN","RMPRPFFS",108,0) ..I INICD9I'="" D "RTN","RMPRPFFS",109,0) ...S INICD9=$$ICDDX^ICDCODE(INICD9I,$P(^RMPR(660,RMPRB,0),U,1)) "RTN","RMPRPFFS",110,0) ...I INICD9'="" S INICD9E=$P(INICD9,U,2),INICD9D=$P(INICD9,U,4) "RTN","RMPRPFFS",111,0) ...I $P(INICD9,U,10)=0 S CODERR=CODERR_" ICD9 Inactive",CODEFLG=CODEFLG_2 "RTN","RMPRPFFS",112,0) ..D DATA "RTN","RMPRPFFS",113,0) S RESULT=$NA(^TMP($J)) "RTN","RMPRPFFS",114,0) Q "RTN","RMPRPFFS",115,0) ; "RTN","RMPRPFFS",116,0) DATA ; "RTN","RMPRPFFS",117,0) S B=RMPRB "RTN","RMPRPFFS",118,0) D GETS^DIQ(660,B,".01;.02;2;4.5;5;7;8;8.3;11;12;14;24;27;68","","RMXM") "RTN","RMPRPFFS",119,0) S $P(^TMP($J,B),U,1)=$G(RMXM(660,B_",",.01)) "RTN","RMPRPFFS",120,0) ;Check for OEF/OIF "RTN","RMPRPFFS",121,0) I RMPROEOI="" S RMXM(660,B_",",.02)=""_RMXM(660,B_",",.02) "RTN","RMPRPFFS",122,0) S $P(^TMP($J,B),U,2)=$G(RMXM(660,B_",",.02)) "RTN","RMPRPFFS",123,0) S $P(^TMP($J,B),U,3)=$G(RMXM(660,B_",",4.5))_CAL "RTN","RMPRPFFS",124,0) S $P(^TMP($J,B),U,4)=$G(RMXM(660,B_",",5)) "RTN","RMPRPFFS",125,0) ;change to insurance "RTN","RMPRPFFS",126,0) I INSUR="" S INSUR="Incomplete Insurance Information" "RTN","RMPRPFFS",127,0) S $P(^TMP($J,B),U,5)=INSUR "RTN","RMPRPFFS",128,0) ;change to effective insurance date "RTN","RMPRPFFS",129,0) S $P(^TMP($J,B),U,6)=INSURE "RTN","RMPRPFFS",130,0) S $P(^TMP($J,B),U,7)=$G(RMXM(660,B_",",14)) "RTN","RMPRPFFS",131,0) ;patch 77 remove the " for Excel CSV "RTN","RMPRPFFS",132,0) ;append ~R~ for repair items "RTN","RMPRPFFS",133,0) I $G(RMXM(660,B_",",2))="REPAIR" S RMXM(660,B_",",24)="~R~"_RMXM(660,B_",",24) "RTN","RMPRPFFS",134,0) S $P(^TMP($J,B),U,8)=$TR($G(RMXM(660,B_",",24)),"""","'") "RTN","RMPRPFFS",135,0) ;change to coding errors "RTN","RMPRPFFS",136,0) I CODERR="Alert" S CODERR="" "RTN","RMPRPFFS",137,0) S $P(^TMP($J,B),U,9)=CODERR "RTN","RMPRPFFS",138,0) ;change to holder "RTN","RMPRPFFS",139,0) S $P(^TMP($J,B),U,10)=HOLDER "RTN","RMPRPFFS",140,0) S $P(^TMP($J,B),U,11)=$G(RMXM(660,B_",",8)) "RTN","RMPRPFFS",141,0) ;change to ICD9 description "RTN","RMPRPFFS",142,0) S $P(^TMP($J,B),U,12)=INICD9D "RTN","RMPRPFFS",143,0) ;change to Billing Group "RTN","RMPRPFFS",144,0) S $P(^TMP($J,B),U,13)=INSURGG "RTN","RMPRPFFS",145,0) ;change to subscriber ID "RTN","RMPRPFFS",146,0) S $P(^TMP($J,B),U,14)=SUBID "RTN","RMPRPFFS",147,0) S $P(^TMP($J,B),U,15)=$P(VADM(2),U,2) "RTN","RMPRPFFS",148,0) S $P(^TMP($J,B),U,16)=B "RTN","RMPRPFFS",149,0) S $P(^TMP($J,B),U,17)=HDES "RTN","RMPRPFFS",150,0) ;change to ICD9 code "RTN","RMPRPFFS",151,0) S $P(^TMP($J,B),U,18)=INICD9E "RTN","RMPRPFFS",152,0) ;add Delivery Date "RTN","RMPRPFFS",153,0) S $P(^TMP($J,B),U,20)=RMPRDEL "RTN","RMPRPFFS",154,0) ;add Insurance Expiration Date "RTN","RMPRPFFS",155,0) S $P(^TMP($J,B),U,19)=RMPRIND "RTN","RMPRPFFS",156,0) ;hcpcs-icd9 code flag "RTN","RMPRPFFS",157,0) S $P(^TMP($J,B),U,21)=CODEFLG "RTN","RMPRPFFS",158,0) S $P(^RMPR(660,RMPRB,1),U,11)=CODEFLG "RTN","RMPRPFFS",159,0) S $P(^RMPR(660,RMPRB,1),U,12)=DT "RTN","RMPRPFFS",160,0) K RMXM,VADM,CAL "RTN","RMPRPFFS",161,0) D KVAR^VADPT "RTN","RMPRPFFS",162,0) Q "RTN","RMPRPFFS",163,0) EXIT ;common exit point "RTN","RMPRPFFS",164,0) N RESULTS D KILL^XUSCLEAN "RTN","RMPRPFFS",165,0) Q "RTN","RMPRPFFS",166,0) ;END "VER") 8.0^22.0 "^DD",660,660,11,0) FORM REQUESTED ON^S^1:PSC;2:2421;3:2237;4:2529-3;5:2529-7;6:2474;7:2431;8:2914;9:OTHER;10:2520;11:STOCK ISSUE;12:INVENTORY ISSUE;13:HISTORICAL DATA;14:VISA;15:LAB ISSUE-3;16:DALC;^0;13^Q "^DD",660,660,11,3) Please select appropriate form to enter this request. "^DD",660,660,11,21,0) ^.001^3^3^3070523^^^^ "^DD",660,660,11,21,1,0) The FORM REQUESTED ON is based on current VA regulations. "^DD",660,660,11,21,2,0) The system makes no checks to be sure that the form entered from "^DD",660,660,11,21,3,0) the set of codes is within these regulations. "^DD",660,660,11,"DT") 3070523 "^DD",660,660,34,0) OIF/OEF^S^0:NO;1:YES;^5;1^Q "^DD",660,660,34,21,0) ^.001^1^1^3070419^^ "^DD",660,660,34,21,1,0) Veteran determined to be OEF/OIF 1 Yes 0 NO. "^DD",660,660,34,"DT") 3070430 "^DD",660,660,89.1,0) DALC REFERENCE NUMBER^F^^HSTV1;3^K:$L(X)>25!($L(X)<1) X "^DD",660,660,89.1,1,0) ^.1 "^DD",660,660,89.1,1,1,0) 660^DDC "^DD",660,660,89.1,1,1,1) S ^RMPR(660,"DDC",$E(X,1,30),DA)="" "^DD",660,660,89.1,1,1,2) K ^RMPR(660,"DDC",$E(X,1,30),DA) "^DD",660,660,89.1,1,1,"%D",0) ^^1^1^3070523^ "^DD",660,660,89.1,1,1,"%D",1,0) This is the DALC internal reference. "^DD",660,660,89.1,1,1,"DT") 3061031 "^DD",660,660,89.1,3) Answer must be 1-25 characters in length. "^DD",660,660,89.1,21,0) ^^2^2^3070709^ "^DD",660,660,89.1,21,1,0) This is the line level reference number from a DALC purchase order or "^DD",660,660,89.1,21,2,0) delivery of item or service. "^DD",660,660,89.1,"DT") 3070523 "^DD",660,660,89.2,0) DALC BILL DATE^D^^HSTV1;4^S %DT="E" D ^%DT S X=Y K:Y<1 X "^DD",660,660,89.2,21,0) ^^2^2^3070523^ "^DD",660,660,89.2,21,1,0) This is the Billing Date from the Denver Acquisition and Logistics "^DD",660,660,89.2,21,2,0) Center (DALC). "^DD",660,660,89.2,"DT") 3070523 "^DD",660,660,89.3,0) DALC ORDERING STATION^F^^HSTV1;5^K:$L(X)>30!($L(X)<3) X "^DD",660,660,89.3,3) Answer must be 3-30 characters in length. "^DD",660,660,89.3,21,0) ^^2^2^3070523^ "^DD",660,660,89.3,21,1,0) This is the Ordering station from to the Denver Acquisition and "^DD",660,660,89.3,21,2,0) Logistics Center (DALC). "^DD",660,660,89.3,"DT") 3070523 "^DD",668,668,15,0) OIF/OEF^S^0:NO;1:YES;^7;1^Q "^DD",668,668,15,21,0) ^^1^1^3070419^ "^DD",668,668,15,21,1,0) Veteran determined to be OEF/OIF 1 Yes 0 NO. "^DD",668,668,15,"DT") 3070430 "BLD",3182,6) ^113 **END** **END**