Released RMPR*3*131 SEQ #104 Extracted from mail message **KIDS**:RMPR*3.0*131^ **INSTALL NAME** RMPR*3.0*131 "BLD",6252,0) RMPR*3.0*131^PROSTHETICS^0^3060914^y "BLD",6252,1,0) ^^5^5^3060913^ "BLD",6252,1,1,0) Prosthetics midnight processing of issues to PCE causing invalid data "BLD",6252,1,2,0) structures in file #900010,VISIT "BLD",6252,1,3,0) a. Subscript error in Austin transmission SITE+10^VASITE "BLD",6252,1,4,0) b. File entry points to another patient "BLD",6252,1,5,0) c. AMBCARE data into Austin "BLD",6252,4,0) ^9.64PA^^ "BLD",6252,6.3) 3 "BLD",6252,"ABPKG") n "BLD",6252,"KRN",0) ^9.67PA^8989.52^19 "BLD",6252,"KRN",.4,0) .4 "BLD",6252,"KRN",.401,0) .401 "BLD",6252,"KRN",.402,0) .402 "BLD",6252,"KRN",.403,0) .403 "BLD",6252,"KRN",.5,0) .5 "BLD",6252,"KRN",.84,0) .84 "BLD",6252,"KRN",3.6,0) 3.6 "BLD",6252,"KRN",3.8,0) 3.8 "BLD",6252,"KRN",9.2,0) 9.2 "BLD",6252,"KRN",9.8,0) 9.8 "BLD",6252,"KRN",9.8,"NM",0) ^9.68A^2^2 "BLD",6252,"KRN",9.8,"NM",1,0) RMPRPCEA^^0^B53474069 "BLD",6252,"KRN",9.8,"NM",2,0) RMPRPCED^^0^B21894321 "BLD",6252,"KRN",9.8,"NM","B","RMPRPCEA",1) "BLD",6252,"KRN",9.8,"NM","B","RMPRPCED",2) "BLD",6252,"KRN",19,0) 19 "BLD",6252,"KRN",19,"NM",0) ^9.68A^^ "BLD",6252,"KRN",19.1,0) 19.1 "BLD",6252,"KRN",101,0) 101 "BLD",6252,"KRN",409.61,0) 409.61 "BLD",6252,"KRN",771,0) 771 "BLD",6252,"KRN",870,0) 870 "BLD",6252,"KRN",8989.51,0) 8989.51 "BLD",6252,"KRN",8989.52,0) 8989.52 "BLD",6252,"KRN",8994,0) 8994 "BLD",6252,"KRN","B",.4,.4) "BLD",6252,"KRN","B",.401,.401) "BLD",6252,"KRN","B",.402,.402) "BLD",6252,"KRN","B",.403,.403) "BLD",6252,"KRN","B",.5,.5) "BLD",6252,"KRN","B",.84,.84) "BLD",6252,"KRN","B",3.6,3.6) "BLD",6252,"KRN","B",3.8,3.8) "BLD",6252,"KRN","B",9.2,9.2) "BLD",6252,"KRN","B",9.8,9.8) "BLD",6252,"KRN","B",19,19) "BLD",6252,"KRN","B",19.1,19.1) "BLD",6252,"KRN","B",101,101) "BLD",6252,"KRN","B",409.61,409.61) "BLD",6252,"KRN","B",771,771) "BLD",6252,"KRN","B",870,870) "BLD",6252,"KRN","B",8989.51,8989.51) "BLD",6252,"KRN","B",8989.52,8989.52) "BLD",6252,"KRN","B",8994,8994) "BLD",6252,"QUES",0) ^9.62^^ "BLD",6252,"REQB",0) ^9.611^2^2 "BLD",6252,"REQB",1,0) RMPR*3.0*128^2 "BLD",6252,"REQB",2,0) RMPR*3.0*121^2 "BLD",6252,"REQB","B","RMPR*3.0*121",2) "BLD",6252,"REQB","B","RMPR*3.0*128",1) "MBREQ") 0 "PKG",101,-1) 1^1 "PKG",101,0) PROSTHETICS^RMPR^PROSTHETICS VERSION 3.0 ALPHA "PKG",101,20,0) ^9.402P^^0 "PKG",101,22,0) ^9.49I^1^1 "PKG",101,22,1,0) 3.0^2960209^2960214 "PKG",101,22,1,"PAH",1,0) 131^3060914 "PKG",101,22,1,"PAH",1,1,0) ^^5^5^3060914 "PKG",101,22,1,"PAH",1,1,1,0) Prosthetics midnight processing of issues to PCE causing invalid data "PKG",101,22,1,"PAH",1,1,2,0) structures in file #900010,VISIT "PKG",101,22,1,"PAH",1,1,3,0) a. Subscript error in Austin transmission SITE+10^VASITE "PKG",101,22,1,"PAH",1,1,4,0) b. File entry points to another patient "PKG",101,22,1,"PAH",1,1,5,0) c. AMBCARE data into Austin "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") 2 "RTN","RMPRPCEA") 0^1^B53474069^B52809233 "RTN","RMPRPCEA",1,0) RMPRPCEA ;HCIOFO/RVD - Prosthetics/PCE Interface; 05/31/01 "RTN","RMPRPCEA",2,0) ;;3.0;PROSTHETICS;**62,82,78,114,120,128,131**;Feb 09, 1996;Build 1 "RTN","RMPRPCEA",3,0) ; "RTN","RMPRPCEA",4,0) ; RMS 10/1/03 Patch 78 - Change Service connected, and environmental "RTN","RMPRPCEA",5,0) ; indicators (Agent Orange, Ionizing Radiation, "RTN","RMPRPCEA",6,0) ; Environmental Contaminants, Military Sexual "RTN","RMPRPCEA",7,0) ; Trauma, Head/Neck Cancer, and Combat Veteran "RTN","RMPRPCEA",8,0) ; Status) to come from new BA fields if they "RTN","RMPRPCEA",9,0) ; exist. "RTN","RMPRPCEA",10,0) ; "RTN","RMPRPCEA",11,0) ;This routine contains the code for sending a Prosthetic visit to PCE. "RTN","RMPRPCEA",12,0) ; "RTN","RMPRPCEA",13,0) ;DBIA #1889-A - this API is used to add, edit and delete the "RTN","RMPRPCEA",14,0) ; of encounter, provider, diagnosis and procedure "RTN","RMPRPCEA",15,0) ; data to VISIT and V files in the PCE module. "RTN","RMPRPCEA",16,0) ; 04/23/2004 KAM RMPR*3*82 Make Background Message more Robust "RTN","RMPRPCEA",17,0) ; "RTN","RMPRPCEA",18,0) ;RMIE60 - ien in file #660 "RTN","RMPRPCEA",19,0) SENDPCE(RMIE60) ; send a Prosthetic Visit to PCE. "RTN","RMPRPCEA",20,0) ; D NEWVAR subroutine removed for functionality 01/31/05 WLC "RTN","RMPRPCEA",21,0) ; "RTN","RMPRPCEA",22,0) N RMPCE,RME2,RMSENT,RMLOCK,RMERR,RMPKG,RMSRC,RMDIAG,RMQTY "RTN","RMPRPCEA",23,0) N RMSCAT,RMPROC,RMUPD,RMIEPCE,RMHLOC,RMLOC,RMPAT,RMDATE,RMINST "RTN","RMPRPCEA",24,0) N RMETYP,RMCDAT,RMPCAT,RMDANOW,DIE,DA,DIC,RMAO,RMEC,RMIR,DFN,RMSCON "RTN","RMPRPCEA",25,0) N RMMST,RMHNC,RMCBV,RMPRTPCE,STOP "RTN","RMPRPCEA",26,0) ; PATCH 78, RMS - 10/1/2003, Billing aware related variables "RTN","RMPRPCEA",27,0) N RMBASCON,RMBAAO,RMBAIR,RMBAEC,RMBAMST,RMBAHNC,RMBACBV,RMBAICD9,RMLOOP "RTN","RMPRPCEA",28,0) N RMPROV,RMCPDT,DXERR,SICD "RTN","RMPRPCEA",29,0) ; "RTN","RMPRPCEA",30,0) S RMERR=1 "RTN","RMPRPCEA",31,0) S RMSRC="PROSTHETICS DATA" "RTN","RMPRPCEA",32,0) S RMPKG=$O(^DIC(9.4,"B","PROSTHETICS",0)) "RTN","RMPRPCEA",33,0) I '$G(RMPKG) S RMERR=-2 G SENDPCEX "RTN","RMPRPCEA",34,0) S RMSTA=$P(^RMPR(660,RMIE60,0),U,10) "RTN","RMPRPCEA",35,0) S (RMLOC,RERRMSG,RERRMSG2)="" "RTN","RMPRPCEA",36,0) F I=0:0 S I=$O(^RMPR(669.9,"C",RMSTA,I)) Q:I'>0 D "RTN","RMPRPCEA",37,0) .I ($D(^RMPR(669.9,I,0))),($D(^RMPR(669.9,I,"PCE"))) S RMLOC=$P(^RMPR(669.9,I,"PCE"),U,3) "RTN","RMPRPCEA",38,0) ;exit if Hospital Location (clinic) not defined. "RTN","RMPRPCEA",39,0) I '$G(RMLOC) D G SENDPCEX "RTN","RMPRPCEA",40,0) .S RMERR=-2 "RTN","RMPRPCEA",41,0) .;RMPR*3*82 04/23/2004 KAM Added next 8 lines "RTN","RMPRPCEA",42,0) .N SPACES,VNAME,ENDAT "RTN","RMPRPCEA",43,0) .S VNAME=$$GET1^DIQ(2,$P(^RMPR(660,RMIE60,0),U,2),.01) "RTN","RMPRPCEA",44,0) .S ENDAT=$$GET1^DIQ(660,RMIE60,.01),SPACES="" "RTN","RMPRPCEA",45,0) .I $G(ENDAT)="" S ENDAT=" No Entry Data Found" "RTN","RMPRPCEA",46,0) .F I=1:1:42-($L(VNAME)+$L(ENDAT)) S SPACES=$G(SPACES)_" " "RTN","RMPRPCEA",47,0) .S RERRMSG=" *** NAME = "_VNAME_" ENTRY DATE = "_ENDAT_SPACES "RTN","RMPRPCEA",48,0) .I $G(RMSTA),$D(^DIC(4,RMSTA,99)) S RMSTAW=$P(^DIC(4,RMSTA,99),U) "RTN","RMPRPCEA",49,0) .S RERRMSG=RERRMSG_" *** Clinic is not defined....Please ask your ADPAC to enter a prosthetics *** clinic in the Prosthetics Site Parameters file for station # = "_$G(RMSTAW) "RTN","RMPRPCEA",50,0) .S RERRMSG2=" *** Using option 'Enter/Edit Station Site Parameters'" "RTN","RMPRPCEA",51,0) .W !,"*** Clinic is not defined....." "RTN","RMPRPCEA",52,0) .W !,"*** Please ask your ADPAC to enter a prosthetics clinic in the" "RTN","RMPRPCEA",53,0) .W !,"*** Prosthetics Site Parameters file for station # = ",RMSTAW "RTN","RMPRPCEA",54,0) .W !,"*** Using option 'Enter/Edit Station Site Parameters'" "RTN","RMPRPCEA",55,0) S RMSENT=0,RMLOCK=0 "RTN","RMPRPCEA",56,0) ; initialize temp file. "RTN","RMPRPCEA",57,0) K ^TMP("RMPRPCE1",$J),RMSTAW "RTN","RMPRPCEA",58,0) ; "RTN","RMPRPCEA",59,0) ; get the visit data (#660) and place in temp file. "RTN","RMPRPCEA",60,0) D GETDATA G:$G(DXERR) SENDPCEX ;quit if inactive diagnosis RMPR*120 "RTN","RMPRPCEA",61,0) ;don't create a PCE encounter if Date of Death is before the transaction "RTN","RMPRPCEA",62,0) I $D(VADM(6)),$P(VADM(6),U,1),$P(VADM(6),U,1)<(RMDATE) G SENDPCEX "RTN","RMPRPCEA",63,0) ; "RTN","RMPRPCEA",64,0) ; build the temp file for sending to PCE "RTN","RMPRPCEA",65,0) D BUILD "RTN","RMPRPCEA",66,0) ; "RTN","RMPRPCEA",67,0) ; now send "RTN","RMPRPCEA",68,0) D SENDIT "RTN","RMPRPCEA",69,0) ; "RTN","RMPRPCEA",70,0) SENDPCEX ; exit point "RTN","RMPRPCEA",71,0) ; "RTN","RMPRPCEA",72,0) ; clear the temp file "RTN","RMPRPCEA",73,0) K ^TMP("RMPRPCE1",$J) "RTN","RMPRPCEA",74,0) ; "RTN","RMPRPCEA",75,0) ; return "RTN","RMPRPCEA",76,0) Q RMERR "RTN","RMPRPCEA",77,0) ; "RTN","RMPRPCEA",78,0) GETDATA ; get the visit data and place in temp file "RTN","RMPRPCEA",79,0) K RMDA,RMDA2 "RTN","RMPRPCEA",80,0) S RMDA=$NA(^TMP("RMPRPCE1",$J,"RM")) "RTN","RMPRPCEA",81,0) D GETS^DIQ(660,RMIE60_",","*","I",RMDA,"") "RTN","RMPRPCEA",82,0) S RMDA2=$NA(^TMP("RMPRPCE1",$J,"RM",660,RMIE60_",")) "RTN","RMPRPCEA",83,0) D NOW^%DTC "RTN","RMPRPCEA",84,0) S RMDANOW=% "RTN","RMPRPCEA",85,0) S RMDATE=@RMDA2@(.01,"I"),RMDATE=RMDATE_"."_$P(%,".",2) "RTN","RMPRPCEA",86,0) S (DFN,RMPAT)=@RMDA2@(.02,"I") "RTN","RMPRPCEA",87,0) S RMHLOC=RMLOC "RTN","RMPRPCEA",88,0) S RMINST=@RMDA2@(8.11,"I") "RTN","RMPRPCEA",89,0) S RMPCAT=@RMDA2@(62,"I") "RTN","RMPRPCEA",90,0) S RMSCON=0 "RTN","RMPRPCEA",91,0) I (RMPCAT=1)!(RMPCAT=2) S RMSCON=1 "RTN","RMPRPCEA",92,0) ;============================== "RTN","RMPRPCEA",93,0) S RMSCAT="A" "RTN","RMPRPCEA",94,0) S RMETYP="P" "RTN","RMPRPCEA",95,0) S RMUSER=@RMDA2@(27,"I") "RTN","RMPRPCEA",96,0) S RMDIAG=@RMDA2@(8.8,"I") "RTN","RMPRPCEA",97,0) S RMPROC=@RMDA2@(4.1,"I") "RTN","RMPRPCEA",98,0) S RMPROV=@RMDA2@(8.6,"I") "RTN","RMPRPCEA",99,0) S RMCPDT=@RMDA2@(8.4,"I") "RTN","RMPRPCEA",100,0) S RMQTY=@RMDA2@(5,"I") "RTN","RMPRPCEA",101,0) S RMCDAT=@RMDA2@(10,"I") "RTN","RMPRPCEA",102,0) S (RMPCE,RMIEPCE)=@RMDA2@(8.12,"I") "RTN","RMPRPCEA",103,0) ; PATCH 78, RMS - 10/1/2003, billing aware related variables "RTN","RMPRPCEA",104,0) K RMBAICD9,RMBAAO,RMBASCON,RMBAAIR,RMBAEC,RMBAMST,RMBAHNC,RMBACBV "RTN","RMPRPCEA",105,0) I '$D(^RMPR(660,RMIE60,"BA1")) G GTDT ; no BA data, skip retrieval "RTN","RMPRPCEA",106,0) F RMLOOP=30:1:33 D "RTN","RMPRPCEA",107,0) . N RMBAREC S RMBAREC=RMLOOP-29 "RTN","RMPRPCEA",108,0) . S RMBAICD9(RMBAREC)=@RMDA2@(RMLOOP,"I"),SICD=RMBAICD9(RMBAREC) I SICD'="" S:$P($G(^ICD9(SICD,0)),U,9) DXERR=1 "RTN","RMPRPCEA",109,0) . S RMBAAO(RMBAREC)=@RMDA2@((RMLOOP+.1),"I") "RTN","RMPRPCEA",110,0) . S RMBAIR(RMBAREC)=@RMDA2@((RMLOOP+.2),"I") "RTN","RMPRPCEA",111,0) . S RMBASCON(RMBAREC)=@RMDA2@((RMLOOP+.3),"I") "RTN","RMPRPCEA",112,0) . S RMBAEC(RMBAREC)=@RMDA2@((RMLOOP+.4),"I") "RTN","RMPRPCEA",113,0) . S RMBAMST(RMBAREC)=@RMDA2@((RMLOOP+.5),"I") "RTN","RMPRPCEA",114,0) . S RMBAHNC(RMBAREC)=@RMDA2@((RMLOOP+.6),"I") "RTN","RMPRPCEA",115,0) . S RMBACBV(RMBAREC)=@RMDA2@((RMLOOP+.7),"I") "RTN","RMPRPCEA",116,0) ; Retrieve order number "RTN","RMPRPCEA",117,0) GTDT S RMPTR123=@RMDA2@(8.9,"I") "RTN","RMPRPCEA",118,0) S RMODENT=$$GET1^DIQ(123,RMPTR123_",",.03) "RTN","RMPRPCEA",119,0) ;get Date of Death. "RTN","RMPRPCEA",120,0) D DEM^VADPT "RTN","RMPRPCEA",121,0) ;get Agent Orange and Radiation. "RTN","RMPRPCEA",122,0) D SVC^VADPT S RMAO=VASV(2),RMIR=VASV(3) "RTN","RMPRPCEA",123,0) ;get environmental contaminants. "RTN","RMPRPCEA",124,0) S RMEC=$$GET1^DIQ(2,DFN,.322013,"I") I RMEC="Y" S RMEC=1 "RTN","RMPRPCEA",125,0) S:RMEC'=1 RMEC=0 "RTN","RMPRPCEA",126,0) ; "RTN","RMPRPCEA",127,0) S RMMST="",RMCBV="",RMHNC="" "RTN","RMPRPCEA",128,0) Q "RTN","RMPRPCEA",129,0) ; "RTN","RMPRPCEA",130,0) BUILD ; now build array for passing data to PCE "RTN","RMPRPCEA",131,0) K ^TMP("RMPRPCE1",$J,"PXAPI"),RMAPI "RTN","RMPRPCEA",132,0) S RMAPI=$NA(^TMP("RMPRPCE1",$J,"PXAPI")) "RTN","RMPRPCEA",133,0) ; ---------encounter date/time---------------- "RTN","RMPRPCEA",134,0) S @RMAPI@("ENCOUNTER",1,"ENC D/T")=RMDATE "RTN","RMPRPCEA",135,0) ; --------------patient----------------------- "RTN","RMPRPCEA",136,0) S @RMAPI@("ENCOUNTER",1,"PATIENT")=RMPAT "RTN","RMPRPCEA",137,0) ; ---------------clinic----------------------- "RTN","RMPRPCEA",138,0) S @RMAPI@("ENCOUNTER",1,"HOS LOC")=RMHLOC "RTN","RMPRPCEA",139,0) ; -------------checkout date/time------------- "RTN","RMPRPCEA",140,0) S @RMAPI@("ENCOUNTER",1,"CHECKOUT D/T")=RMDATE "RTN","RMPRPCEA",141,0) ; ------------agent orange-------------------- "RTN","RMPRPCEA",142,0) S @RMAPI@("ENCOUNTER",1,"AO")=RMAO "RTN","RMPRPCEA",143,0) ;--------------ionizing radiation------------- "RTN","RMPRPCEA",144,0) S @RMAPI@("ENCOUNTER",1,"IR")=RMIR "RTN","RMPRPCEA",145,0) ;-----------environmental contaminants-------- "RTN","RMPRPCEA",146,0) S @RMAPI@("ENCOUNTER",1,"EC")=RMEC "RTN","RMPRPCEA",147,0) ; --------------service connected-------------- "RTN","RMPRPCEA",148,0) S @RMAPI@("ENCOUNTER",1,"SC")=RMSCON "RTN","RMPRPCEA",149,0) ; ------------Military Sexual Trauma---------- "RTN","RMPRPCEA",150,0) S @RMAPI@("ENCOUNTER",1,"MST")=RMMST "RTN","RMPRPCEA",151,0) ; -------------Head/Neck Cancer--------------- "RTN","RMPRPCEA",152,0) S @RMAPI@("ENCOUNTER",1,"HNC")=RMHNC "RTN","RMPRPCEA",153,0) ; --------------Combat Veteran--------- "RTN","RMPRPCEA",154,0) S @RMAPI@("ENCOUNTER",1,"CV")=RMCBV "RTN","RMPRPCEA",155,0) ; --------------service category-------------- "RTN","RMPRPCEA",156,0) S @RMAPI@("ENCOUNTER",1,"SERVICE CATEGORY")=RMSCAT "RTN","RMPRPCEA",157,0) ; ---------------encounter type--------------- "RTN","RMPRPCEA",158,0) S @RMAPI@("ENCOUNTER",1,"ENCOUNTER TYPE")=RMETYP "RTN","RMPRPCEA",159,0) ; ------------primary provider---------------- "RTN","RMPRPCEA",160,0) S @RMAPI@("PROVIDER",1,"NAME")=RMUSER "RTN","RMPRPCEA",161,0) ; ----------------diagnosis------------------ "RTN","RMPRPCEA",162,0) S @RMAPI@("DX/PL",1,"DIAGNOSIS")=RMDIAG "RTN","RMPRPCEA",163,0) S @RMAPI@("DX/PL",1,"PRIMARY")=1 "RTN","RMPRPCEA",164,0) ; -------------- procedures ----------------- "RTN","RMPRPCEA",165,0) S @RMAPI@("PROCEDURE",1,"PROCEDURE")=RMPROC "RTN","RMPRPCEA",166,0) ; ---------------- Quantity ----------------- "RTN","RMPRPCEA",167,0) S @RMAPI@("PROCEDURE",1,"QTY")=RMQTY "RTN","RMPRPCEA",168,0) ; -------------- Procedures ----------------- "RTN","RMPRPCEA",169,0) I '$D(RMBAICD9(1)) D G BLD1 "RTN","RMPRPCEA",170,0) . S @RMAPI@("PROCEDURE",1,"DIAGNOSIS")=RMDIAG "RTN","RMPRPCEA",171,0) ; "RTN","RMPRPCEA",172,0) F RMLOOP=1:1:99 Q:$G(RMBAICD9(RMLOOP))="" D "RTN","RMPRPCEA",173,0) . S @RMAPI@("DX/PL",RMLOOP,"DIAGNOSIS")=$G(RMBAICD9(RMLOOP)) "RTN","RMPRPCEA",174,0) . S @RMAPI@("DX/PL",RMLOOP,"PL AO")=$G(RMBAAO(RMLOOP)) "RTN","RMPRPCEA",175,0) . S @RMAPI@("DX/PL",RMLOOP,"PL IR")=$G(RMBAIR(RMLOOP)) "RTN","RMPRPCEA",176,0) . S @RMAPI@("DX/PL",RMLOOP,"PL SC")=$G(RMBASCON(RMLOOP)) "RTN","RMPRPCEA",177,0) . S @RMAPI@("DX/PL",RMLOOP,"PL EC")=$G(RMBAEC(RMLOOP)) "RTN","RMPRPCEA",178,0) . S @RMAPI@("DX/PL",RMLOOP,"PL MST")=$G(RMBAMST(RMLOOP)) "RTN","RMPRPCEA",179,0) . S @RMAPI@("DX/PL",RMLOOP,"PL HNC")=$G(RMBAHNC(RMLOOP)) "RTN","RMPRPCEA",180,0) . S @RMAPI@("DX/PL",RMLOOP,"PL CV")=$G(RMBACBV(RMLOOP)) "RTN","RMPRPCEA",181,0) . I RMLOOP=1 D Q "RTN","RMPRPCEA",182,0) . . S @RMAPI@("DX/PL",RMLOOP,"PRIMARY")=RMLOOP "RTN","RMPRPCEA",183,0) . . S RMDIAG=$G(RMBAICD9(RMLOOP)) "RTN","RMPRPCEA",184,0) . . S @RMAPI@("PROCEDURE",1,"DIAGNOSIS")=$G(RMBAICD9(RMLOOP)) "RTN","RMPRPCEA",185,0) . S @RMAPI@("PROCEDURE",1,"DIAGNOSIS "_RMLOOP)=$G(RMBAICD9(RMLOOP)) ; only one procedure per send "RTN","RMPRPCEA",186,0) ; "RTN","RMPRPCEA",187,0) ; -----------------procedures---------------- "RTN","RMPRPCEA",188,0) BLD1 S @RMAPI@("PROCEDURE",1,"PROCEDURE")=RMPROC "RTN","RMPRPCEA",189,0) S @RMAPI@("PROCEDURE",1,"ORD PROVIDER")=RMPROV "RTN","RMPRPCEA",190,0) S @RMAPI@("PROCEDURE",1,"EVENT D/T")=RMCPDT "RTN","RMPRPCEA",191,0) ; ------------- Order Reference ------------- "RTN","RMPRPCEA",192,0) S @RMAPI@("PROCEDURE",1,"ORD REFERENCE")=RMODENT "RTN","RMPRPCEA",193,0) ; -----------------Quantity------------------ "RTN","RMPRPCEA",194,0) S @RMAPI@("PROCEDURE",1,"QTY")=RMQTY "RTN","RMPRPCEA",195,0) ; -----------------diagnosis----------------- "RTN","RMPRPCEA",196,0) S @RMAPI@("PROCEDURE",1,"DIAGNOSIS")=RMDIAG "RTN","RMPRPCEA",197,0) Q "RTN","RMPRPCEA",198,0) ; "RTN","RMPRPCEA",199,0) SENDIT ; send the data to PCE. API (1891) "RTN","RMPRPCEA",200,0) K RMPROB,RMPRTPCE,RMPCE "RTN","RMPRPCEA",201,0) S (RMPRCPER,RMPROB,STOP)=0 "RTN","RMPRPCEA",202,0) D PRV^RMPRPCED "RTN","RMPRPCEA",203,0) ; call the PCE package API. "RTN","RMPRPCEA",204,0) I RMERR'<1 S RMERR=$$DATA2PCE^PXAPI($NA(^TMP("RMPRPCE1",$J,"PXAPI")),RMPKG,RMSRC,.RMPCE,RMUSER,0,,"",.RMPROB) "RTN","RMPRPCEA",205,0) ;To check for returned error messages, list the RMPROB array. "RTN","RMPRPCEA",206,0) I RMERR<1 W !,"File #660 IEN="_RMIE60_" - Error in PCE interface !!!" "RTN","RMPRPCEA",207,0) ;delete PCE entry if Provider and CPT CODE error, but send an error "RTN","RMPRPCEA",208,0) ;message to RMPR PCE mailgroup. "RTN","RMPRPCEA",209,0) I $D(RMPROB($J)) D CHECK^RMPRPCED "RTN","RMPRPCEA",210,0) I $G(RMPCE),$G(RMPRCPER) S RMPRTPCE=RJ_"^"_RMHLOC,RMCHK=$$DELVFILE^PXAPI("ALL",.RMPCE,RMPKG,RMSRC,0,0,"") Q "RTN","RMPRPCEA",211,0) ; "RTN","RMPRPCEA",212,0) Q:'$G(RMPCE) "RTN","RMPRPCEA",213,0) ;update PCE pointer and date last sent in #660. "RTN","RMPRPCEA",214,0) K RMUPD "RTN","RMPRPCEA",215,0) S RMUPD(660,RMIE60_",",8.12)=RMPCE "RTN","RMPRPCEA",216,0) S RMUPD(660,RMIE60_",",8.13)=RMDANOW "RTN","RMPRPCEA",217,0) D FILE^DIE("","RMUPD","") "RTN","RMPRPCEA",218,0) Q "RTN","RMPRPCEA",219,0) ; "RTN","RMPRPCED") 0^2^B21894321^B10727703 "RTN","RMPRPCED",1,0) RMPRPCED ;Hines OIFO/RVD - Prosthetics/660/668/PCE DELETE ;7/30/02 09:39 "RTN","RMPRPCED",2,0) ;;3.0;PROSTHETICS;**62,70,121,131**;Feb 09, 1996;Build 3 "RTN","RMPRPCED",3,0) ;RVD 7/1/02 - patch #70 - new RMPR variables before calling PCE. "RTN","RMPRPCED",4,0) ; "RTN","RMPRPCED",5,0) ; This routine contains the code for deleting a Prosthetic visit in PCE. "RTN","RMPRPCED",6,0) ; "RTN","RMPRPCED",7,0) ;DBIA #1890 - this API is used to delete data from the VISIT file "RTN","RMPRPCED",8,0) ; (9000010) and V files from PCE module. "RTN","RMPRPCED",9,0) ;DBIA #10048 - fileman read on file 9.4. "RTN","RMPRPCED",10,0) ; "RTN","RMPRPCED",11,0) DEL(RMIE60) ;delete PCE visit. "RTN","RMPRPCED",12,0) D NEWVAR "RTN","RMPRPCED",13,0) S (RMLOCK,RMERR)=0 "RTN","RMPRPCED",14,0) I '$P($G(^RMPR(660,RMIE60,10)),U,12) G DEL68 "RTN","RMPRPCED",15,0) S RMSRC="PROSTHETICS DATA" "RTN","RMPRPCED",16,0) S X="PROSTHETICS",DIC="^DIC(9.4," D ^DIC "RTN","RMPRPCED",17,0) I '$D(Y)!(Y<0) S RMERR=-1 G DELX "RTN","RMPRPCED",18,0) S RMPKG=+Y "RTN","RMPRPCED",19,0) I 'RMPKG S RMERR=-1 G DELX "RTN","RMPRPCED",20,0) ; "RTN","RMPRPCED",21,0) ; get PCE IEn from file #660. "RTN","RMPRPCED",22,0) S RMPCE=$P($G(^RMPR(660,RMIE60,10)),U,12) "RTN","RMPRPCED",23,0) I 'RMPCE S RMERR=-1 G DELX "RTN","RMPRPCED",24,0) I '$D(^AUPNVSIT(RMPCE,0)) G DEL68 "RTN","RMPRPCED",25,0) ; "RTN","RMPRPCED",26,0) DELVF ; Remove all workload data from the PCE visit file & related V files. "RTN","RMPRPCED",27,0) ; check if the visit is already in PCE and remove workload, "RTN","RMPRPCED",28,0) ; (sending RMPKG and RMSRC to ensure that only data that originally "RTN","RMPRPCED",29,0) ; came from PROSTHETICS will be removed). "RTN","RMPRPCED",30,0) ; "RTN","RMPRPCED",31,0) N RMPR,REDO,VEJD "RTN","RMPRPCED",32,0) S REDO=0 "RTN","RMPRPCED",33,0) DELVF1 S RMCHK=$$DELVFILE^PXAPI("ALL",.RMPCE,RMPKG,RMSRC,0,0,"") "RTN","RMPRPCED",34,0) I RMCHK'=1 D I REDO=1 G DELVF1 "RTN","RMPRPCED",35,0) . Q:$P($G(^AUPNVSIT(RMPCE,0)),U,9)'=1!REDO "RTN","RMPRPCED",36,0) . S VEJD=$O(^VEJD(19610.5,"B",RMPCE,0)) Q:VEJD="" "RTN","RMPRPCED",37,0) . ;kill remaining dependent (DSS) to visit "RTN","RMPRPCED",38,0) . S DA=VEJD,DIK="^VEJD(19610.5," D ^DIK "RTN","RMPRPCED",39,0) . K DA,DIK "RTN","RMPRPCED",40,0) . I $P(^AUPNVSIT(RMPCE,0),U,9)=0 S REDO=1 "RTN","RMPRPCED",41,0) I RMCHK'=1 W !!,"*** Error in deleting PCE visit !!",! S RMERR=-1 G DELX "RTN","RMPRPCED",42,0) ; "RTN","RMPRPCED",43,0) DEL68 ; delete PCE info in file #668. "RTN","RMPRPCED",44,0) S RMAMIS=$G(^RMPR(660,RMIE60,"AMS")) "RTN","RMPRPCED",45,0) S RMIE68=$O(^RMPR(668,"F",RMIE60,0)) G:RMIE68="" DEL60 "RTN","RMPRPCED",46,0) L +^RMPR(668,RMIE68):3 I $T=0 D ERR68 G DELX "RTN","RMPRPCED",47,0) S DA=$O(^RMPR(668,RMIE68,10,"B",RMIE60,0)) "RTN","RMPRPCED",48,0) S DA(1)=RMIE68,DIK="^RMPR(668,"_DA(1)_",10," D ^DIK "RTN","RMPRPCED",49,0) S RMAMIEN=$O(^RMPR(668,RMIE68,11,"B",RMAMIS,0)) "RTN","RMPRPCED",50,0) S RMCNT=0 "RTN","RMPRPCED",51,0) F I=0:0 S I=$O(^RMPR(668,RMIE68,10,"B",I)) Q:I'>0 D "RTN","RMPRPCED",52,0) .S RMAMIS68=$G(^RMPR(660,I,"AMS")) S:RMAMIS68=RMAMIS RMCNT=RMCNT+1 "RTN","RMPRPCED",53,0) ;if no other line item of the same GROUPER #, then delete. "RTN","RMPRPCED",54,0) I RMCNT=1 D "RTN","RMPRPCED",55,0) .S DA=RMAMIEN "RTN","RMPRPCED",56,0) .S DA(1)=RMIE68,DIK="^RMPR(668,"_DA(1)_",11," "RTN","RMPRPCED",57,0) .D ^DIK "RTN","RMPRPCED",58,0) L -^RMPR(668,RMIE68) "RTN","RMPRPCED",59,0) ; "RTN","RMPRPCED",60,0) DEL60 ; delete PCE info in file #660. "RTN","RMPRPCED",61,0) ; lock file #660 "RTN","RMPRPCED",62,0) L +^RMPR(660,RMIE60,10):3 I $T=0 D ERR60 G DELX "RTN","RMPRPCED",63,0) S RMARR(660,RMIE60_",",8.12)="@" "RTN","RMPRPCED",64,0) S RMARR(660,RMIE60_",",8.13)="@" "RTN","RMPRPCED",65,0) D FILE^DIE("","RMARR","") "RTN","RMPRPCED",66,0) L -^RMPR(660,RMIE60,10) "RTN","RMPRPCED",67,0) ; "RTN","RMPRPCED",68,0) ; exit delete "RTN","RMPRPCED",69,0) DELX Q RMERR "RTN","RMPRPCED",70,0) ; "RTN","RMPRPCED",71,0) ERR68 ; print error if unable to delete/update file #668. "RTN","RMPRPCED",72,0) W !!,"*** File #668 is locked, IEN = ",RMIE68,", PLEASE contact your IRM!!",!! "RTN","RMPRPCED",73,0) L -^RMPR(668,RMIE68) "RTN","RMPRPCED",74,0) S RMERR=-1 "RTN","RMPRPCED",75,0) Q "RTN","RMPRPCED",76,0) ERR60 ; print error if unable to delete/update file #660. "RTN","RMPRPCED",77,0) W !!,"*** File #660 is locked, IEN = ",RMIE60,", PLEASE contact your IRM!!",!! "RTN","RMPRPCED",78,0) S RMERR=-1 "RTN","RMPRPCED",79,0) Q "RTN","RMPRPCED",80,0) ; "RTN","RMPRPCED",81,0) CHECK ;check for return error from PCE "RTN","RMPRPCED",82,0) ;input variable RMPROB "RTN","RMPRPCED",83,0) I $D(RMPROB($J,1))!$D(RMPROB($J,2)) D "RTN","RMPRPCED",84,0) .S (R2,R3,RMMESS)="" "RTN","RMPRPCED",85,0) .F R1=0:0 S R1=$O(RMPROB($J,R1)) Q:R1'>0 F S R2=$O(RMPROB($J,R1,"ERROR1",R2)) Q:R2="" F S R3=$O(RMPROB($J,R1,"ERROR1",R2,R3)) Q:R3="" D "RTN","RMPRPCED",86,0) ..F R4=0:0 S R4=$O(RMPROB($J,R1,"ERROR1",R2,R3,R4)) Q:R4'>0 D "RTN","RMPRPCED",87,0) ...S RMMESS=RMPROB($J,R1,"ERROR1",R2,R3,R4) "RTN","RMPRPCED",88,0) ...W:RMMESS'="" !,"???? ",RMMESS "RTN","RMPRPCED",89,0) ...I (RMMESS["CPT")!(RMMESS["Provider") S RMPRCPER=1 "RTN","RMPRPCED",90,0) Q "RTN","RMPRPCED",91,0) ; "RTN","RMPRPCED",92,0) PRV ;PROVIDER VALIDATION PRIOR TO PCE INTERFACE CALL "RTN","RMPRPCED",93,0) K PXAA,PXADI,PXAERR N PXAVDATE,PXAERRF "RTN","RMPRPCED",94,0) S PXAA("NAME")=^TMP("RMPRPCE1",$J,"PXAPI","PROVIDER",1,"NAME"),PXAVDATE=$P(^TMP("RMPRPCE1",$J,"PXAPI","ENCOUNTER",1,"ENC D/T"),".") "RTN","RMPRPCED",95,0) ;CHECKER "RTN","RMPRPCED",96,0) ;----Missing a pointer to providers name "RTN","RMPRPCED",97,0) I $G(PXAA("NAME"))']"" D G PRVX:$G(STOP) "RTN","RMPRPCED",98,0) .S STOP=1 ;--USED TO STOP DO LOOP "RTN","RMPRPCED",99,0) .S PXAERRF=1 ;--FLAG INDICATES THERE IS AN ERR "RTN","RMPRPCED",100,0) .S PXADI("DIALOG")=8390001.001 "RTN","RMPRPCED",101,0) .S PXAERR(9)="NAME" "RTN","RMPRPCED",102,0) .S PXAERR(11)=$G(PXAA("NAME")) "RTN","RMPRPCED",103,0) .S PXAERR(12)="You are missing a pointer to the NEW PERSON file #200 that represents the Provider's name" "RTN","RMPRPCED",104,0) ; "RTN","RMPRPCED",105,0) ;----Not a pointer to NEW PERSON file#200 "RTN","RMPRPCED",106,0) I $G(PXAA("NAME"))'["@" D 01^PXAIUPRV($G(PXAA("NAME"))) I $G(PXAIVAL)=1 K PXAIVAL,PXCA("ERROR") D G PRVX:$G(STOP) "RTN","RMPRPCED",107,0) .S STOP=1 "RTN","RMPRPCED",108,0) .S PXAERRF=1 "RTN","RMPRPCED",109,0) .S PXADI("DIALOG")=8390001.001 "RTN","RMPRPCED",110,0) .S PXAERR(9)="NAME" "RTN","RMPRPCED",111,0) .S PXAERR(11)=$G(PXAA("NAME")) "RTN","RMPRPCED",112,0) .S PXAERR(12)=PXAERR(11)_" is NOT a pointer value to the NEW PERSON file #200 for Provider" "RTN","RMPRPCED",113,0) ; "RTN","RMPRPCED",114,0) ;----Not have an active person class "RTN","RMPRPCED",115,0) N CLASS "RTN","RMPRPCED",116,0) S CLASS=+$$GET^XUA4A72($G(PXAA("NAME")),PXAVDATE) I CLASS<0 D "RTN","RMPRPCED",117,0) .S STOP=1 "RTN","RMPRPCED",118,0) .S PXAERRF=1 "RTN","RMPRPCED",119,0) .S PXADI("DIALOG")=8390001.001 "RTN","RMPRPCED",120,0) .S PXAERR(9)="NAME" "RTN","RMPRPCED",121,0) .S PXAERR(11)=$G(PXAA("NAME")) "RTN","RMPRPCED",122,0) .S PXAERR(12)="The Provider does not have an ACTIVE person class!" "RTN","RMPRPCED",123,0) PRVX I STOP D "RTN","RMPRPCED",124,0) . S RMERR=0 K RMPCE "RTN","RMPRPCED",125,0) . S RMPROB($J,2,"ERROR1","PROVIDER","NAME",1)=PXAERR(12) "RTN","RMPRPCED",126,0) K PXAERR,PXAERRF,PXADI,PXAA "RTN","RMPRPCED",127,0) Q "RTN","RMPRPCED",128,0) NEWVAR ; new variables "RTN","RMPRPCED",129,0) N Y "RTN","RMPRPCED",130,0) N I,RMCHK,RMKI,RMSUB,RMARR,DIE,DA,DIC,RMAMIS,RMAMIS68,DIK,RMCNT,RMAMIEN "RTN","RMPRPCED",131,0) Q "VER") 8.0^22.0 "BLD",6252,6) ^104 **END** **END**