Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACHSEOBE

ACHSEOBE.m

Go to the documentation of this file.
  1. ACHSEOBE ; IHS/ITSC/PMF - SET VARIABLES FROM NON-PROCESSED EOBRS FILE ; [ 10/16/2001 8:16 AM ]
  1. ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**23**;JUN 11, 2001;Build 43
  1. ;ACHS*3.1*23 ADDED NEW PROCEDURE FIELDS IN RECORD "G"
  1. ;
  1. GET ;GET THE FIELD VALUES FROM 'CHS NON-PROCESSED EOBRS' FILE
  1. ;ACHSNON0 = NODE 0
  1. ;ACHSNON1 = NODE 1
  1. ;ACHSNON2 = NODE 2
  1. ;ACHSNON4 = NODE 4
  1. ;
  1. S ACHSNON0=$G(^ACHSEOBE(ACHSNON,0))
  1. S ACHSNON1=$G(^ACHSEOBE(ACHSNON,1))
  1. S ACHSNON2=$G(^ACHSEOBE(ACHSNON,2))
  1. S ACHSNON4=$G(^ACHSEOBE(ACHSNON,4))
  1. ;
  1. S ACHSEOBR("A",12)=$P(ACHSNON0,U) ;'NAME'
  1. S ACHSEOBR("A",1)=$P(ACHSNON0,U,2) ;'AREA OFFICE'
  1. S ACHSEOBR("A",2)=$P(ACHSNON0,U,3) ;'SERVICE UNIT'
  1. S ACHSEOBR("A",5)=$P(ACHSNON0,U,4) ;'CLAIM NUMBER'
  1. S ACHSEOBR("A",8)=$P(ACHSNON0,U,5) ;'CLAIM SEQUENCE COUNT'
  1. S ACHSEOBR("A",9)=$P(ACHSNON0,U,6) ;'CHECK NUMBER'
  1. S ACHSEOBR("A",10)=$P(ACHSNON0,U,7) ;'REMITTANCE NUMBER'
  1. S ACHSEOBR("A",11)=$P(ACHSNON0,U,8) ;'PAID DATE'
  1. S ACHSEOBR("A",13)=$P(ACHSNON0,U,9) ;'CERTIFICATE NUMBER'
  1. S ACHSEOBR("A",14)=$P(ACHSNON0,U,10) ;'FACILITY CODE'
  1. S ACHSEOBR("A",15)=$P(ACHSNON0,U,11) ;'DOCUMENTATION TYPE'
  1. ;
  1. S ACHSEOBR("B",8)=$P(ACHSNON1,U) ;'PATIENT NAME'
  1. S ACHSEOBR("B",9)=$P(ACHSNON1,U,2) ;'HEALTH RECORD NUMBER'
  1. S ACHSEOBR("B",10)=$P(ACHSNON1,U,3) ;'AUTHORIZATION DATE'
  1. S ACHSEOBR("B",11)=$P(ACHSNON1,U,4) ;'ACTUAL DAYS'
  1. S ACHSEOBR("B",12)=$P(ACHSNON1,U,5) ;'DRG'
  1. ;
  1. ;
  1. I ACHSEOBR("B",8)?1N.N S ACHSEOBR("B",8)=$P($G(^DPT(ACHSEOBR("B",8),0)),U)
  1. ;
  1. S ACHSEOBR("C",8)=$P(ACHSNON1,U,6) ;'COMMON ACCOUNTING NUMBER'
  1. S ACHSEOBR("C",9)=$P(ACHSNON1,U,7) ;'OBJECT CLASS CODE'
  1. S ACHSEOBR("C",10)=$P(ACHSNON1,U,8) ;'SERVICES BILLED'
  1. S ACHSEOBR("C",11)=$P(ACHSNON1,U,9) ;'BLANKET INDICATOR'
  1. S ACHSEOBR("C",12)=$P(ACHSNON1,U,10) ;'CONTRACT NUMBER'
  1. S ACHSEOBR("C",14)=$P(ACHSNON1,U,11) ;'SERVICE START DATE'
  1. S ACHSEOBR("C",15)=$P(ACHSNON1,U,12) ;'SERVICE END DATE'
  1. S ACHSEOBR("C",16)=$P(ACHSNON1,U,13) ;'VENDOR NUMBER'
  1. S ACHSEOBR("C",13)=$P(ACHSNON1,U,14) ;'INTERIM/FINAL INDICATOR'
  1. ;
  1. S ACHSEOBR("D",8)=$P(ACHSNON2,U) ;'VENDOR NAME'
  1. S ACHSEOBR("D",9)=$P(ACHSNON2,U,2) ;'BILLED BY PROVIDER'
  1. S ACHSEOBR("D",10)=$P(ACHSNON2,U,3) ;'ALLOWABLE AMOUNT'
  1. S ACHSEOBR("D",11)=$P(ACHSNON2,U,4) ;'PAID BY 3RD PARTY'
  1. ;
  1. ;
  1. I +ACHSEOBR("D",8)>0 S ACHSEOBR("D",8)=$P($G(^AUTTVNDR(ACHSEOBR("D",8),0)),U)
  1. S ACHSREJ=$P(ACHSNON2,U,14) ;ACHS*3.1*23 AND MOD NXT 9 LINES
  1. S ACHSEOBR(ACHSREJ,8)=$P(ACHSNON2,U,5) ;'IHS COST'
  1. S ACHSEOBR(ACHSREJ,9)=$P(ACHSNON2,U,6) ;'OBLIGATION INDICATOR'
  1. S ACHSEOBR(ACHSREJ,10)=$P(ACHSNON2,U,7) ;'OBLIGATION AMOUNT'
  1. S ACHSEOBR(ACHSREJ,11)=$P(ACHSNON2,U,8) ;'ADJUSTMENT AMOUNT'
  1. S ACHSEOBR(ACHSREJ,12)=$P(ACHSNON2,U,9) ;'DIAGNOSIS CODE 1'
  1. S ACHSEOBR(ACHSREJ,13)=$P(ACHSNON2,U,10) ;'DIAGNOSIS CODE 2'
  1. S ACHSEOBR(ACHSREJ,14)=$P(ACHSNON2,U,11) ;'DIAGNOSIS CODE 3'
  1. S ACHSEOBR(ACHSREJ,15)=$P(ACHSNON2,U,12) ;'DIAGNOSIS CODE 4'
  1. S ACHSEOBR(ACHSREJ,16)=$P(ACHSNON2,U,13) ;'DIAGNOSIS CODE 5'
  1. ;
  1. ;
  1. S ACHSEOBR("G",8)=$P(ACHSNON4,U) ;'PROCEDURE CODE 1'
  1. S ACHSEOBR("G",9)=$P(ACHSNON4,U,2) ;'PROCEDURE CODE 2'
  1. S ACHSEOBR("G",10)=$P(ACHSNON4,U,3) ;'PROCEDURE CODE 3'
  1. S ACHSEOBR("G",11)=$P(ACHSNON4,U,4) ;'PROCEDURE CODE 4' ;ACHS*3.1*23
  1. S ACHSEOBR("G",12)=$P(ACHSNON4,U,5) ;'PROCEDURE CODE 5' ;ACHS*3.1*23
  1. ;
  1. S ACHSCPT=0
  1. K ^TMP("ACHSEOB",$J)
  1. D ACHSF
  1. G END
  1. ;
  1. ACHSF ;
  1. S ACHSCPT=$O(^ACHSEOBE(ACHSNON,3,ACHSCPT))
  1. Q:ACHSCPT=""
  1. Q:+ACHSCPT<1
  1. S ^TMP("ACHSEOB",$J,"F",ACHSCPT)=$J(" ",22)_$E($P(^ACHSEOBE(ACHSNON,3,ACHSCPT,0),U,2),2,7)_$E($P(^(0),U,3),2,7)_$P(^(0),U,1)_$P(^(0),U,4)_$P(^(0),U,5)_$P(^(0),U,6)_$P(^(0),U,7)_$P(^(0),U,8)_$P(^(0),U,9)
  1. I $P(^ACHSEOBE(ACHSNON,3,ACHSCPT,0),U,7)[" " G ACHSF
  1. S ACHSEOBR("M","B",$P(^ACHSEOBE(ACHSNON,3,ACHSCPT,0),U,7))=""
  1. G ACHSF
  1. ;
  1. END ;
  1. Q
  1. ;