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

ACHSEOBD.m

Go to the documentation of this file. 
  1. ACHSEOBD ; IHS/ITSC/PMF - SET NODES IN NON-PROCESSED EOBR 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 the 4th and 5th procedure
  1.  ;
  1.  I '$D(^ACHSEOBE(0)) S ^ACHSEOBE(0)="CHS NON-PROCESSED EOBRS^9002065^0^0"
  1.  S ACHSNON=$P($G(^ACHSEOBE(0)),U,3)+1
  1.  S $P(^ACHSEOBE(0),U,3)=ACHSNON
  1.  S ACHSNON1=$P($G(^ACHSEOBE(0)),U,4)+1
  1.  S $P(^ACHSEOBE(0),U,4)=ACHSNON1
  1.  ;
  1.  S ^ACHSEOBE(ACHSNON,0)=ACHSEOBR("A",12)_"^"_ACHSEOBR("A",1)_"^"_ACHSEOBR("A",2)_"^"_ACHSEOBR("A",5)_"^"_ACHSEOBR("A",8)
  1.  ;
  1.  S ^ACHSEOBE(ACHSNON,0)=$G(^ACHSEOBE(ACHSNON,0))_"^"_ACHSEOBR("A",9)_"^"_ACHSEOBR("A",10)_"^"_ACHSEOBR("A",11)_"^"_ACHSEOBR("A",13)_"^"_ACHSEOBR("A",14)_"^"_ACHSEOBR("A",15)
  1.  ;
  1.  S ^ACHSEOBE(ACHSNON,1)=ACHSEOBR("B",8)_"^"_ACHSEOBR("B",9)_"^"_ACHSEOBR("B",10)_"^"_ACHSEOBR("B",11)_"^"_ACHSEOBR("B",12)
  1.  ;
  1.  S ^ACHSEOBE(ACHSNON,1)=$G(^ACHSEOBE(ACHSNON,1))_"^"_ACHSEOBR("C",8)_"^"_ACHSEOBR("C",9)_"^"_ACHSEOBR("C",10)_"^"_ACHSEOBR("C",11)_"^"_ACHSEOBR("C",12)
  1.  ;
  1.  S ^ACHSEOBE(ACHSNON,1)=$G(^ACHSEOBE(ACHSNON,1))_"^"_$G(ACHSEOBR("C",14))_"^"_$G(ACHSEOBR("C",15))_"^"_ACHSEOBR("C",16)_"^"_ACHSEOBR("C",13)
  1.  ;
  1.  S ^ACHSEOBE(ACHSNON,2)=ACHSEOBR("D",8)_"^"_ACHSEOBR("D",9)_"^"_ACHSEOBR("D",10)_"^"_ACHSEOBR("D",11)
  1.  ;
  1.  ;ACHS*3.1*23 CHG "E" TO VAR ACHSREJ FOR REC E OR J AND ADDED ACHSREJ IN P
  1.  S ^ACHSEOBE(ACHSNON,2)=$G(^ACHSEOBE(ACHSNON,2))_"^"_ACHSEOBR(ACHSREJ,8)_"^"_ACHSEOBR(ACHSREJ,9)_"^"_ACHSEOBR(ACHSREJ,10)
  1.  ;
  1.  S ^ACHSEOBE(ACHSNON,2)=$G(^ACHSEOBE(ACHSNON,2))_"^"_ACHSEOBR(ACHSREJ,11)_"^"_ACHSEOBR(ACHSREJ,12)_"^"_ACHSEOBR(ACHSREJ,13)_"^"_ACHSEOBR(ACHSREJ,14)_"^"_$G(ACHSEOBR(ACHSREJ,15))_"^"_$G(ACHSEOBR(ACHSREJ,16))_"^"_ACHSREJ
  1.  ;
  1.  ;I $D(ACHSEOBR("G")) S ^ACHSEOBE(ACHSNON,4)=ACHSEOBR("G",8)_"^"_ACHSEOBR("G",9)_"^"_ACHSEOBR("G",10)  ;ACHS*3.1*23
  1.  I $D(ACHSEOBR("G")) S ^ACHSEOBE(ACHSNON,4)=ACHSEOBR("G",8)_"^"_ACHSEOBR("G",9)_"^"_ACHSEOBR("G",10)_"^"_$G(ACHSEOBR("G",11))_"^"_$G(ACHSEOBR("G",12)) ;ACHS*3.1*23
  1.  ;
  1.  I '$D(^ACHSEOBE(ACHSNON,3,0)) S ^ACHSEOBE(ACHSNON,3,0)="CPT PROCEDURES^9002065.037^0^0"
  1.  N ACHS,ACHSBR,ACHSCLM
  1.  S ACHSPO=ACHSEOBR("A",12),(ACHS,ACHSBR,ACHSCLM)=0
  1.  S ACHSCPT=$P($G(^ACHSEOBE(ACHSNON,3,0)),U,3)
  1. F ;
  1.  S ACHSBR=$O(^ACHSEOBR("P",ACHSPO,ACHSBR))
  1.  G F3:ACHSBR=""
  1. F1 ;
  1.  S ACHSEOBR=^ACHSEOBR(ACHSZFPT,ACHSBR)
  1.  I $E(ACHSEOBR,19)'="F" S ACHSBR=ACHSBR+1 G F1
  1.  G F:ACHSCLM'=0&$E(ACHSEOBR,9,18)'=ACHSCLM
  1.  D F2
  1.  S ACHSBR=ACHSBR+1,ACHSCLM=$E(ACHSEOBR,9,18)
  1.  G F1
  1.  ;
  1. F2 ;
  1.  S ACHS=ACHS+1,^TMP("ACHSEOB",$J,"F",ACHS)=ACHSEOBR
  1.  Q
  1.  ;
  1. F3 ;
  1.  S ACHSCPT=ACHSCPT+1
  1.  S ACHS=$O(^TMP("ACHSEOB",$J,"F",ACHS)) G END:'ACHS S ACHSX=^(ACHS)
  1.  ;BEGIN Y2K BLOCK
  1.  ;S F=$E(ACHSX,35,39)_"^"_2_$E(ACHSX,23,28)_"^"_2_$E(ACHSX,29,34)
  1.  ;S F=F_"^"_$E(ACHSX,40,42)_"^"_$E(ACHSX,43,51)_"^"_$E(ACHSX,52,60)_"^"_$E(ACHSX,61,64)_"^"_$E(ACHSX,65,66)_"^"_$E(ACHSX,67,71)
  1.  K ACHSTEMP D REC2^ACHSEOBB(ACHSX,.ACHSTEMP)
  1.  S F=ACHSTEMP("F",10)_"^"_ACHSTEMP("F",8)_"^"_ACHSTEMP("F",9)
  1.  S F=F_"^"_ACHSTEMP("F",11)_"^"_ACHSTEMP("F",12)_"^"_ACHSTEMP("F",13)
  1.  S F=F_"^"_ACHSTEMP("F",14)_"^"_ACHSTEMP("F",15)_"^"_ACHSTEMP("F",16)
  1.  ;END Y2K BLOCK
  1.  S $P(^ACHSEOBE(ACHSNON,3,0),U,3)=ACHSCPT,$P(^(0),U,4)=ACHSCPT
  1.  S ^ACHSEOBE(ACHSNON,3,ACHSCPT,0)=F
  1.  G F3
  1.  ;
  1. END ;
  1.  S DIK="^ACHSEOBE(",DA=ACHSNON
  1.  D IX1^DIK
  1.  K ACHSNON,ACHSCPT,F,ACHSX
  1.  Q
  1.  ;
  1. DFN ;
  1.  ;I don't think that this module is ever used
  1.  ;   4/11/01     pmf
  1.  ;
  1.  S DFN=$O(^AUPNPAT("D",X,DFN))
  1.  I DFN="" S DFN=ACHSEOBR("B",8) Q
  1.  I $D(^AUPNPAT("D",X,DFN,DUZ(2))) Q
  1.  G DFN
  1.  ;