- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRDDC.m
r613 r623 1 RMPRDDC ;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 ; 8 MAIN ;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 ; 112 EXIT ;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 1 RMPRDDC ;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 ; 8 MAIN ;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 ; 108 EXIT ;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 TracChangeset
for help on using the changeset viewer.
