Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RMPRPIX1

RMPRPIX1.m

Go to the documentation of this file.
  1. RMPRPIX1 ;HINCIO/ODJ - PIP HCPCS ITEM FILE 661.11 APIs ;3/8/01
  1. ;;3.0;PROSTHETICS;**61,201**;Feb 09, 1996;Build 4
  1. Q
  1. ;
  1. ;***** IEN - get the ien for a HCPCS item
  1. ;
  1. ; Inputs:
  1. ; RMPR("STATION") - Station ien
  1. ; RMPR("HCPCS") - HCPCS code
  1. ; RMPR("ITEM") - HCPCS Item
  1. ;
  1. ; Outputs:
  1. ; RMPR("IEN") - ien for HCPCS Item rec.
  1. ; RMPRERR - exit code returned by function
  1. ; 0 - no problems
  1. ; 1,2,3 - null inputs
  1. IEN(RMPR) ;
  1. N RMPRIEN,RMPRERR
  1. S RMPRERR=0
  1. I $G(RMPR("STATION"))="" S RMPRERR=1 G IENX
  1. I $G(RMPR("HCPCS"))="" S RMPRERR=2 G IENX
  1. I $G(RMPR("ITEM"))="" S RMPRERR=3 G IENX
  1. S RMPRIEN=$O(^RMPR(661.11,"ASHI",RMPR("STATION"),RMPR("HCPCS"),RMPR("ITEM"),""))
  1. S RMPR("IEN")=RMPRIEN
  1. IENX Q RMPRERR
  1. ;
  1. ;***** CRE - Create a new HCPCS Item (661.11) record
  1. ;
  1. ; Inputs
  1. CRE(RMPR) ;
  1. N RMPRCRE,RMPRFDA,RMPRFME,RMPRIEN,X,Y,DA
  1. S RMPRCRE=0
  1. L +^RMPR(661.11)
  1. ;
  1. ; Get new seq. number for Item
  1. I $G(RMPR("ITEM"))="" D
  1. . S RMPR("ITEM")=1+$O(^RMPR(661.11,"ASHI",RMPR("STATION"),RMPR("HCPCS"),""),-1)
  1. . Q
  1. ;
  1. ; Update 661.11
  1. S RMPRFDA(661.11,"+1,",.01)=RMPR("HCPCS")
  1. S RMPRFDA(661.11,"+1,",1)=RMPR("ITEM")
  1. S RMPRFDA(661.11,"+1,",2)=RMPR("DESCRIPTION")
  1. S RMPRFDA(661.11,"+1,",3)=RMPR("STATION")
  1. S RMPRFDA(661.11,"+1,",4)=RMPR("SOURCE")
  1. S RMPRFDA(661.11,"+1,",5)=$G(RMPR("UNIT"))
  1. S RMPRFDA(661.11,"+1,",6)=RMPR("HCPCS")_"-"_RMPR("ITEM")
  1. S RMPRFDA(661.11,"+1,",7)=RMPR("ITEM MASTER IEN")
  1. D UPDATE^DIE("","RMPRFDA","RMPRIEN","RMPRFME")
  1. L -^RMPR(661.11)
  1. I $D(RMPRFME) S RMPRCRE=1 G CREX
  1. S RMPR("IEN")=RMPRIEN(1)
  1. ;
  1. ; Update Inventory Flag
  1. ; RMPR*3.0*201 Removes Inventory Flag update
  1. K RMPRFDA,RMPRFME
  1. ;S RMPRIEN=$O(^RMPR(661.1,"B",RMPR("HCPCS"),""))_","
  1. ;S RMPRFDA(661.1,RMPRIEN,10)=1
  1. ;D FILE^DIE("","RMPRFDA","RMPRFME")
  1. CREX Q RMPRCRE
  1. ;
  1. ;***** UPD - Update HCPCS Item record (661.11)
  1. UPD(RMPR11) ;
  1. N RMPRFDA,RMPRFME,X,Y,DA,RMPRIEN,RMPRERR
  1. S RMPRERR=0
  1. S RMPRIEN=RMPR11("IEN")_","
  1. I $D(RMPR11("HCPCS")) D
  1. . S RMPRFDA(661.11,RMPRIEN,.01)=RMPR11("HCPCS")
  1. . Q
  1. I $D(RMPR11("ITEM")) D
  1. . S RMPRFDA(661.11,RMPRIEN,1)=RMPR11("ITEM")
  1. . Q
  1. S:$D(RMPR11("DESCRIPTION")) RMPRFDA(661.11,RMPRIEN,2)=RMPR11("DESCRIPTION")
  1. S:$D(RMPR11("SOURCE")) RMPRFDA(661.11,RMPRIEN,4)=RMPR11("SOURCE")
  1. S:$D(RMPR11("UNIT")) RMPRFDA(661.11,RMPRIEN,5)=RMPR11("UNIT")
  1. S:$D(RMPR11("HCPCS-ITEM")) RMPRFDA(661.11,RMPRIEN,6)=RMPR11("HCPCS-ITEM")
  1. S:$D(RMPR11("ITEM MASTER IEN")) RMPRFDA(661.11,RMPRIEN,7)=RMPR11("ITEM MASTER IEN")
  1. D:$D(RMPRFDA) FILE^DIE("","RMPRFDA","RMPRFME")
  1. I $D(RMPRFME) S RMPRERR=1 G UPDX
  1. UPDX Q RMPRERR
  1. ;
  1. ;***** DUP - Check that a HCPCS Item does not have a different
  1. ; source on the same code
  1. DUP(RMPR,RMPRDUP) ;
  1. N RMPRS,RMPRERR,RMPR1,RMPR1I
  1. S RMPRERR=0,RMPRDUP=0
  1. S RMPRERR=$$IEN(.RMPR) G:RMPRERR DUPX
  1. I RMPR("IEN")="" G DUPX
  1. S RMPR1("IEN")=RMPR("IEN")
  1. S RMPRERR=$$GET(.RMPR1) G:RMPRERR DUPX
  1. S RMPRERR=$$ETOI(.RMPR1,.RMPR1I) G:RMPRERR DUPX
  1. I RMPR1I("SOURCE")=RMPR("SOURCE") D
  1. . S RMPRDUP=0
  1. . Q
  1. E D
  1. . S RMPRDUP=1
  1. . Q
  1. DUPX Q RMPRERR
  1. ;
  1. ;***** GET - read HCPCS Item 661.11 record
  1. GET(RMPR) ;
  1. N RMPRCRE,RMPRFME,RMPROUP,RMPRIEN
  1. S RMPRCRE=0
  1. I $G(RMPR("IEN"))="" D
  1. . S RMPRCRE=$$IEN(.RMPR)
  1. . Q
  1. I RMPRCRE G GETX
  1. S RMPRIEN=RMPR("IEN")_","
  1. D GETS^DIQ(661.11,RMPRIEN,"*","","RMPROUP","RMPRFME")
  1. I $D(RMPRFME) S RMPRCRE=1 G GETX
  1. S RMPR("HCPCS")=RMPROUP(661.11,RMPRIEN,.01)
  1. S RMPR("ITEM")=RMPROUP(661.11,RMPRIEN,1)
  1. S RMPR("DESCRIPTION")=RMPROUP(661.11,RMPRIEN,2)
  1. S RMPR("STATION")=RMPROUP(661.11,RMPRIEN,3)
  1. S RMPR("SOURCE")=RMPROUP(661.11,RMPRIEN,4)
  1. S RMPR("UNIT")=RMPROUP(661.11,RMPRIEN,5)
  1. S RMPR("HCPCS-ITEM")=RMPROUP(661.11,RMPRIEN,6)
  1. S RMPR("ITEM MASTER")=RMPROUP(661.11,RMPRIEN,7)
  1. S RMPR("STATUS")=RMPROUP(661.11,RMPRIEN,8)
  1. GETX Q RMPRCRE
  1. ;
  1. ; Given HCPCS code get 1st active HCPCS record in 661.1 file
  1. ; If none are active then use 1st ien (should never occur)
  1. HPACT(RMPR) ;
  1. N RMPRCRE,RMPRFME,RMPROUP,RMPRIEN,RMPRE,RMPRI
  1. S RMPRCRE=0
  1. I $G(RMPR("HCPCS"))="" S RMPRCRE=1 G HPACTX
  1. S RMPRI=""
  1. F S RMPRI=$O(^RMPR(661.1,"B",RMPR("HCPCS"),RMPRI)) Q:RMPRI="" D Q:RMPRE("STATUS")="ACTIVE"
  1. . K RMPRE S RMPRE("IEN")=RMPRI
  1. . S RMPRCRE=$$HPGET(.RMPRE)
  1. . Q
  1. I $G(RMPRE("IEN"))'="" M RMPR=RMPRE
  1. HPACTX Q RMPRCRE
  1. ;
  1. ;***** HPGET - Get a HCPCS record
  1. HPGET(RMPR) ;
  1. N RMPRCRE,RMPRFME,RMPROUP,RMPRIEN
  1. S RMPRCRE=0
  1. I $G(RMPR("IEN"))="" S RMPRCRE=1 G HPGETX
  1. S RMPRIEN=RMPR("IEN")_","
  1. D GETS^DIQ(661.1,RMPRIEN,"*","","RMPROUP","RMPRFME")
  1. I $D(RMPRFME) S RMPRCRE=2 G HPGETX
  1. S RMPR("HCPCS")=RMPROUP(661.1,RMPRIEN,.01)
  1. S RMPR("SHORT DESC")=RMPROUP(661.1,RMPRIEN,.02)
  1. S RMPR("NEW HCPC IEN")=RMPROUP(661.1,RMPRIEN,1)
  1. S RMPR("CPT CODE")=RMPROUP(661.1,RMPRIEN,2)
  1. S RMPR("STATUS")=RMPROUP(661.1,RMPRIEN,3)
  1. S RMPR("NPPD REPAIR CODE")=RMPROUP(661.1,RMPRIEN,5)
  1. S RMPR("NPPD NEW CODE")=RMPROUP(661.1,RMPRIEN,6)
  1. S RMPR("CALC FLAG")=RMPROUP(661.1,RMPRIEN,9)
  1. S RMPR("INV FLAG")=RMPROUP(661.1,RMPRIEN,10)
  1. S RMPR("LAB TIME")=RMPROUP(661.1,RMPRIEN,11)
  1. HPGETX Q RMPRCRE
  1. ;
  1. ;***** HPETOI - Convert external to internal form for HCPCS rec.
  1. HPETOI(RMPRE,RMPRI) ;
  1. N RMPRFDA,RMPRIEN,RMPRFDI,RMPRFME,RMPRERR
  1. S RMPRERR=0
  1. S RMPRIEN=RMPRE("IEN")_","
  1. D GETS^DIQ(661.1,RMPRIEN,"*","I","RMPRFDI","RMPRFME")
  1. I $D(RMPRFME) S RMPRERR=1 G HPETOIX
  1. S RMPRI("IEN")=RMPRE("IEN")
  1. S RMPRI("NEW HCPC IEN")=RMPRFDI(661.1,RMPRIEN,1,"I")
  1. S RMPRI("CPT CODE")=RMPRFDI(661.1,RMPRIEN,2,"I")
  1. S RMPRI("STATUS")=RMPRFDI(661.1,RMPRIEN,3,"I")
  1. S RMPRI("NPPD REPAIR CODE")=RMPRFDI(661.1,RMPRIEN,5,"I")
  1. S RMPRI("NPPD NEW CODE")=RMPRFDI(661.1,RMPRIEN,6,"I")
  1. S RMPRI("CALC FLAG")=RMPRFDI(661.1,RMPRIEN,9,"I")
  1. S RMPRI("INV FLAG")=RMPRFDI(661.1,RMPRIEN,10,"I")
  1. S RMPRI("LAB TIME")=RMPRFDI(661.1,RMPRIEN,11,"I")
  1. HPETOIX Q RMPRERR
  1. ;
  1. ;***** ETOI - Convert external to internal form
  1. ETOI(RMPRE,RMPRI) ;
  1. N RMPRFDA,RMPRIEN,RMPRFDI,RMPRFME,RMPRERR
  1. S RMPRERR=0
  1. S RMPRIEN=RMPRE("IEN")_","
  1. D GETS^DIQ(661.11,RMPRIEN,"*","I","RMPRFDI","RMPRFME")
  1. I $D(RMPRFME) S RMPRERR=1 G ETOIX
  1. S RMPRI("IEN")=RMPRE("IEN")
  1. S RMPRI("HCPCS")=RMPRFDI(661.11,RMPRIEN,.01,"I")
  1. S RMPRI("ITEM")=RMPRFDI(661.11,RMPRIEN,1,"I")
  1. S RMPRI("DESCRIPTION")=RMPRFDI(661.11,RMPRIEN,2,"I")
  1. S RMPRI("STATION")=RMPRFDI(661.11,RMPRIEN,3,"I")
  1. S RMPRI("SOURCE")=RMPRFDI(661.11,RMPRIEN,4,"I")
  1. S RMPRI("UNIT")=RMPRFDI(661.11,RMPRIEN,5,"I")
  1. S RMPRI("ITEM MASTER IEN")=RMPRFDI(661.11,RMPRIEN,7,"I")
  1. ETOIX Q RMPRERR