source: FOIAVistA/tag/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIX2.m@ 1540

RMPRPIX2 ;HINCIO/ODJ - APIs for 660 file (Patient 2319) ;3/8/01
 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
 Q
 ;
 ; CRE - Create a 2319 record for a stock issue (file 660)
 ;
 ; Inputs:
 ;    
 ; Outputs:
 ;
CRE(RMPR60,RMPR6111) ;
 N RMPRFDA,RMPRFME,RMPRIEN,RMPRRET,X,Y,RMPR699,RMPRTMP,RMPRI,RMPRJ
 N RMPR611,RMPR611I,RMPRERR,RMPRTMP
 S RMPRRET=0
 S RMPR611("HCPCS")=RMPR6111("HCPCS")
 S RMPRRET=$$HPACT^RMPRPIX1(.RMPR611)
 I RMPRRET S RMPRRET=1 G CREX
 S RMPRRET=$$HPETOI^RMPRPIX1(.RMPR611,.RMPR611I)
 I RMPRRET S RMPRRET=1 G CREX
 ;S RMPR60("CPT IEN")=RMPR611I("CPT CODE")
 S RMPRFDA(660,"+1,",.01)=RMPR60("ENTRY DATE")
 S RMPRFDA(660,"+1,",.02)=RMPR60("PATIENT IEN")
 S RMPRFDA(660,"+1,",1)=RMPR60("REQ DATE")
 S RMPRFDA(660,"+1,",2)=RMPR60("ISSUE TYPE")
 S RMPRFDA(660,"+1,",4)=$G(RMPR60("IFCAP ITEM"))
 S RMPRFDA(660,"+1,",5)=RMPR60("QUANTITY")
 S RMPRFDA(660,"+1,",78)=$G(RMPR60("UNIT"))
 S RMPRFDA(660,"+1,",7)=RMPR60("VENDOR IEN")
 S RMPRFDA(660,"+1,",8)=RMPR6111("STATION IEN")
 S RMPRFDA(660,"+1,",9)=$G(RMPR60("SERIAL NUM"))
 S RMPRFDA(660,"+1,",10)=RMPR60("DELIV DATE")
 S RMPRFDA(660,"+1,",11)=$G(RMPR60("REQ TYPE"))
 S RMPRFDA(660,"+1,",12)=$G(RMPR60("SOURCE"))
 S RMPRFDA(660,"+1,",14)=RMPR60("COST")
 S RMPRFDA(660,"+1,",16)=$G(RMPR60("REMARKS"))
 S RMPRFDA(660,"+1,",4.1)=RMPR60("CPT IEN")
 S RMPRFDA(660,"+1,",21)=$G(RMPR60("LOT NUM"))
 S RMPRFDA(660,"+1,",27)=$G(RMPR60("USER"))
 ;
 ; for the type 1 rec.
 S RMPRFDA(660,"+1,",24)=RMPR611("SHORT DESC")
 S RMPRFDA(660,"+1,",4.5)=RMPR60("HCPCS")
 ;S RMPRFDA(660,"+1,",4.5)=RMPR611("IEN")
 S RMPRFDA(660,"+1,",4.7)=RMPR60("CPT MOD")
 S RMPRFDA(660,"+1,",4.6)=RMPR60("TRANS IEN")
 S RMPRFDA(660,"+1,",39)=RMPR60("DATE OF SERVICE")
 ;
 ; for the type 2 rec.
 S RMPRFDA(660,"+1,",37)=RMPR6111("HCPCS")_"-"_RMPR6111("ITEM")
 S RMPRFDA(660,"+1,",38)=RMPR6111("DESCRIPTION")
 ;
 ; for the type AM rec.
 S RMPRFDA(660,"+1,",62)=RMPR60("PAT CAT")
 S RMPRFDA(660,"+1,",63)=$G(RMPR60("SPEC CAT"))
 ;
 ; for the type AMS rec.
 S RMPR699("IEN")=RMPR60("SITE IEN")
 S RMPRFDA(660,"+1,",68)=RMPR60("GROUPER")
 ;
 ; for the type DES rec.
 S RMPRERR=$$HCDES(.RMPR611,.RMPRTMP)
 I RMPRERR S RMPRRET=2 G CREX
 S RMPRFDA(660,"+1,",28)="RMPRTMP"
 D UPDATE^DIE("","RMPRFDA","RMPRIEN","RMPRFME")
 I $D(RMPRFME) S RMPRRET=99 G CREX
 S RMPR60("IEN")=RMPRIEN(1)
CREX Q RMPRRET
 ;
 ; UPD - Update existing 660 rec.
UPD(RMPR60,RMPR6111) ;
 N RMPRFDA,RMPRFME,RMPRERR,RMPRI,X,Y,DA,RMPR611,RMPR611I,RMPRTMP
 S RMPRERR=0
 I $G(RMPR60("IEN"))="" S RMPRERR=1 G UPDX
 S RMPRI=RMPR60("IEN")_","
 I $D(RMPR6111("HCPCS")) D
 . S RMPR611("HCPCS")=RMPR6111("HCPCS")
 . S RMPRERR=$$HPACT^RMPRPIX1(.RMPR611)
 . Q:RMPRERR
 . S RMPRERR=$$HPETOI^RMPRPIX1(.RMPR611,.RMPR611I)
 . Q:RMPRERR
 . S RMPRERR=$$HCDES(.RMPR611,.RMPRTMP)
 . Q:RMPRERR
 . S RMPRFDA(660,RMPRI,28)="RMPRTMP"
 . Q
 I RMPRERR S RMPRERR=1 G UPDX
 S:$D(RMPR60("ENTRY DATE")) RMPRFDA(660,RMPRI,.01)=RMPR60("ENTRY DATE")
 S:$D(RMPR60("PATIENT IEN")) RMPRFDA(660,RMPRI,.02)=RMPR60("PATIENT IEN")
 S:$D(RMPR60("REQ DATE")) RMPRFDA(660,RMPRI,1)=RMPR60("REQ DATE")
 S:$D(RMPR60("ISSUE TYPE")) RMPRFDA(660,RMPRI,2)=RMPR60("ISSUE TYPE")
 S:$D(RMPR60("IFCAP ITEM")) RMPRFDA(660,RMPRI,4)=RMPR60("IFCAP ITEM")
 S:$D(RMPR60("QUANTITY")) RMPRFDA(660,RMPRI,5)=RMPR60("QUANTITY")
 S:$D(RMPR6111("UNIT")) RMPRFDA(660,RMPRI,78)=RMPR6111("UNIT")
 S:$D(RMPR60("VENDOR IEN")) RMPRFDA(660,RMPRI,7)=RMPR60("VENDOR IEN")
 S:$D(RMPR6111("STATION IEN")) RMPRFDA(660,RMPRI,8)=RMPR6111("STATION IEN")
 S:$D(RMPR60("SERIAL NUM")) RMPRFDA(660,RMPRI,9)=RMPR60("SERIAL NUM")
 S:$D(RMPR60("DELIV DATE")) RMPRFDA(660,RMPRI,10)=RMPR60("DELIV DATE")
 S:$D(RMPR60("DATE OF SERVICE")) RMPRFDA(660,RMPRI,39)=RMPR60("DATE OF SERVICE")
 S:$D(RMPR60("REQ TYPE")) RMPRFDA(660,RMPRI,11)=RMPR60("REQ TYPE")
 S:$D(RMPR60("SOURCE")) RMPRFDA(660,RMPRI,12)=RMPR60("SOURCE")
 S:$D(RMPR60("COST")) RMPRFDA(660,RMPRI,14)=RMPR60("COST")
 S:$D(RMPR60("REMARKS")) RMPRFDA(660,RMPRI,16)=RMPR60("REMARKS")
 S:$D(RMPR60("TRANS IEN")) RMPRFDA(660,RMPRI,4.6)=RMPR60("TRANS IEN")
 S:$D(RMPR60("CPT IEN")) RMPRFDA(660,RMPRI,4.1)=RMPR60("CPT IEN")
 S:$D(RMPR60("LOT NUM")) RMPRFDA(660,RMPRI,21)=RMPR60("LOT NUM")
 ;
 ; for the type 1 rec.
 S:$D(RMPR611("SHORT DESC")) RMPRFDA(660,RMPRI,24)=RMPR611("SHORT DESC")
 S:$D(RMPR60("HCPCS")) RMPRFDA(660,RMPRI,4.5)=RMPR60("HCPCS")
 ;S:$D(RMPR611("IEN")) RMPRFDA(660,RMPRI,4.5)=RMPR611("IEN")
 S:$D(RMPR60("CPT MOD")) RMPRFDA(660,RMPRI,4.7)=RMPR60("CPT MOD")
 ;
 ; for the type 2 rec.
 S:$D(RMPR6111("HCPCS")) RMPRFDA(660,RMPRI,37)=RMPR6111("HCPCS")_"-"_RMPR6111("ITEM")
 S:$D(RMPR6111("DESCRIPTION")) RMPRFDA(660,RMPRI,38)=RMPR6111("DESCRIPTION")
 ;
 ; for the type AM rec.
 S:$D(RMPR60("PAT CAT")) RMPRFDA(660,RMPRI,62)=RMPR60("PAT CAT")
 S:$D(RMPR60("SPEC CAT")) RMPRFDA(660,RMPRI,63)=RMPR60("SPEC CAT")
 D:$D(RMPRFDA) FILE^DIE("","RMPRFDA","RMPRFME")
 I $D(RMPRFME) S RMPRERR=1
UPDX Q RMPRERR
 ;
 ; Update AMIS grouper
AMGR(RMPR699) ;
 N RMPRFDA,RMPRIEN,RMPRFME,X,Y,RMPRRET
 S RMPRRET=0
 S RMPRIEN=RMPR699("IEN")_","
 L +^RMPR(669.9,RMPR699("IEN"))
 S RMPR699("AMIS GROUPER")=$P(^RMPR(669.9,RMPR699("IEN"),0),"^",7)
 S RMPR699("AMIS GROUPER")=RMPR699("AMIS GROUPER")-1
 S RMPRFDA(669.9,RMPRIEN,11)=RMPR699("AMIS GROUPER")
 D FILE^DIE("","RMPRFDA","RMPRFME")
 I $D(RMPRFME) S RMPRRET=1
 L -^RMPR(669.9,RMPR699("IEN"))
 Q RMPRRET
 ;
 ; Read description for HCPCS
HCDES(RMPR611,RMPRFDA) ;
 N RMPRIEN,RMPRFME,RMPRRET,RMPRTMP,RMPRI,RMPRJ
 K RMPRFDA
 S RMPRRET=0
 S RMPRIEN=RMPR611("IEN")_","
 D GETS^DIQ(661.1,RMPRIEN,"**","","RMPRTMP","RMPRFME")
 I $D(RMPRFME) S RMPRRET=1 G HCDESX
 S RMPRJ=0,RMPRI=""
 F  S RMPRI=$O(RMPRTMP(661.18,RMPRI)) Q:RMPRI=""  D
 . S RMPRJ=RMPRJ+1
 . S RMPRFDA(RMPRJ)=RMPRTMP(661.18,RMPRI,.01)
 . Q
HCDESX Q RMPRRET
 ;
 ; DEL - Delete a record
DEL(RMPR60) ;
 N RMPRFDA,RMPRFME,RMPRERR,RMPRIEN,X,Y,DA
 S RMPRERR=0
 I $G(RMPR60("IEN"))="" S RMPRERR=1 G DELX
 S RMPRIEN=RMPR60("IEN")_","
 S RMPRFDA(660,RMPRIEN,.01)="@"
 D FILE^DIE("","RMPRFDA","RMPRFME")
 I $D(RMPRFME) S RMPRERR=1
DELX Q RMPRERR
 ;
 ; GET - read in 660 record
GET(RMPR60,RMPR11) ;
 S RMPRERR=$$GET^RMPRPIXC(.RMPR60,.RMPR11)
GETX Q RMPRERR
 ;
 ; ETOI - convert external to internal form
ETOI(RMPR60,RMPR11,RMPR60I,RMPR11I) ;
 S RMPRERR=$$ETOI^RMPRPIXC(.RMPR60,.RMPR11,.RMPR60I,.RMPR11I)
ETOIX Q RMPRERR