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

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

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