source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRDDC.m@ 1093

Last change on this file since 1093 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version
File size: 4.6 KB
RevLine 
[623]1RMPRDDC ;VACO/HNC - SERVER ROUTINE FOR DALC RECORD IN 660 ; 11/01/2006
2 ;;3.0;PROSTHETICS;**60**;Feb 09, 1996;Build 18
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;DBIA # 10072 - for routine REMSBMSG^XMA1C
6 ;DBIA # ????? - for D FIND^DIC(2,,".09"
7 ;
8MAIN ;main entry point
9 ;loop msg
10 K RMPRMSG
11 S RMPRCNT=0
12 S RMPRMSGC=0
13 F X XMREC Q:XMRG="" D
14 .S RMPRDATA=XMRG
15 .Q:RMPRDATA="ENCRYPTED STRING"
16 .S (RMPRTD,RMPRMPI,RMPRSSN,RMPRNAM,RMPRTRAN,RMPRCAT,RMPRPP,RMPRICD,RMPRITM,RMPRHCPE,RMPRHCP,RMPRSTN,RMPRCMT,RMPRCOST,RMPRQTY,RMPRREF,RMPRSRL,RMPRVND,RMPRDUN,RMPRTAX,RMPRRT,DFN)=""
17 .;parse data string
18 .S RMPRNPMN=$P(XQSUB,"#",2)
19 .S RMPRMSGC=RMPRMSGC+1
20 .S RMPRCNT=RMPRCNT+1
21 .S RMPRFLG=$P($G(RMPRDATA),U,21) ;retransmission flag Y or N
22 .S X=$P($P($G(RMPRDATA),U,1),".",1) ;transaction date
23 .S X=$E(X,5,6)_"/"_$E(X,7,8)_"/"_$E(X,3,4) D ^%DT S RMPRTD=Y
24 .I RMPRTD=-1 S RMPRTD=""
25 .S RMPRMPI=$P($G(RMPRDATA),U,2) ;MPI
26 .S RMPRSSN=$P($G(RMPRDATA),U,3) ;SSN
27 .S RMPRPNAM=$P($G(RMPRDATA),U,4) ;Patient Name
28 .S RMPRTRAN=$P($G(RMPRDATA),U,5) ;Type New or Repair
29 .I RMPRTRAN="N" S RMPRTRAN="I" ;new trans
30 .I RMPRTRAN="R" S RMPRTRAN="X" ;repair trans
31 .S RMPRCAT=$P($G(RMPRDATA),U,6) ;category NSC or SC
32 .I RMPRCAT="NSC" S RMPRCAT=4
33 .I RMPRCAT="SC" S RMPRCAT=1
34 .S RMPRPP=$P($G(RMPRDATA),U,7) ;Person placing order DALC STAFF or VET
35 .S RMPRICD=$P($G(RMPRDATA),U,8) ;ICD9 blank for now
36 .S RMPRITM=$P($G(RMPRDATA),U,9) ;Item HCPCS short desc
37 .S RMPRHCPE=$P($G(RMPRDATA),U,10) ;hcpcs
38 .S RMPRHCP=""
39 .S RMPRHCP=$O(^RMPR(661.1,"B",RMPRHCPE,RMPRHCP))
40 .I RMPRHCP="" S RMPRITM=RMPRITM_" *NOT VALID"
41 .S RMPRSTN=$P($G(RMPRDATA),U,11) ;station billing number
42 .S RMPRCMT=$P($G(RMPRDATA),U,12) ;comment
43 .S RMPRCOST=$P($G(RMPRDATA),U,13) ;total cost
44 .S RMPRQTY=$P($G(RMPRDATA),U,14) ;qty
45 .S RMPRREF=$P($G(RMPRDATA),U,15) ;ddc internal reference
46 .S RMPRSRL=$P($G(RMPRDATA),U,16) ;serial number
47 .S RMPRVND=$P($G(RMPRDATA),U,17) ;vendor as text
48 .S RMPRDUN=$P($G(RMPRDATA),U,18) ;dun
49 .S RMPRTAX=$P($G(RMPRDATA),U,19) ;tax
50 .; RMPRDAT,U,21 IS RESERVED FOR A RETURN NUMBER TBD SKIPPED
51 .S RMPROS=$P($G(RMPRDATA),U,22) ;ordering station
52 .S X=$P($G(RMPRDATA),U,20) ;return date
53 .S X=$E(X,5,6)_"/"_$E(X,7,8)_"/"_$E(X,3,4) D ^%DT S RMPRRT=Y
54 .I RMPRRT=-1 S RMPRRT=""
55 .;file
56 .D NOW^%DTC S RMPRWHN=$P(%,".",1)
57 .;check to see if new
58 .I $D(^RMPR(660,"DDC",RMPRREF)) S RMPRMSG(RMPRMSGC)="Record already on file, Not Processed: "_RMPRREF Q
59 .;find patient
60 .D FIND^DIC(2,,".09","PS",RMPRSSN,3,"SSN","","","RMPROUT")
61 .I '$G(RMPROUT("DILIST","1",0)) S RMPRMSG(RMPRMSGC)="Patient Not Found Not Processed: "_RMPRREF Q
62 .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
63 .S DFN=$P(RMPROUT("DILIST",1,0),U,1)
64 .;check 665 if not there add it
65 .;array to file
66 .K RMPRERR,RMPR660
67 .S RMPR660(660,"+1,",.01)=RMPRWHN
68 .S RMPR660(660,"+1,",.02)=DFN
69 .S RMPR660(660,"+1,",1)=RMPRTD
70 .S RMPR660(660,"+1,",89.2)=RMPRTD
71 .S RMPR660(660,"+1,",2)=RMPRTRAN
72 .S RMPR660(660,"+1,",4.2)=RMPRPP
73 .S RMPR660(660,"+1,",62)=RMPRCAT
74 .S RMPR660(660,"+1,",89)=RMPRITM
75 .S RMPR660(660,"+1,",24)=RMPRITM
76 .S RMPR660(660,"+1,",16)=RMPRCMT
77 .S RMPR660(660,"+1,",14)=RMPRCOST
78 .S RMPR660(660,"+1,",5)=RMPRQTY
79 .S RMPR660(660,"+1,",9)=RMPRSRL
80 .S RMPR660(660,"+1,",91)=RMPRVND
81 .S RMPR660(660,"+1,",92)=RMPRDUN
82 .S RMPR660(660,"+1,",93)=RMPRTAX
83 .S RMPR660(660,"+1,",17.5)=RMPRRT
84 .S RMPR660(660,"+1,",17)=1
85 .S RMPR660(660,"+1,",89.3)=RMPROS
86 .S RMPR660(660,"+1,",90)=RMPRSTN
87 .S RMPR660(660,"+1,",4.5)=RMPRHCP
88 .S RMPR660(660,"+1,",89.1)=RMPRREF
89 .S RMPR660(660,"+1,",11)=16
90 .S RMPR660(660,"+1,",12)="V" ;source
91 .S RMPR660(660,"+1,",15)="*" ;historical data flag
92 .D UPDATE^DIE("","RMPR660","","RMPRERR")
93 .I $D(RMPRERR) D
94 . .S RMPRMSG(RMPRMSGC)=$G(RMPRERR("DIERR","1","TEXT",1))_"Error Not Processed: "_RMPRREF
95 . .;S RMPRMSG(RMPRMSGC)="Error Not Processed: "_RMPRREF
96 . .S XMY("G.RMPR SERVER")=""
97 .S RMPRMSG(RMPRMSGC)="Done: "_RMPRREF
98 ;Send email to ddc with number of records processed
99 S XMDUZ=.5
100 S XMY("G.RMPR SERVER")=""
101 S XMY("S.RMPRACKDALC@DDC.VA.GOV")=""
102 S XMSUB="Prosthetics - DALC Interface Summary NPNM #"_RMPRNPMN
103 S RMPRMSGC=RMPRMSGC+1
104 S RMPRMSG(RMPRMSGC)="Total Records Received: "_RMPRCNT
105 S XMTEXT="RMPRMSG("
106 D ^XMD
107 ;
108EXIT ;main exit point
109 K RMPRTD,RMPRMPI,RMPRSSN,RMPRNAM,RMPRTRAN,RMPRCAT,RMPRPP,RMPRICD
110 K RMPRITM,RMPRHCPE,RMPRHCP,RMPRSTN,RMPRCMT,RMPRCOST,RMPRQTY,RMPRREF
111 K RMPRSRL,RMPRVND,RMPRDUN,RMPRTAX,RMPRRT,DFN,RMPR(660),RMPRCNT,RMPRDATA
112 K RMPRFLG,RMPROUT,RMPRNAM,RMPRWHN,RMPRMSGC,RMPRPNAM,RMPRNPMN
113 ;purge server message
114 S XMSER="S."_XQSOP,XMZ=XQMSG D REMSBMSG^XMA1C
115 Q
116 ;END
Note: See TracBrowser for help on using the repository browser.