- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPCED.m
r613 r623 1 RMPRPCED 2 ;;3.0;PROSTHETICS;**62,70,121,131,141**;Feb 09, 1996;Build 5 3 4 5 6 7 8 9 10 11 DEL(RMIE60) 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 DELVF 27 28 29 30 31 32 33 DELVF1 34 35 36 37 38 39 40 41 42 43 DEL68 44 45 46 47 48 49 50 51 52 53 54 I RMCNT=1,RMAMIEND55 56 57 58 59 60 DEL60 61 62 63 64 65 66 67 68 69 DELX 70 71 ERR68 72 73 74 75 76 ERR60 77 78 79 80 81 CHECK 82 83 84 85 86 87 88 89 90 91 92 PRV 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 PRVX 124 125 126 127 128 NEWVAR 129 130 131 1 RMPRPCED ;Hines OIFO/RVD - Prosthetics/660/668/PCE DELETE ;7/30/02 09:39 2 ;;3.0;PROSTHETICS;**62,70,121,131**;Feb 09, 1996;Build 3 3 ;RVD 7/1/02 - patch #70 - new RMPR variables before calling PCE. 4 ; 5 ; This routine contains the code for deleting a Prosthetic visit in PCE. 6 ; 7 ;DBIA #1890 - this API is used to delete data from the VISIT file 8 ; (9000010) and V files from PCE module. 9 ;DBIA #10048 - fileman read on file 9.4. 10 ; 11 DEL(RMIE60) ;delete PCE visit. 12 D NEWVAR 13 S (RMLOCK,RMERR)=0 14 I '$P($G(^RMPR(660,RMIE60,10)),U,12) G DEL68 15 S RMSRC="PROSTHETICS DATA" 16 S X="PROSTHETICS",DIC="^DIC(9.4," D ^DIC 17 I '$D(Y)!(Y<0) S RMERR=-1 G DELX 18 S RMPKG=+Y 19 I 'RMPKG S RMERR=-1 G DELX 20 ; 21 ; get PCE IEn from file #660. 22 S RMPCE=$P($G(^RMPR(660,RMIE60,10)),U,12) 23 I 'RMPCE S RMERR=-1 G DELX 24 I '$D(^AUPNVSIT(RMPCE,0)) G DEL68 25 ; 26 DELVF ; Remove all workload data from the PCE visit file & related V files. 27 ; check if the visit is already in PCE and remove workload, 28 ; (sending RMPKG and RMSRC to ensure that only data that originally 29 ; came from PROSTHETICS will be removed). 30 ; 31 N RMPR,REDO,VEJD 32 S REDO=0 33 DELVF1 S RMCHK=$$DELVFILE^PXAPI("ALL",.RMPCE,RMPKG,RMSRC,0,0,"") 34 I RMCHK'=1 D I REDO=1 G DELVF1 35 . Q:$P($G(^AUPNVSIT(RMPCE,0)),U,9)'=1!REDO 36 . S VEJD=$O(^VEJD(19610.5,"B",RMPCE,0)) Q:VEJD="" 37 . ;kill remaining dependent (DSS) to visit 38 . S DA=VEJD,DIK="^VEJD(19610.5," D ^DIK 39 . K DA,DIK 40 . I $P(^AUPNVSIT(RMPCE,0),U,9)=0 S REDO=1 41 I RMCHK'=1 W !!,"*** Error in deleting PCE visit !!",! S RMERR=-1 G DELX 42 ; 43 DEL68 ; delete PCE info in file #668. 44 S RMAMIS=$G(^RMPR(660,RMIE60,"AMS")) 45 S RMIE68=$O(^RMPR(668,"F",RMIE60,0)) G:RMIE68="" DEL60 46 L +^RMPR(668,RMIE68):3 I $T=0 D ERR68 G DELX 47 S DA=$O(^RMPR(668,RMIE68,10,"B",RMIE60,0)) 48 S DA(1)=RMIE68,DIK="^RMPR(668,"_DA(1)_",10," D ^DIK 49 S RMAMIEN=$O(^RMPR(668,RMIE68,11,"B",RMAMIS,0)) 50 S RMCNT=0 51 F I=0:0 S I=$O(^RMPR(668,RMIE68,10,"B",I)) Q:I'>0 D 52 .S RMAMIS68=$G(^RMPR(660,I,"AMS")) S:RMAMIS68=RMAMIS RMCNT=RMCNT+1 53 ;if no other line item of the same GROUPER #, then delete. 54 I RMCNT=1 D 55 .S DA=RMAMIEN 56 .S DA(1)=RMIE68,DIK="^RMPR(668,"_DA(1)_",11," 57 .D ^DIK 58 L -^RMPR(668,RMIE68) 59 ; 60 DEL60 ; delete PCE info in file #660. 61 ; lock file #660 62 L +^RMPR(660,RMIE60,10):3 I $T=0 D ERR60 G DELX 63 S RMARR(660,RMIE60_",",8.12)="@" 64 S RMARR(660,RMIE60_",",8.13)="@" 65 D FILE^DIE("","RMARR","") 66 L -^RMPR(660,RMIE60,10) 67 ; 68 ; exit delete 69 DELX Q RMERR 70 ; 71 ERR68 ; print error if unable to delete/update file #668. 72 W !!,"*** File #668 is locked, IEN = ",RMIE68,", PLEASE contact your IRM!!",!! 73 L -^RMPR(668,RMIE68) 74 S RMERR=-1 75 Q 76 ERR60 ; print error if unable to delete/update file #660. 77 W !!,"*** File #660 is locked, IEN = ",RMIE60,", PLEASE contact your IRM!!",!! 78 S RMERR=-1 79 Q 80 ; 81 CHECK ;check for return error from PCE 82 ;input variable RMPROB 83 I $D(RMPROB($J,1))!$D(RMPROB($J,2)) D 84 .S (R2,R3,RMMESS)="" 85 .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 86 ..F R4=0:0 S R4=$O(RMPROB($J,R1,"ERROR1",R2,R3,R4)) Q:R4'>0 D 87 ...S RMMESS=RMPROB($J,R1,"ERROR1",R2,R3,R4) 88 ...W:RMMESS'="" !,"???? ",RMMESS 89 ...I (RMMESS["CPT")!(RMMESS["Provider") S RMPRCPER=1 90 Q 91 ; 92 PRV ;PROVIDER VALIDATION PRIOR TO PCE INTERFACE CALL 93 K PXAA,PXADI,PXAERR N PXAVDATE,PXAERRF 94 S PXAA("NAME")=^TMP("RMPRPCE1",$J,"PXAPI","PROVIDER",1,"NAME"),PXAVDATE=$P(^TMP("RMPRPCE1",$J,"PXAPI","ENCOUNTER",1,"ENC D/T"),".") 95 ;CHECKER 96 ;----Missing a pointer to providers name 97 I $G(PXAA("NAME"))']"" D G PRVX:$G(STOP) 98 .S STOP=1 ;--USED TO STOP DO LOOP 99 .S PXAERRF=1 ;--FLAG INDICATES THERE IS AN ERR 100 .S PXADI("DIALOG")=8390001.001 101 .S PXAERR(9)="NAME" 102 .S PXAERR(11)=$G(PXAA("NAME")) 103 .S PXAERR(12)="You are missing a pointer to the NEW PERSON file #200 that represents the Provider's name" 104 ; 105 ;----Not a pointer to NEW PERSON file#200 106 I $G(PXAA("NAME"))'["@" D 01^PXAIUPRV($G(PXAA("NAME"))) I $G(PXAIVAL)=1 K PXAIVAL,PXCA("ERROR") D G PRVX:$G(STOP) 107 .S STOP=1 108 .S PXAERRF=1 109 .S PXADI("DIALOG")=8390001.001 110 .S PXAERR(9)="NAME" 111 .S PXAERR(11)=$G(PXAA("NAME")) 112 .S PXAERR(12)=PXAERR(11)_" is NOT a pointer value to the NEW PERSON file #200 for Provider" 113 ; 114 ;----Not have an active person class 115 N CLASS 116 S CLASS=+$$GET^XUA4A72($G(PXAA("NAME")),PXAVDATE) I CLASS<0 D 117 .S STOP=1 118 .S PXAERRF=1 119 .S PXADI("DIALOG")=8390001.001 120 .S PXAERR(9)="NAME" 121 .S PXAERR(11)=$G(PXAA("NAME")) 122 .S PXAERR(12)="The Provider does not have an ACTIVE person class!" 123 PRVX I STOP D 124 . S RMERR=0 K RMPCE 125 . S RMPROB($J,2,"ERROR1","PROVIDER","NAME",1)=PXAERR(12) 126 K PXAERR,PXAERRF,PXADI,PXAA 127 Q 128 NEWVAR ; new variables 129 N Y 130 N I,RMCHK,RMKI,RMSUB,RMARR,DIE,DA,DIC,RMAMIS,RMAMIS68,DIK,RMCNT,RMAMIEN 131 Q
Note:
See TracChangeset
for help on using the changeset viewer.
