- RMPRPIX1 ;HINCIO/ODJ - PIP HCPCS ITEM FILE 661.11 APIs ;3/8/01
- ;;3.0;PROSTHETICS;**61,201**;Feb 09, 1996;Build 4
- Q
- ;
- ;***** IEN - get the ien for a HCPCS item
- ;
- ; Inputs:
- ; RMPR("STATION") - Station ien
- ; RMPR("HCPCS") - HCPCS code
- ; RMPR("ITEM") - HCPCS Item
- ;
- ; Outputs:
- ; RMPR("IEN") - ien for HCPCS Item rec.
- ; RMPRERR - exit code returned by function
- ; 0 - no problems
- ; 1,2,3 - null inputs
- IEN(RMPR) ;
- N RMPRIEN,RMPRERR
- S RMPRERR=0
- I $G(RMPR("STATION"))="" S RMPRERR=1 G IENX
- I $G(RMPR("HCPCS"))="" S RMPRERR=2 G IENX
- I $G(RMPR("ITEM"))="" S RMPRERR=3 G IENX
- S RMPRIEN=$O(^RMPR(661.11,"ASHI",RMPR("STATION"),RMPR("HCPCS"),RMPR("ITEM"),""))
- S RMPR("IEN")=RMPRIEN
- IENX Q RMPRERR
- ;
- ;***** CRE - Create a new HCPCS Item (661.11) record
- ;
- ; Inputs
- CRE(RMPR) ;
- N RMPRCRE,RMPRFDA,RMPRFME,RMPRIEN,X,Y,DA
- S RMPRCRE=0
- L +^RMPR(661.11)
- ;
- ; Get new seq. number for Item
- I $G(RMPR("ITEM"))="" D
- . S RMPR("ITEM")=1+$O(^RMPR(661.11,"ASHI",RMPR("STATION"),RMPR("HCPCS"),""),-1)
- . Q
- ;
- ; Update 661.11
- S RMPRFDA(661.11,"+1,",.01)=RMPR("HCPCS")
- S RMPRFDA(661.11,"+1,",1)=RMPR("ITEM")
- S RMPRFDA(661.11,"+1,",2)=RMPR("DESCRIPTION")
- S RMPRFDA(661.11,"+1,",3)=RMPR("STATION")
- S RMPRFDA(661.11,"+1,",4)=RMPR("SOURCE")
- S RMPRFDA(661.11,"+1,",5)=$G(RMPR("UNIT"))
- S RMPRFDA(661.11,"+1,",6)=RMPR("HCPCS")_"-"_RMPR("ITEM")
- S RMPRFDA(661.11,"+1,",7)=RMPR("ITEM MASTER IEN")
- D UPDATE^DIE("","RMPRFDA","RMPRIEN","RMPRFME")
- L -^RMPR(661.11)
- I $D(RMPRFME) S RMPRCRE=1 G CREX
- S RMPR("IEN")=RMPRIEN(1)
- ;
- ; Update Inventory Flag
- ; RMPR*3.0*201 Removes Inventory Flag update
- K RMPRFDA,RMPRFME
- ;S RMPRIEN=$O(^RMPR(661.1,"B",RMPR("HCPCS"),""))_","
- ;S RMPRFDA(661.1,RMPRIEN,10)=1
- ;D FILE^DIE("","RMPRFDA","RMPRFME")
- CREX Q RMPRCRE
- ;
- ;***** UPD - Update HCPCS Item record (661.11)
- UPD(RMPR11) ;
- N RMPRFDA,RMPRFME,X,Y,DA,RMPRIEN,RMPRERR
- S RMPRERR=0
- S RMPRIEN=RMPR11("IEN")_","
- I $D(RMPR11("HCPCS")) D
- . S RMPRFDA(661.11,RMPRIEN,.01)=RMPR11("HCPCS")
- . Q
- I $D(RMPR11("ITEM")) D
- . S RMPRFDA(661.11,RMPRIEN,1)=RMPR11("ITEM")
- . Q
- S:$D(RMPR11("DESCRIPTION")) RMPRFDA(661.11,RMPRIEN,2)=RMPR11("DESCRIPTION")
- S:$D(RMPR11("SOURCE")) RMPRFDA(661.11,RMPRIEN,4)=RMPR11("SOURCE")
- S:$D(RMPR11("UNIT")) RMPRFDA(661.11,RMPRIEN,5)=RMPR11("UNIT")
- S:$D(RMPR11("HCPCS-ITEM")) RMPRFDA(661.11,RMPRIEN,6)=RMPR11("HCPCS-ITEM")
- S:$D(RMPR11("ITEM MASTER IEN")) RMPRFDA(661.11,RMPRIEN,7)=RMPR11("ITEM MASTER IEN")
- D:$D(RMPRFDA) FILE^DIE("","RMPRFDA","RMPRFME")
- I $D(RMPRFME) S RMPRERR=1 G UPDX
- UPDX Q RMPRERR
- ;
- ;***** DUP - Check that a HCPCS Item does not have a different
- ; source on the same code
- DUP(RMPR,RMPRDUP) ;
- N RMPRS,RMPRERR,RMPR1,RMPR1I
- S RMPRERR=0,RMPRDUP=0
- S RMPRERR=$$IEN(.RMPR) G:RMPRERR DUPX
- I RMPR("IEN")="" G DUPX
- S RMPR1("IEN")=RMPR("IEN")
- S RMPRERR=$$GET(.RMPR1) G:RMPRERR DUPX
- S RMPRERR=$$ETOI(.RMPR1,.RMPR1I) G:RMPRERR DUPX
- I RMPR1I("SOURCE")=RMPR("SOURCE") D
- . S RMPRDUP=0
- . Q
- E D
- . S RMPRDUP=1
- . Q
- DUPX Q RMPRERR
- ;
- ;***** GET - read HCPCS Item 661.11 record
- GET(RMPR) ;
- N RMPRCRE,RMPRFME,RMPROUP,RMPRIEN
- S RMPRCRE=0
- I $G(RMPR("IEN"))="" D
- . S RMPRCRE=$$IEN(.RMPR)
- . Q
- I RMPRCRE G GETX
- S RMPRIEN=RMPR("IEN")_","
- D GETS^DIQ(661.11,RMPRIEN,"*","","RMPROUP","RMPRFME")
- I $D(RMPRFME) S RMPRCRE=1 G GETX
- S RMPR("HCPCS")=RMPROUP(661.11,RMPRIEN,.01)
- S RMPR("ITEM")=RMPROUP(661.11,RMPRIEN,1)
- S RMPR("DESCRIPTION")=RMPROUP(661.11,RMPRIEN,2)
- S RMPR("STATION")=RMPROUP(661.11,RMPRIEN,3)
- S RMPR("SOURCE")=RMPROUP(661.11,RMPRIEN,4)
- S RMPR("UNIT")=RMPROUP(661.11,RMPRIEN,5)
- S RMPR("HCPCS-ITEM")=RMPROUP(661.11,RMPRIEN,6)
- S RMPR("ITEM MASTER")=RMPROUP(661.11,RMPRIEN,7)
- S RMPR("STATUS")=RMPROUP(661.11,RMPRIEN,8)
- GETX Q RMPRCRE
- ;
- ; Given HCPCS code get 1st active HCPCS record in 661.1 file
- ; If none are active then use 1st ien (should never occur)
- HPACT(RMPR) ;
- N RMPRCRE,RMPRFME,RMPROUP,RMPRIEN,RMPRE,RMPRI
- S RMPRCRE=0
- I $G(RMPR("HCPCS"))="" S RMPRCRE=1 G HPACTX
- S RMPRI=""
- F S RMPRI=$O(^RMPR(661.1,"B",RMPR("HCPCS"),RMPRI)) Q:RMPRI="" D Q:RMPRE("STATUS")="ACTIVE"
- . K RMPRE S RMPRE("IEN")=RMPRI
- . S RMPRCRE=$$HPGET(.RMPRE)
- . Q
- I $G(RMPRE("IEN"))'="" M RMPR=RMPRE
- HPACTX Q RMPRCRE
- ;
- ;***** HPGET - Get a HCPCS record
- HPGET(RMPR) ;
- N RMPRCRE,RMPRFME,RMPROUP,RMPRIEN
- S RMPRCRE=0
- I $G(RMPR("IEN"))="" S RMPRCRE=1 G HPGETX
- S RMPRIEN=RMPR("IEN")_","
- D GETS^DIQ(661.1,RMPRIEN,"*","","RMPROUP","RMPRFME")
- I $D(RMPRFME) S RMPRCRE=2 G HPGETX
- S RMPR("HCPCS")=RMPROUP(661.1,RMPRIEN,.01)
- S RMPR("SHORT DESC")=RMPROUP(661.1,RMPRIEN,.02)
- S RMPR("NEW HCPC IEN")=RMPROUP(661.1,RMPRIEN,1)
- S RMPR("CPT CODE")=RMPROUP(661.1,RMPRIEN,2)
- S RMPR("STATUS")=RMPROUP(661.1,RMPRIEN,3)
- S RMPR("NPPD REPAIR CODE")=RMPROUP(661.1,RMPRIEN,5)
- S RMPR("NPPD NEW CODE")=RMPROUP(661.1,RMPRIEN,6)
- S RMPR("CALC FLAG")=RMPROUP(661.1,RMPRIEN,9)
- S RMPR("INV FLAG")=RMPROUP(661.1,RMPRIEN,10)
- S RMPR("LAB TIME")=RMPROUP(661.1,RMPRIEN,11)
- HPGETX Q RMPRCRE
- ;
- ;***** HPETOI - Convert external to internal form for HCPCS rec.
- HPETOI(RMPRE,RMPRI) ;
- N RMPRFDA,RMPRIEN,RMPRFDI,RMPRFME,RMPRERR
- S RMPRERR=0
- S RMPRIEN=RMPRE("IEN")_","
- D GETS^DIQ(661.1,RMPRIEN,"*","I","RMPRFDI","RMPRFME")
- I $D(RMPRFME) S RMPRERR=1 G HPETOIX
- S RMPRI("IEN")=RMPRE("IEN")
- S RMPRI("NEW HCPC IEN")=RMPRFDI(661.1,RMPRIEN,1,"I")
- S RMPRI("CPT CODE")=RMPRFDI(661.1,RMPRIEN,2,"I")
- S RMPRI("STATUS")=RMPRFDI(661.1,RMPRIEN,3,"I")
- S RMPRI("NPPD REPAIR CODE")=RMPRFDI(661.1,RMPRIEN,5,"I")
- S RMPRI("NPPD NEW CODE")=RMPRFDI(661.1,RMPRIEN,6,"I")
- S RMPRI("CALC FLAG")=RMPRFDI(661.1,RMPRIEN,9,"I")
- S RMPRI("INV FLAG")=RMPRFDI(661.1,RMPRIEN,10,"I")
- S RMPRI("LAB TIME")=RMPRFDI(661.1,RMPRIEN,11,"I")
- HPETOIX Q RMPRERR
- ;
- ;***** ETOI - Convert external to internal form
- ETOI(RMPRE,RMPRI) ;
- N RMPRFDA,RMPRIEN,RMPRFDI,RMPRFME,RMPRERR
- S RMPRERR=0
- S RMPRIEN=RMPRE("IEN")_","
- D GETS^DIQ(661.11,RMPRIEN,"*","I","RMPRFDI","RMPRFME")
- I $D(RMPRFME) S RMPRERR=1 G ETOIX
- S RMPRI("IEN")=RMPRE("IEN")
- S RMPRI("HCPCS")=RMPRFDI(661.11,RMPRIEN,.01,"I")
- S RMPRI("ITEM")=RMPRFDI(661.11,RMPRIEN,1,"I")
- S RMPRI("DESCRIPTION")=RMPRFDI(661.11,RMPRIEN,2,"I")
- S RMPRI("STATION")=RMPRFDI(661.11,RMPRIEN,3,"I")
- S RMPRI("SOURCE")=RMPRFDI(661.11,RMPRIEN,4,"I")
- S RMPRI("UNIT")=RMPRFDI(661.11,RMPRIEN,5,"I")
- S RMPRI("ITEM MASTER IEN")=RMPRFDI(661.11,RMPRIEN,7,"I")
- ETOIX Q RMPRERR
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPIX1 6541 printed Feb 19, 2025@00:03 Page 2
- RMPRPIX1 ;HINCIO/ODJ - PIP HCPCS ITEM FILE 661.11 APIs ;3/8/01
- +1 ;;3.0;PROSTHETICS;**61,201**;Feb 09, 1996;Build 4
- +2 QUIT
- +3 ;
- +4 ;***** IEN - get the ien for a HCPCS item
- +5 ;
- +6 ; Inputs:
- +7 ; RMPR("STATION") - Station ien
- +8 ; RMPR("HCPCS") - HCPCS code
- +9 ; RMPR("ITEM") - HCPCS Item
- +10 ;
- +11 ; Outputs:
- +12 ; RMPR("IEN") - ien for HCPCS Item rec.
- +13 ; RMPRERR - exit code returned by function
- +14 ; 0 - no problems
- +15 ; 1,2,3 - null inputs
- IEN(RMPR) ;
- +1 NEW RMPRIEN,RMPRERR
- +2 SET RMPRERR=0
- +3 IF $GET(RMPR("STATION"))=""
- SET RMPRERR=1
- GOTO IENX
- +4 IF $GET(RMPR("HCPCS"))=""
- SET RMPRERR=2
- GOTO IENX
- +5 IF $GET(RMPR("ITEM"))=""
- SET RMPRERR=3
- GOTO IENX
- +6 SET RMPRIEN=$ORDER(^RMPR(661.11,"ASHI",RMPR("STATION"),RMPR("HCPCS"),RMPR("ITEM"),""))
- +7 SET RMPR("IEN")=RMPRIEN
- IENX QUIT RMPRERR
- +1 ;
- +2 ;***** CRE - Create a new HCPCS Item (661.11) record
- +3 ;
- +4 ; Inputs
- CRE(RMPR) ;
- +1 NEW RMPRCRE,RMPRFDA,RMPRFME,RMPRIEN,X,Y,DA
- +2 SET RMPRCRE=0
- +3 LOCK +^RMPR(661.11)
- +4 ;
- +5 ; Get new seq. number for Item
- +6 IF $GET(RMPR("ITEM"))=""
- Begin DoDot:1
- +7 SET RMPR("ITEM")=1+$ORDER(^RMPR(661.11,"ASHI",RMPR("STATION"),RMPR("HCPCS"),""),-1)
- +8 QUIT
- End DoDot:1
- +9 ;
- +10 ; Update 661.11
- +11 SET RMPRFDA(661.11,"+1,",.01)=RMPR("HCPCS")
- +12 SET RMPRFDA(661.11,"+1,",1)=RMPR("ITEM")
- +13 SET RMPRFDA(661.11,"+1,",2)=RMPR("DESCRIPTION")
- +14 SET RMPRFDA(661.11,"+1,",3)=RMPR("STATION")
- +15 SET RMPRFDA(661.11,"+1,",4)=RMPR("SOURCE")
- +16 SET RMPRFDA(661.11,"+1,",5)=$GET(RMPR("UNIT"))
- +17 SET RMPRFDA(661.11,"+1,",6)=RMPR("HCPCS")_"-"_RMPR("ITEM")
- +18 SET RMPRFDA(661.11,"+1,",7)=RMPR("ITEM MASTER IEN")
- +19 DO UPDATE^DIE("","RMPRFDA","RMPRIEN","RMPRFME")
- +20 LOCK -^RMPR(661.11)
- +21 IF $DATA(RMPRFME)
- SET RMPRCRE=1
- GOTO CREX
- +22 SET RMPR("IEN")=RMPRIEN(1)
- +23 ;
- +24 ; Update Inventory Flag
- +25 ; RMPR*3.0*201 Removes Inventory Flag update
- +26 KILL RMPRFDA,RMPRFME
- +27 ;S RMPRIEN=$O(^RMPR(661.1,"B",RMPR("HCPCS"),""))_","
- +28 ;S RMPRFDA(661.1,RMPRIEN,10)=1
- +29 ;D FILE^DIE("","RMPRFDA","RMPRFME")
- CREX QUIT RMPRCRE
- +1 ;
- +2 ;***** UPD - Update HCPCS Item record (661.11)
- UPD(RMPR11) ;
- +1 NEW RMPRFDA,RMPRFME,X,Y,DA,RMPRIEN,RMPRERR
- +2 SET RMPRERR=0
- +3 SET RMPRIEN=RMPR11("IEN")_","
- +4 IF $DATA(RMPR11("HCPCS"))
- Begin DoDot:1
- +5 SET RMPRFDA(661.11,RMPRIEN,.01)=RMPR11("HCPCS")
- +6 QUIT
- End DoDot:1
- +7 IF $DATA(RMPR11("ITEM"))
- Begin DoDot:1
- +8 SET RMPRFDA(661.11,RMPRIEN,1)=RMPR11("ITEM")
- +9 QUIT
- End DoDot:1
- +10 if $DATA(RMPR11("DESCRIPTION"))
- SET RMPRFDA(661.11,RMPRIEN,2)=RMPR11("DESCRIPTION")
- +11 if $DATA(RMPR11("SOURCE"))
- SET RMPRFDA(661.11,RMPRIEN,4)=RMPR11("SOURCE")
- +12 if $DATA(RMPR11("UNIT"))
- SET RMPRFDA(661.11,RMPRIEN,5)=RMPR11("UNIT")
- +13 if $DATA(RMPR11("HCPCS-ITEM"))
- SET RMPRFDA(661.11,RMPRIEN,6)=RMPR11("HCPCS-ITEM")
- +14 if $DATA(RMPR11("ITEM MASTER IEN"))
- SET RMPRFDA(661.11,RMPRIEN,7)=RMPR11("ITEM MASTER IEN")
- +15 if $DATA(RMPRFDA)
- DO FILE^DIE("","RMPRFDA","RMPRFME")
- +16 IF $DATA(RMPRFME)
- SET RMPRERR=1
- GOTO UPDX
- UPDX QUIT RMPRERR
- +1 ;
- +2 ;***** DUP - Check that a HCPCS Item does not have a different
- +3 ; source on the same code
- DUP(RMPR,RMPRDUP) ;
- +1 NEW RMPRS,RMPRERR,RMPR1,RMPR1I
- +2 SET RMPRERR=0
- SET RMPRDUP=0
- +3 SET RMPRERR=$$IEN(.RMPR)
- if RMPRERR
- GOTO DUPX
- +4 IF RMPR("IEN")=""
- GOTO DUPX
- +5 SET RMPR1("IEN")=RMPR("IEN")
- +6 SET RMPRERR=$$GET(.RMPR1)
- if RMPRERR
- GOTO DUPX
- +7 SET RMPRERR=$$ETOI(.RMPR1,.RMPR1I)
- if RMPRERR
- GOTO DUPX
- +8 IF RMPR1I("SOURCE")=RMPR("SOURCE")
- Begin DoDot:1
- +9 SET RMPRDUP=0
- +10 QUIT
- End DoDot:1
- +11 IF '$TEST
- Begin DoDot:1
- +12 SET RMPRDUP=1
- +13 QUIT
- End DoDot:1
- DUPX QUIT RMPRERR
- +1 ;
- +2 ;***** GET - read HCPCS Item 661.11 record
- GET(RMPR) ;
- +1 NEW RMPRCRE,RMPRFME,RMPROUP,RMPRIEN
- +2 SET RMPRCRE=0
- +3 IF $GET(RMPR("IEN"))=""
- Begin DoDot:1
- +4 SET RMPRCRE=$$IEN(.RMPR)
- +5 QUIT
- End DoDot:1
- +6 IF RMPRCRE
- GOTO GETX
- +7 SET RMPRIEN=RMPR("IEN")_","
- +8 DO GETS^DIQ(661.11,RMPRIEN,"*","","RMPROUP","RMPRFME")
- +9 IF $DATA(RMPRFME)
- SET RMPRCRE=1
- GOTO GETX
- +10 SET RMPR("HCPCS")=RMPROUP(661.11,RMPRIEN,.01)
- +11 SET RMPR("ITEM")=RMPROUP(661.11,RMPRIEN,1)
- +12 SET RMPR("DESCRIPTION")=RMPROUP(661.11,RMPRIEN,2)
- +13 SET RMPR("STATION")=RMPROUP(661.11,RMPRIEN,3)
- +14 SET RMPR("SOURCE")=RMPROUP(661.11,RMPRIEN,4)
- +15 SET RMPR("UNIT")=RMPROUP(661.11,RMPRIEN,5)
- +16 SET RMPR("HCPCS-ITEM")=RMPROUP(661.11,RMPRIEN,6)
- +17 SET RMPR("ITEM MASTER")=RMPROUP(661.11,RMPRIEN,7)
- +18 SET RMPR("STATUS")=RMPROUP(661.11,RMPRIEN,8)
- GETX QUIT RMPRCRE
- +1 ;
- +2 ; Given HCPCS code get 1st active HCPCS record in 661.1 file
- +3 ; If none are active then use 1st ien (should never occur)
- HPACT(RMPR) ;
- +1 NEW RMPRCRE,RMPRFME,RMPROUP,RMPRIEN,RMPRE,RMPRI
- +2 SET RMPRCRE=0
- +3 IF $GET(RMPR("HCPCS"))=""
- SET RMPRCRE=1
- GOTO HPACTX
- +4 SET RMPRI=""
- +5 FOR
- SET RMPRI=$ORDER(^RMPR(661.1,"B",RMPR("HCPCS"),RMPRI))
- if RMPRI=""
- QUIT
- Begin DoDot:1
- +6 KILL RMPRE
- SET RMPRE("IEN")=RMPRI
- +7 SET RMPRCRE=$$HPGET(.RMPRE)
- +8 QUIT
- End DoDot:1
- if RMPRE("STATUS")="ACTIVE"
- QUIT
- +9 IF $GET(RMPRE("IEN"))'=""
- MERGE RMPR=RMPRE
- HPACTX QUIT RMPRCRE
- +1 ;
- +2 ;***** HPGET - Get a HCPCS record
- HPGET(RMPR) ;
- +1 NEW RMPRCRE,RMPRFME,RMPROUP,RMPRIEN
- +2 SET RMPRCRE=0
- +3 IF $GET(RMPR("IEN"))=""
- SET RMPRCRE=1
- GOTO HPGETX
- +4 SET RMPRIEN=RMPR("IEN")_","
- +5 DO GETS^DIQ(661.1,RMPRIEN,"*","","RMPROUP","RMPRFME")
- +6 IF $DATA(RMPRFME)
- SET RMPRCRE=2
- GOTO HPGETX
- +7 SET RMPR("HCPCS")=RMPROUP(661.1,RMPRIEN,.01)
- +8 SET RMPR("SHORT DESC")=RMPROUP(661.1,RMPRIEN,.02)
- +9 SET RMPR("NEW HCPC IEN")=RMPROUP(661.1,RMPRIEN,1)
- +10 SET RMPR("CPT CODE")=RMPROUP(661.1,RMPRIEN,2)
- +11 SET RMPR("STATUS")=RMPROUP(661.1,RMPRIEN,3)
- +12 SET RMPR("NPPD REPAIR CODE")=RMPROUP(661.1,RMPRIEN,5)
- +13 SET RMPR("NPPD NEW CODE")=RMPROUP(661.1,RMPRIEN,6)
- +14 SET RMPR("CALC FLAG")=RMPROUP(661.1,RMPRIEN,9)
- +15 SET RMPR("INV FLAG")=RMPROUP(661.1,RMPRIEN,10)
- +16 SET RMPR("LAB TIME")=RMPROUP(661.1,RMPRIEN,11)
- HPGETX QUIT RMPRCRE
- +1 ;
- +2 ;***** HPETOI - Convert external to internal form for HCPCS rec.
- HPETOI(RMPRE,RMPRI) ;
- +1 NEW RMPRFDA,RMPRIEN,RMPRFDI,RMPRFME,RMPRERR
- +2 SET RMPRERR=0
- +3 SET RMPRIEN=RMPRE("IEN")_","
- +4 DO GETS^DIQ(661.1,RMPRIEN,"*","I","RMPRFDI","RMPRFME")
- +5 IF $DATA(RMPRFME)
- SET RMPRERR=1
- GOTO HPETOIX
- +6 SET RMPRI("IEN")=RMPRE("IEN")
- +7 SET RMPRI("NEW HCPC IEN")=RMPRFDI(661.1,RMPRIEN,1,"I")
- +8 SET RMPRI("CPT CODE")=RMPRFDI(661.1,RMPRIEN,2,"I")
- +9 SET RMPRI("STATUS")=RMPRFDI(661.1,RMPRIEN,3,"I")
- +10 SET RMPRI("NPPD REPAIR CODE")=RMPRFDI(661.1,RMPRIEN,5,"I")
- +11 SET RMPRI("NPPD NEW CODE")=RMPRFDI(661.1,RMPRIEN,6,"I")
- +12 SET RMPRI("CALC FLAG")=RMPRFDI(661.1,RMPRIEN,9,"I")
- +13 SET RMPRI("INV FLAG")=RMPRFDI(661.1,RMPRIEN,10,"I")
- +14 SET RMPRI("LAB TIME")=RMPRFDI(661.1,RMPRIEN,11,"I")
- HPETOIX QUIT RMPRERR
- +1 ;
- +2 ;***** ETOI - Convert external to internal form
- ETOI(RMPRE,RMPRI) ;
- +1 NEW RMPRFDA,RMPRIEN,RMPRFDI,RMPRFME,RMPRERR
- +2 SET RMPRERR=0
- +3 SET RMPRIEN=RMPRE("IEN")_","
- +4 DO GETS^DIQ(661.11,RMPRIEN,"*","I","RMPRFDI","RMPRFME")
- +5 IF $DATA(RMPRFME)
- SET RMPRERR=1
- GOTO ETOIX
- +6 SET RMPRI("IEN")=RMPRE("IEN")
- +7 SET RMPRI("HCPCS")=RMPRFDI(661.11,RMPRIEN,.01,"I")
- +8 SET RMPRI("ITEM")=RMPRFDI(661.11,RMPRIEN,1,"I")
- +9 SET RMPRI("DESCRIPTION")=RMPRFDI(661.11,RMPRIEN,2,"I")
- +10 SET RMPRI("STATION")=RMPRFDI(661.11,RMPRIEN,3,"I")
- +11 SET RMPRI("SOURCE")=RMPRFDI(661.11,RMPRIEN,4,"I")
- +12 SET RMPRI("UNIT")=RMPRFDI(661.11,RMPRIEN,5,"I")
- +13 SET RMPRI("ITEM MASTER IEN")=RMPRFDI(661.11,RMPRIEN,7,"I")
- ETOIX QUIT RMPRERR