121 lines
4.8 KiB
Mathematica
121 lines
4.8 KiB
Mathematica
RMPRDDC ;VACO/HNC - SERVER ROUTINE FOR DALC RECORD IN 660 ; 11/01/2006
|
|
;;3.0;PROSTHETICS;**60,141**;Feb 09, 1996;Build 5
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;
|
|
;DBIA # 10072 - for routine REMSBMSG^XMA1C
|
|
;DBIA # ????? - for D FIND^DIC(2,,".09"
|
|
;
|
|
MAIN ;main entry point
|
|
;loop msg
|
|
K RMPRMSG
|
|
N ERR
|
|
S RMPRCNT=0
|
|
S RMPRMSGC=0
|
|
F X XMREC Q:XMRG="" D
|
|
.S RMPRDATA=XMRG
|
|
.Q:RMPRDATA="ENCRYPTED STRING"
|
|
.S (RMPRTD,RMPRMPI,RMPRSSN,RMPRNAM,RMPRTRAN,RMPRCAT,RMPRPP,RMPRICD,RMPRITM,RMPRHCPE,RMPRHCP,RMPRSTN,RMPRCMT,RMPRCOST,RMPRQTY,RMPRREF,RMPRSRL,RMPRVND,RMPRDUN,RMPRTAX,RMPRRT,DFN)=""
|
|
.;parse data string
|
|
.S RMPRNPMN=$P(XQSUB,"#",2)
|
|
.S RMPRMSGC=RMPRMSGC+1
|
|
.S RMPRCNT=RMPRCNT+1
|
|
.S RMPRFLG=$P($G(RMPRDATA),U,21) ;retransmission flag Y or N
|
|
.S X=$P($P($G(RMPRDATA),U,1),".",1) ;transaction date
|
|
.S X=$E(X,5,6)_"/"_$E(X,7,8)_"/"_$E(X,3,4) D ^%DT S RMPRTD=Y
|
|
.I RMPRTD=-1 S RMPRTD=""
|
|
.S RMPRMPI=$P($G(RMPRDATA),U,2) ;MPI
|
|
.S RMPRSSN=$P($G(RMPRDATA),U,3) ;SSN
|
|
.S RMPRPNAM=$P($G(RMPRDATA),U,4) ;Patient Name
|
|
.S RMPRTRAN=$P($G(RMPRDATA),U,5) ;Type New or Repair
|
|
.I RMPRTRAN="N" S RMPRTRAN="I" ;new trans
|
|
.I RMPRTRAN="R" S RMPRTRAN="X" ;repair trans
|
|
.S RMPRCAT=$P($G(RMPRDATA),U,6) ;category NSC or SC
|
|
.I RMPRCAT="NSC" S RMPRCAT=4
|
|
.I RMPRCAT="SC" S RMPRCAT=1
|
|
.S RMPRPP=$P($G(RMPRDATA),U,7) ;Person placing order DALC STAFF or VET
|
|
.S RMPRICD=$P($G(RMPRDATA),U,8) ;ICD9 blank for now
|
|
.S RMPRITM=$P($G(RMPRDATA),U,9) ;Item HCPCS short desc
|
|
.S RMPRHCPE=$P($G(RMPRDATA),U,10) ;hcpcs
|
|
.S RMPRHCP=""
|
|
.S RMPRHCP=$O(^RMPR(661.1,"B",RMPRHCPE,RMPRHCP))
|
|
.I RMPRHCP="" S RMPRITM=RMPRITM_" *NOT VALID"
|
|
.S RMPRSTN=$P($G(RMPRDATA),U,11) ;station billing number
|
|
.S RMPRCMT=$P($G(RMPRDATA),U,12) ;comment
|
|
.S RMPRCOST=$P($G(RMPRDATA),U,13) ;total cost
|
|
.S RMPRQTY=$P($G(RMPRDATA),U,14) ;qty
|
|
.S RMPRREF=$P($G(RMPRDATA),U,15) ;ddc internal reference
|
|
.S RMPRSRL=$P($G(RMPRDATA),U,16) ;serial number
|
|
.S RMPRVND=$P($G(RMPRDATA),U,17) ;vendor as text
|
|
.S RMPRDUN=$P($G(RMPRDATA),U,18) ;dun
|
|
.S RMPRTAX=$P($G(RMPRDATA),U,19) ;tax
|
|
.; RMPRDAT,U,21 IS RESERVED FOR A RETURN NUMBER TBD SKIPPED
|
|
.S RMPROS=$P($G(RMPRDATA),U,22) ;ordering station
|
|
.S RMPRSTA=$$FIND1^DIC(4,"","X",RMPROS,"D","","ERR")
|
|
.I $D(ERR)!(RMPRSTA'>0) D
|
|
.. S RMPR6699=$O(^RMPR(669.9,0)),RMPRSTA=$P(^RMPR(669.9,RMPR6699,0),U,2)
|
|
.S X=$P($G(RMPRDATA),U,20) ;return date
|
|
.S X=$E(X,5,6)_"/"_$E(X,7,8)_"/"_$E(X,3,4) D ^%DT S RMPRRT=Y
|
|
.I RMPRRT=-1 S RMPRRT=""
|
|
.;file
|
|
.D NOW^%DTC S RMPRWHN=$P(%,".",1)
|
|
.;check to see if new
|
|
.I $D(^RMPR(660,"DDC",RMPRREF)) S RMPRMSG(RMPRMSGC)="Record already on file, Not Processed: "_RMPRREF Q
|
|
.;find patient
|
|
.D FIND^DIC(2,,".09","PS",RMPRSSN,3,"SSN","","","RMPROUT")
|
|
.I '$G(RMPROUT("DILIST","1",0)) S RMPRMSG(RMPRMSGC)="Patient Not Found Not Processed: "_RMPRREF Q
|
|
.I $G(RMPROUT("DISLIST",2,0)) S RMPRMSG(RMPRMSGC)="More than one Patient with Same SSN, Patient Not Processed: "_RMPRREF Q ;more than one with same ssn
|
|
.S DFN=$P(RMPROUT("DILIST",1,0),U,1)
|
|
.;check 665 if not there add it
|
|
.;array to file
|
|
.K RMPRERR,RMPR660
|
|
.S RMPR660(660,"+1,",.01)=RMPRWHN
|
|
.S RMPR660(660,"+1,",.02)=DFN
|
|
.S RMPR660(660,"+1,",1)=RMPRTD
|
|
.S RMPR660(660,"+1,",89.2)=RMPRTD
|
|
.S RMPR660(660,"+1,",2)=RMPRTRAN
|
|
.S RMPR660(660,"+1,",4.2)=RMPRPP
|
|
.S RMPR660(660,"+1,",62)=RMPRCAT
|
|
.S RMPR660(660,"+1,",89)=RMPRITM
|
|
.S RMPR660(660,"+1,",24)=RMPRITM
|
|
.S RMPR660(660,"+1,",16)=RMPRCMT
|
|
.S RMPR660(660,"+1,",14)=RMPRCOST
|
|
.S RMPR660(660,"+1,",5)=RMPRQTY
|
|
.S RMPR660(660,"+1,",9)=RMPRSRL
|
|
.S RMPR660(660,"+1,",91)=RMPRVND
|
|
.S RMPR660(660,"+1,",92)=RMPRDUN
|
|
.S RMPR660(660,"+1,",93)=RMPRTAX
|
|
.S RMPR660(660,"+1,",17.5)=RMPRRT
|
|
.S RMPR660(660,"+1,",17)=1
|
|
.S RMPR660(660,"+1,",89.3)=RMPROS
|
|
.S RMPR660(660,"+1,",90)=RMPRSTN
|
|
.S RMPR660(660,"+1,",4.5)=RMPRHCP
|
|
.S RMPR660(660,"+1,",89.1)=RMPRREF
|
|
.S RMPR660(660,"+1,",11)=16
|
|
.S RMPR660(660,"+1,",12)="V" ;source
|
|
.S RMPR660(660,"+1,",15)="*" ;historical data flag
|
|
.D UPDATE^DIE("","RMPR660","","RMPRERR")
|
|
.I $D(RMPRERR) D
|
|
. .S RMPRMSG(RMPRMSGC)=$G(RMPRERR("DIERR","1","TEXT",1))_"Error Not Processed: "_RMPRREF
|
|
. .;S RMPRMSG(RMPRMSGC)="Error Not Processed: "_RMPRREF
|
|
. .S XMY("G.RMPR SERVER")=""
|
|
.S RMPRMSG(RMPRMSGC)="Done: "_RMPRREF
|
|
;Send email to ddc with number of records processed
|
|
S XMDUZ=.5
|
|
S XMY("G.RMPR SERVER")=""
|
|
S XMY("S.RMPRACKDALC@DDC.VA.GOV")=""
|
|
S XMSUB="Prosthetics - DALC Interface Summary NPNM #"_RMPRNPMN
|
|
S RMPRMSGC=RMPRMSGC+1
|
|
S RMPRMSG(RMPRMSGC)="Total Records Received: "_RMPRCNT
|
|
S XMTEXT="RMPRMSG("
|
|
D ^XMD
|
|
;
|
|
EXIT ;main exit point
|
|
K RMPRTD,RMPRMPI,RMPRSSN,RMPRNAM,RMPRTRAN,RMPRCAT,RMPRPP,RMPRICD
|
|
K RMPRITM,RMPRHCPE,RMPRHCP,RMPRSTN,RMPRCMT,RMPRCOST,RMPRQTY,RMPRREF
|
|
K RMPRSRL,RMPRVND,RMPRDUN,RMPRTAX,RMPRRT,DFN,RMPR(660),RMPRCNT,RMPRDATA
|
|
K RMPRFLG,RMPROUT,RMPRNAM,RMPRWHN,RMPRMSGC,RMPRPNAM,RMPRNPMN,RMPRSTA,RMPR6699
|
|
;purge server message
|
|
S XMSER="S."_XQSOP,XMZ=XQMSG D REMSBMSG^XMA1C
|
|
Q
|
|
;END
|