Changeset 623 for WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR29BG.m

Timestamp:

Dec 4, 2009, 12:11:15 AM (14 years ago)

Author:

George Lilly

Message:

revised back to 6/30/08 version

File:

• WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR29BG.m (modified) (1 diff)

WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR29BG.m

@@ -1 @@
-RMPR29BG        ;OI-HINES/SPS -OWL BASE HCPCS ENTER/EDIT/DELETE RPC;12/27/2004
-        ;;3.0;PROSTHETICS;**75,142**;Feb 09, 1996;Build 2
-A1(RMAED,RMPRSITE,RMIE1,RMIE16,RMITM,RMQTY,RMUI,RMTT,RMPC,RMSN,RMHCPC,RMCPTM,RMVEN)     ;roll and scroll entry point
-        G A2
-EN(RESULTS,RMAED,RMPRSITE,RMIE1,RMIE16,RMITM,RMQTY,RMUI,RMTT,RMPC,RMSN,RMHCPC,RMCPTM,RMVEN,RMBD,RMHTECH,RMPRTXT)        ;RPC entry point
-A2      ;
-        N J,L,RESULTS,RMIE16C,RMIE16F,R6641,RSITE
-        S RESULTS(0)=""
-        K ^TMP($J)
-        ; If no Tech assigned then self assign here
-        I +$P(^RMPR(664.1,RMIE1,0),U,16)'>0 S $P(^(0),U,16)=DUZ,$P(^(0),U,17)="A",$P(^(7),U,1)=DT,$P(^(7),U,3)=DUZ
-        ;
-        I RMAED="D" G DEL
-        ;
-        S RMERR=0
-        S ^TMP("SPS",0)=RMAED_U_RMPRSITE_U_RMIE1_U_RMIE16_U_RMITM_U_RMQTY_U_RMUI_U_RMTT_U_RMPC_U_RMSN_U_RMHCPC_U_RMCPTM_U_RMVEN
-        S RMIE16F=$O(^RMPR(664.1,RMIE1,2,0))
-        S R6641=$G(^RMPR(664.1,RMIE1,0))
-        S RSITE=$P(R6641,U,15),RSITE=$O(^RMPR(669.9,"C",RSITE,0))
-        I RSITE'=RMPRSITE S RMPRSITE=RSITE
-        I RMIE16F>0 S:RMIE16'=RMIE16F RMTT=$P(^RMPR(664.1,RMIE1,2,RMIE16F,0),U,7),RMPC=$P(^(0),U,8)
-        I RMIE16=RMIE16F D:RMTT'=$P(^RMPR(664.1,RMIE1,2,RMIE16F,0),U,7)!(RMPC'=$P(^(0),U,8))
-        . S RMIE16C="" F  S RMIE16C=$O(^RMPR(664.1,RMIE1,2,RMIE16C)) Q:RMIE16C=""  D
-        .. Q:RMIE16C=RMIE16
-        .. Q:'$D(^RMPR(664.1,RMIE1,2,RMIE16C,0))
-        .. S $P(^RMPR(664.1,RMIE1,2,RMIE16C,0),U,7)=RMTT
-        .. S $P(^RMPR(664.1,RMIE1,2,RMIE16C,0),U,8)=RMPC
-        I RMIE16="" S RMIE16="+1,"_RMIE1
-        E  S RMIE16E=RMIE16,RMIE16=RMIE16_","_RMIE1
-        S RMDAT(664.16,RMIE16_",",.01)=RMITM
-        S RMDAT(664.16,RMIE16_",",2)=RMQTY
-        S RMDAT(664.16,RMIE16_",",3)=RMUI
-        S RMDAT(664.16,RMIE16_",",6.5)=RMBD
-        S RMDAT(664.16,RMIE16_",",8)=RMTT
-        S RMDAT(664.16,RMIE16_",",9)=RMPC
-        S RMDAT(664.16,RMIE16_",",12)=RMSN
-        S RMDAT(664.16,RMIE16_",",13)=RMHCPC
-        S RMDAT(664.16,RMIE16_",",13.1)=RMCPTM
-        S RMDAT(664.16,RMIE16_",",13.2)=RMHTECH
-        S RMDAT(664.16,RMIE16_",",15)=RMVEN
-        D UPDATE^DIE("","RMDAT","RMIEN","RMERROR")
-        L -^RMPR(664.1,RMIE1)
-        I $D(RMERROR) S RMERR=1 G ERR
-        S J=""
-        F  S J=$O(RMPRTXT(J)) Q:J=""  D
-        . S L=J+1,RMPRTXTF(L)=RMPRTXT(J)
-        I '$D(RMIEN(1)) S RMIEN(1)=RMIE16E
-        D WP^DIE(664.16,RMIEN(1)_","_RMIE1_",",7,,"RMPRTXTF","RMWPERR")
-        I $D(RMWPERR) S ^TMP("SPS","WP")=RMWPERR("DIERR","1","TEXT","1")
-        ;
-        S RMPRDA=RMIE1 D INF^RMPRSIT,POST^RMPR29GA
-QUIT    K RMAED,RMBD,RMTECH,RMDAT,RMIE16E,RMIE2,RMPRDA,RMPRTXT,RMPRTXTF,RMERROR
-        K RMERR,RMAED,RMPRSITE,RMIE1,RMIE16,RMIEN,RMITM,RMQTY,RMUI,RMTT,RMPC
-        K RMSN,RMHCPC,RMCPTM,RMVEN,RMWPERR,RMHTK
-        Q
-ERR     S RESUTLS(0)=1_RMERROR("DIERR",1,"TEXT",1)
-        S ^TMP("SPS",1)=1_RMERROR("DIERR",1,"TEXT",1)
-        G QUIT
-        Q
-DEL     ;
-        S DA=$P(^RMPR(664.1,RMIE1,2,RMIE16,0),U,5)
-        I DA'="" D
-        . S DIK="^RMPR(660," D ^DIK
-        . K DA,DIK
-        S DA=$P(^RMPR(664.1,RMIE1,2,RMIE16,0),U,6)
-        I DA'="" D
-        . S DIK="^RMPR(664.2," D ^DIK
-        . K DA,DIK
-        S DA(1)=RMIE1,DA=RMIE16,DIK="^RMPR(664.1,"_DA(1)_",2," D ^DIK
-        K DA,DIK
-        S RMPRDA=RMIE1 D INF^RMPRSIT,POST^RMPR29GA
-        L -^RMPR(664.1,RMIE1)
-        G QUIT
-        Q
-EN1(RESULTS,DA) ;Broker entry to kill WO
-        ;DA is passed
-        S DIK="^RMPR(664.1," D ^DIK
-        K DIK
-        Q
+RMPR29BG ;OI-HINES/SPS -OWL BASE HCPCS ENTER/EDIT/DELETE RPC;12/27/2004
+ ;;3.0;PROSTHETICS;**75**;Feb 09, 1996;Build 25
+A1(RMAED,RMPRSITE,RMIE1,RMIE16,RMITM,RMQTY,RMUI,RMTT,RMPC,RMSN,RMHCPC,RMCPTM,RMVEN) ;roll and scroll entry point
+ G A2
+EN(RESULTS,RMAED,RMPRSITE,RMIE1,RMIE16,RMITM,RMQTY,RMUI,RMTT,RMPC,RMSN,RMHCPC,RMCPTM,RMVEN,RMBD,RMHTECH,RMPRTXT) ;RPC entry point
+A2 ;
+ N J,L,RESULTS,RMIE16C,RMIE16F
+ S RESULTS(0)=""
+ K ^TMP($J)
+ ; If no Tech assigned then self assign here
+ I +$P(^RMPR(664.1,RMIE1,0),U,16)'>0 S $P(^(0),U,16)=DUZ,$P(^(0),U,17)="A",$P(^(7),U,1)=DT,$P(^(7),U,3)=DUZ
+ ;
+ I RMAED="D" G DEL
+ ;
+ S RMERR=0
+ S ^TMP("SPS",0)=RMAED_U_RMPRSITE_U_RMIE1_U_RMIE16_U_RMITM_U_RMQTY_U_RMUI_U_RMTT_U_RMPC_U_RMSN_U_RMHCPC_U_RMCPTM_U_RMVEN
+ S RMIE16F=$O(^RMPR(664.1,RMIE1,2,0))
+ I RMIE16F>0 S:RMIE16'=RMIE16F RMTT=$P(^RMPR(664.1,RMIE1,2,RMIE16F,0),U,7),RMPC=$P(^(0),U,8)
+ I RMIE16=RMIE16F D:RMTT'=$P(^RMPR(664.1,RMIE1,2,RMIE16F,0),U,7)!(RMPC'=$P(^(0),U,8))
+ . S RMIE16C="" F  S RMIE16C=$O(^RMPR(664.1,RMIE1,2,RMIE16C)) Q:RMIE16C=""  D
+ .. Q:RMIE16C=RMIE16
+ .. Q:'$D(^RMPR(664.1,RMIE1,2,RMIE16C,0))
+ .. S $P(^RMPR(664.1,RMIE1,2,RMIE16C,0),U,7)=RMTT
+ .. S $P(^RMPR(664.1,RMIE1,2,RMIE16C,0),U,8)=RMPC
+ I RMIE16="" S RMIE16="+1,"_RMIE1
+ E  S RMIE16E=RMIE16,RMIE16=RMIE16_","_RMIE1
+ S RMDAT(664.16,RMIE16_",",.01)=RMITM
+ S RMDAT(664.16,RMIE16_",",2)=RMQTY
+ S RMDAT(664.16,RMIE16_",",3)=RMUI
+ S RMDAT(664.16,RMIE16_",",6.5)=RMBD
+ S RMDAT(664.16,RMIE16_",",8)=RMTT
+ S RMDAT(664.16,RMIE16_",",9)=RMPC
+ S RMDAT(664.16,RMIE16_",",12)=RMSN
+ S RMDAT(664.16,RMIE16_",",13)=RMHCPC
+ S RMDAT(664.16,RMIE16_",",13.1)=RMCPTM
+ S RMDAT(664.16,RMIE16_",",13.2)=RMHTECH
+ S RMDAT(664.16,RMIE16_",",15)=RMVEN
+ D UPDATE^DIE("","RMDAT","RMIEN","RMERROR")
+ L -^RMPR(664.1,RMIE1)
+ I $D(RMERROR) S RMERR=1 G ERR
+ S J=""
+ F  S J=$O(RMPRTXT(J)) Q:J=""  D
+ . S L=J+1,RMPRTXTF(L)=RMPRTXT(J)
+ I '$D(RMIEN(1)) S RMIEN(1)=RMIE16E
+ D WP^DIE(664.16,RMIEN(1)_","_RMIE1_",",7,,"RMPRTXTF","RMWPERR")
+ I $D(RMWPERR) S ^TMP("SPS","WP")=RMWPERR("DIERR","1","TEXT","1")
+ ;
+ S RMPRDA=RMIE1 D INF^RMPRSIT,POST^RMPR29GA
+QUIT K RMAED,RMBD,RMTECH,RMDAT,RMIE16E,RMIE2,RMPRDA,RMPRTXT,RMPRTXTF,RMERROR
+ K RMERR,RMAED,RMPRSITE,RMIE1,RMIE16,RMIEN,RMITM,RMQTY,RMUI,RMTT,RMPC
+ K RMSN,RMHCPC,RMCPTM,RMVEN,RMWPERR,RMHTK
+ Q
+ERR S RESUTLS(0)=1_RMERROR("DIERR",1,"TEXT",1)
+ S ^TMP("SPS",1)=1_RMERROR("DIERR",1,"TEXT",1)
+ G QUIT
+ Q
+DEL ;
+ S DA=$P(^RMPR(664.1,RMIE1,2,RMIE16,0),U,5)
+ S DIK="^RMPR(660," D ^DIK
+ K DA,DIK
+ S DA=$P(^RMPR(664.1,RMIE1,2,RMIE16,0),U,6)
+ S DIK="^RMPR(664.2," D ^DIK
+ K DA,DIK
+ S DA(1)=RMIE1,DA=RMIE16,DIK="^RMPR(664.1,"_DA(1)_",2," D ^DIK
+ K DA,DIK
+ S RMPRDA=RMIE1 D INF^RMPRSIT,POST^RMPR29GA
+ L -^RMPR(664.1,RMIE1)
+ G QUIT
+ Q
+EN1(RESULTS,DA) ;Broker entry to kill WO
+ ;DA is passed
+ S DIK="^RMPR(664.1," D ^DIK
+ K DIK
+ Q