Index: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPCED.m
===================================================================
--- WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPCED.m	(revision 613)
+++ WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPCED.m	(revision 623)
@@ -1,131 +1,131 @@
-RMPRPCED	;Hines OIFO/RVD - Prosthetics/660/668/PCE DELETE ;7/30/02  09:39
-	;;3.0;PROSTHETICS;**62,70,121,131,141**;Feb 09, 1996;Build 5
-	;RVD 7/1/02 - patch #70 - new RMPR variables before calling PCE.
-	;
-	; This routine contains the code for deleting a Prosthetic visit in PCE.
-	;
-	;DBIA #1890  - this API is used to delete data from the VISIT file
-	;              (9000010) and V files from PCE module.
-	;DBIA #10048 - fileman read on file 9.4.
-	;
-DEL(RMIE60)	;delete PCE visit.
-	D NEWVAR
-	S (RMLOCK,RMERR)=0
-	I '$P($G(^RMPR(660,RMIE60,10)),U,12) G DEL68
-	S RMSRC="PROSTHETICS DATA"
-	S X="PROSTHETICS",DIC="^DIC(9.4," D ^DIC
-	I '$D(Y)!(Y<0) S RMERR=-1 G DELX
-	S RMPKG=+Y
-	I 'RMPKG S RMERR=-1 G DELX
-	;
-	; get PCE IEn from file #660.
-	S RMPCE=$P($G(^RMPR(660,RMIE60,10)),U,12)
-	I 'RMPCE S RMERR=-1 G DELX
-	I '$D(^AUPNVSIT(RMPCE,0)) G DEL68
-	;
-DELVF	; Remove all workload data from the PCE visit file & related V files.
-	; check if the visit is already in PCE and remove workload,
-	; (sending RMPKG and RMSRC to ensure that only data that originally
-	; came from PROSTHETICS will be removed).
-	;
-	N RMPR,REDO,VEJD
-	S REDO=0
-DELVF1	S RMCHK=$$DELVFILE^PXAPI("ALL",.RMPCE,RMPKG,RMSRC,0,0,"")
-	I RMCHK'=1 D  I REDO=1 G DELVF1
-	. Q:$P($G(^AUPNVSIT(RMPCE,0)),U,9)'=1!REDO
-	. S VEJD=$O(^VEJD(19610.5,"B",RMPCE,0)) Q:VEJD=""
-	. ;kill remaining dependent (DSS) to visit
-	. S DA=VEJD,DIK="^VEJD(19610.5," D ^DIK
-	. K DA,DIK
-	. I $P(^AUPNVSIT(RMPCE,0),U,9)=0 S REDO=1
-	I RMCHK'=1 W !!,"*** Error in deleting PCE visit !!",! S RMERR=-1 G DELX
-	;
-DEL68	; delete PCE info in file #668.
-	S RMAMIS=$G(^RMPR(660,RMIE60,"AMS"))
-	S RMIE68=$O(^RMPR(668,"F",RMIE60,0)) G:RMIE68="" DEL60
-	L +^RMPR(668,RMIE68):3 I $T=0 D ERR68 G DELX
-	S DA=$O(^RMPR(668,RMIE68,10,"B",RMIE60,0))
-	S DA(1)=RMIE68,DIK="^RMPR(668,"_DA(1)_",10," D ^DIK
-	S RMAMIEN=$O(^RMPR(668,RMIE68,11,"B",RMAMIS,0))
-	S RMCNT=0
-	F I=0:0 S I=$O(^RMPR(668,RMIE68,10,"B",I)) Q:I'>0  D
-	.S RMAMIS68=$G(^RMPR(660,I,"AMS")) S:RMAMIS68=RMAMIS RMCNT=RMCNT+1
-	;if no other line item of the same GROUPER #, then delete.
-	I RMCNT=1,RMAMIEN D
-	.S DA=RMAMIEN
-	.S DA(1)=RMIE68,DIK="^RMPR(668,"_DA(1)_",11,"
-	.D ^DIK
-	L -^RMPR(668,RMIE68)
-	;
-DEL60	; delete PCE info in file #660.
-	; lock file #660
-	L +^RMPR(660,RMIE60,10):3 I $T=0 D ERR60 G DELX
-	S RMARR(660,RMIE60_",",8.12)="@"
-	S RMARR(660,RMIE60_",",8.13)="@"
-	D FILE^DIE("","RMARR","")
-	L -^RMPR(660,RMIE60,10)
-	;
-	; exit delete
-DELX	Q RMERR
-	;
-ERR68	; print error if unable to delete/update file #668.
-	W !!,"*** File #668 is locked, IEN = ",RMIE68,", PLEASE contact your IRM!!",!!
-	L -^RMPR(668,RMIE68)
-	S RMERR=-1
-	Q
-ERR60	; print error if unable to delete/update file #660.
-	W !!,"*** File #660 is locked, IEN = ",RMIE60,", PLEASE contact your IRM!!",!!
-	S RMERR=-1
-	Q
-	;
-CHECK	;check for return error from PCE
-	;input variable RMPROB
-	I $D(RMPROB($J,1))!$D(RMPROB($J,2)) D
-	.S (R2,R3,RMMESS)=""
-	.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
-	..F R4=0:0 S R4=$O(RMPROB($J,R1,"ERROR1",R2,R3,R4)) Q:R4'>0  D
-	...S RMMESS=RMPROB($J,R1,"ERROR1",R2,R3,R4)
-	...W:RMMESS'="" !,"???? ",RMMESS
-	...I (RMMESS["CPT")!(RMMESS["Provider") S RMPRCPER=1
-	Q
-	;
-PRV	;PROVIDER VALIDATION PRIOR TO PCE INTERFACE CALL
-	K PXAA,PXADI,PXAERR N PXAVDATE,PXAERRF
-	S PXAA("NAME")=^TMP("RMPRPCE1",$J,"PXAPI","PROVIDER",1,"NAME"),PXAVDATE=$P(^TMP("RMPRPCE1",$J,"PXAPI","ENCOUNTER",1,"ENC D/T"),".")
-	;CHECKER
-	;----Missing a pointer to providers name
-	I $G(PXAA("NAME"))']"" D  G PRVX:$G(STOP)
-	.S STOP=1 ;--USED TO STOP DO LOOP
-	.S PXAERRF=1 ;--FLAG INDICATES THERE IS AN ERR
-	.S PXADI("DIALOG")=8390001.001
-	.S PXAERR(9)="NAME"
-	.S PXAERR(11)=$G(PXAA("NAME"))
-	.S PXAERR(12)="You are missing a pointer to the NEW PERSON file #200 that represents the Provider's name"
-	;
-	;----Not a pointer to NEW PERSON file#200
-	I $G(PXAA("NAME"))'["@" D 01^PXAIUPRV($G(PXAA("NAME"))) I $G(PXAIVAL)=1 K PXAIVAL,PXCA("ERROR") D  G PRVX:$G(STOP)
-	.S STOP=1
-	.S PXAERRF=1
-	.S PXADI("DIALOG")=8390001.001
-	.S PXAERR(9)="NAME"
-	.S PXAERR(11)=$G(PXAA("NAME"))
-	.S PXAERR(12)=PXAERR(11)_" is NOT a pointer value to the NEW PERSON file #200 for Provider"
-	;
-	;----Not have an active person class
-	N CLASS
-	S CLASS=+$$GET^XUA4A72($G(PXAA("NAME")),PXAVDATE) I CLASS<0 D
-	.S STOP=1
-	.S PXAERRF=1
-	.S PXADI("DIALOG")=8390001.001
-	.S PXAERR(9)="NAME"
-	.S PXAERR(11)=$G(PXAA("NAME"))
-	.S PXAERR(12)="The Provider does not have an ACTIVE person class!"
-PRVX	I STOP D
-	. S RMERR=0 K RMPCE
-	. S RMPROB($J,2,"ERROR1","PROVIDER","NAME",1)=PXAERR(12)
-	K PXAERR,PXAERRF,PXADI,PXAA
-	Q
-NEWVAR	; new variables
-	N Y
-	N I,RMCHK,RMKI,RMSUB,RMARR,DIE,DA,DIC,RMAMIS,RMAMIS68,DIK,RMCNT,RMAMIEN
-	Q
+RMPRPCED ;Hines OIFO/RVD - Prosthetics/660/668/PCE DELETE ;7/30/02  09:39
+ ;;3.0;PROSTHETICS;**62,70,121,131**;Feb 09, 1996;Build 3
+ ;RVD 7/1/02 - patch #70 - new RMPR variables before calling PCE.
+ ;
+ ; This routine contains the code for deleting a Prosthetic visit in PCE.
+ ;
+ ;DBIA #1890  - this API is used to delete data from the VISIT file
+ ;              (9000010) and V files from PCE module.
+ ;DBIA #10048 - fileman read on file 9.4.
+ ;
+DEL(RMIE60) ;delete PCE visit.
+ D NEWVAR
+ S (RMLOCK,RMERR)=0
+ I '$P($G(^RMPR(660,RMIE60,10)),U,12) G DEL68
+ S RMSRC="PROSTHETICS DATA"
+ S X="PROSTHETICS",DIC="^DIC(9.4," D ^DIC
+ I '$D(Y)!(Y<0) S RMERR=-1 G DELX
+ S RMPKG=+Y
+ I 'RMPKG S RMERR=-1 G DELX
+ ;
+ ; get PCE IEn from file #660.
+ S RMPCE=$P($G(^RMPR(660,RMIE60,10)),U,12)
+ I 'RMPCE S RMERR=-1 G DELX
+ I '$D(^AUPNVSIT(RMPCE,0)) G DEL68
+ ;
+DELVF ; Remove all workload data from the PCE visit file & related V files.
+ ; check if the visit is already in PCE and remove workload,
+ ; (sending RMPKG and RMSRC to ensure that only data that originally
+ ; came from PROSTHETICS will be removed).
+ ;
+ N RMPR,REDO,VEJD
+ S REDO=0
+DELVF1 S RMCHK=$$DELVFILE^PXAPI("ALL",.RMPCE,RMPKG,RMSRC,0,0,"")
+ I RMCHK'=1 D  I REDO=1 G DELVF1
+ . Q:$P($G(^AUPNVSIT(RMPCE,0)),U,9)'=1!REDO
+ . S VEJD=$O(^VEJD(19610.5,"B",RMPCE,0)) Q:VEJD=""
+ . ;kill remaining dependent (DSS) to visit
+ . S DA=VEJD,DIK="^VEJD(19610.5," D ^DIK
+ . K DA,DIK
+ . I $P(^AUPNVSIT(RMPCE,0),U,9)=0 S REDO=1
+ I RMCHK'=1 W !!,"*** Error in deleting PCE visit !!",! S RMERR=-1 G DELX
+ ;
+DEL68 ; delete PCE info in file #668.
+ S RMAMIS=$G(^RMPR(660,RMIE60,"AMS"))
+ S RMIE68=$O(^RMPR(668,"F",RMIE60,0)) G:RMIE68="" DEL60
+ L +^RMPR(668,RMIE68):3 I $T=0 D ERR68 G DELX
+ S DA=$O(^RMPR(668,RMIE68,10,"B",RMIE60,0))
+ S DA(1)=RMIE68,DIK="^RMPR(668,"_DA(1)_",10," D ^DIK
+ S RMAMIEN=$O(^RMPR(668,RMIE68,11,"B",RMAMIS,0))
+ S RMCNT=0
+ F I=0:0 S I=$O(^RMPR(668,RMIE68,10,"B",I)) Q:I'>0  D
+ .S RMAMIS68=$G(^RMPR(660,I,"AMS")) S:RMAMIS68=RMAMIS RMCNT=RMCNT+1
+ ;if no other line item of the same GROUPER #, then delete.
+ I RMCNT=1 D
+ .S DA=RMAMIEN
+ .S DA(1)=RMIE68,DIK="^RMPR(668,"_DA(1)_",11,"
+ .D ^DIK
+ L -^RMPR(668,RMIE68)
+ ;
+DEL60 ; delete PCE info in file #660.
+ ; lock file #660
+ L +^RMPR(660,RMIE60,10):3 I $T=0 D ERR60 G DELX
+ S RMARR(660,RMIE60_",",8.12)="@"
+ S RMARR(660,RMIE60_",",8.13)="@"
+ D FILE^DIE("","RMARR","")
+ L -^RMPR(660,RMIE60,10)
+ ;
+ ; exit delete
+DELX Q RMERR
+ ;
+ERR68 ; print error if unable to delete/update file #668.
+ W !!,"*** File #668 is locked, IEN = ",RMIE68,", PLEASE contact your IRM!!",!!
+ L -^RMPR(668,RMIE68)
+ S RMERR=-1
+ Q
+ERR60 ; print error if unable to delete/update file #660.
+ W !!,"*** File #660 is locked, IEN = ",RMIE60,", PLEASE contact your IRM!!",!!
+ S RMERR=-1
+ Q
+ ;
+CHECK ;check for return error from PCE
+ ;input variable RMPROB
+ I $D(RMPROB($J,1))!$D(RMPROB($J,2)) D
+ .S (R2,R3,RMMESS)=""
+ .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
+ ..F R4=0:0 S R4=$O(RMPROB($J,R1,"ERROR1",R2,R3,R4)) Q:R4'>0  D
+ ...S RMMESS=RMPROB($J,R1,"ERROR1",R2,R3,R4)
+ ...W:RMMESS'="" !,"???? ",RMMESS
+ ...I (RMMESS["CPT")!(RMMESS["Provider") S RMPRCPER=1
+ Q
+ ;
+PRV ;PROVIDER VALIDATION PRIOR TO PCE INTERFACE CALL
+ K PXAA,PXADI,PXAERR N PXAVDATE,PXAERRF
+ S PXAA("NAME")=^TMP("RMPRPCE1",$J,"PXAPI","PROVIDER",1,"NAME"),PXAVDATE=$P(^TMP("RMPRPCE1",$J,"PXAPI","ENCOUNTER",1,"ENC D/T"),".")
+ ;CHECKER
+ ;----Missing a pointer to providers name
+ I $G(PXAA("NAME"))']"" D  G PRVX:$G(STOP)
+ .S STOP=1 ;--USED TO STOP DO LOOP
+ .S PXAERRF=1 ;--FLAG INDICATES THERE IS AN ERR
+ .S PXADI("DIALOG")=8390001.001
+ .S PXAERR(9)="NAME"
+ .S PXAERR(11)=$G(PXAA("NAME"))
+ .S PXAERR(12)="You are missing a pointer to the NEW PERSON file #200 that represents the Provider's name"
+ ;
+ ;----Not a pointer to NEW PERSON file#200
+ I $G(PXAA("NAME"))'["@" D 01^PXAIUPRV($G(PXAA("NAME"))) I $G(PXAIVAL)=1 K PXAIVAL,PXCA("ERROR") D  G PRVX:$G(STOP)
+ .S STOP=1
+ .S PXAERRF=1
+ .S PXADI("DIALOG")=8390001.001
+ .S PXAERR(9)="NAME"
+ .S PXAERR(11)=$G(PXAA("NAME"))
+ .S PXAERR(12)=PXAERR(11)_" is NOT a pointer value to the NEW PERSON file #200 for Provider"
+ ;
+ ;----Not have an active person class
+ N CLASS
+ S CLASS=+$$GET^XUA4A72($G(PXAA("NAME")),PXAVDATE) I CLASS<0 D
+ .S STOP=1
+ .S PXAERRF=1
+ .S PXADI("DIALOG")=8390001.001
+ .S PXAERR(9)="NAME"
+ .S PXAERR(11)=$G(PXAA("NAME"))
+ .S PXAERR(12)="The Provider does not have an ACTIVE person class!"
+PRVX I STOP D
+ . S RMERR=0 K RMPCE
+ . S RMPROB($J,2,"ERROR1","PROVIDER","NAME",1)=PXAERR(12)
+ K PXAERR,PXAERRF,PXADI,PXAA
+ Q
+NEWVAR ; new variables
+ N Y
+ N I,RMCHK,RMKI,RMSUB,RMARR,DIE,DA,DIC,RMAMIS,RMAMIS68,DIK,RMCNT,RMAMIEN
+ Q
