ACHSEOBD.m

ACHSEOBD ; IHS/ITSC/PMF - SET NODES IN NON-PROCESSED EOBR FILE ;    [ 10/16/2001   8:16 AM ]

 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;*23**;JUN 11, 2001;Build 43

 ;ACHS*3.1*23 Added the 4th and 5th procedure

 ;

 I '$D(^ACHSEOBE(0)) S ^ACHSEOBE(0)="CHS NON-PROCESSED EOBRS^9002065^0^0"

 S ACHSNON=$P($G(^ACHSEOBE(0)),U,3)+1

 S $P(^ACHSEOBE(0),U,3)=ACHSNON

 S ACHSNON1=$P($G(^ACHSEOBE(0)),U,4)+1

 S $P(^ACHSEOBE(0),U,4)=ACHSNON1

 ;

 S ^ACHSEOBE(ACHSNON,0)=ACHSEOBR("A",12)_"^"_ACHSEOBR("A",1)_"^"_ACHSEOBR("A",2)_"^"_ACHSEOBR("A",5)_"^"_ACHSEOBR("A",8)

 ;

 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)

 ;

 S ^ACHSEOBE(ACHSNON,1)=ACHSEOBR("B",8)_"^"_ACHSEOBR("B",9)_"^"_ACHSEOBR("B",10)_"^"_ACHSEOBR("B",11)_"^"_ACHSEOBR("B",12)

 ;

 S ^ACHSEOBE(ACHSNON,1)=$G(^ACHSEOBE(ACHSNON,1))_"^"_ACHSEOBR("C",8)_"^"_ACHSEOBR("C",9)_"^"_ACHSEOBR("C",10)_"^"_ACHSEOBR("C",11)_"^"_ACHSEOBR("C",12)

 ;

 S ^ACHSEOBE(ACHSNON,1)=$G(^ACHSEOBE(ACHSNON,1))_"^"_$G(ACHSEOBR("C",14))_"^"_$G(ACHSEOBR("C",15))_"^"_ACHSEOBR("C",16)_"^"_ACHSEOBR("C",13)

 ;

 S ^ACHSEOBE(ACHSNON,2)=ACHSEOBR("D",8)_"^"_ACHSEOBR("D",9)_"^"_ACHSEOBR("D",10)_"^"_ACHSEOBR("D",11)

 ;

 ;ACHS*3.1*23 CHG "E" TO VAR ACHSREJ FOR REC E OR J AND ADDED ACHSREJ IN P

 S ^ACHSEOBE(ACHSNON,2)=$G(^ACHSEOBE(ACHSNON,2))_"^"_ACHSEOBR(ACHSREJ,8)_"^"_ACHSEOBR(ACHSREJ,9)_"^"_ACHSEOBR(ACHSREJ,10)

 ;

 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

 ;

 ;I $D(ACHSEOBR("G")) S ^ACHSEOBE(ACHSNON,4)=ACHSEOBR("G",8)_"^"_ACHSEOBR("G",9)_"^"_ACHSEOBR("G",10)  ;ACHS*3.1*23

 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

 ;

 I '$D(^ACHSEOBE(ACHSNON,3,0)) S ^ACHSEOBE(ACHSNON,3,0)="CPT PROCEDURES^9002065.037^0^0"

 N ACHS,ACHSBR,ACHSCLM

 S ACHSPO=ACHSEOBR("A",12),(ACHS,ACHSBR,ACHSCLM)=0

 S ACHSCPT=$P($G(^ACHSEOBE(ACHSNON,3,0)),U,3)

F ;

 S ACHSBR=$O(^ACHSEOBR("P",ACHSPO,ACHSBR))

 G F3:ACHSBR=""

F1 ;

 S ACHSEOBR=^ACHSEOBR(ACHSZFPT,ACHSBR)

 I $E(ACHSEOBR,19)'="F" S ACHSBR=ACHSBR+1 G F1

 G F:ACHSCLM'=0&$E(ACHSEOBR,9,18)'=ACHSCLM

 D F2

 S ACHSBR=ACHSBR+1,ACHSCLM=$E(ACHSEOBR,9,18)

 G F1

 ;

F2 ;

 S ACHS=ACHS+1,^TMP("ACHSEOB",$J,"F",ACHS)=ACHSEOBR

 Q

 ;

F3 ;

 S ACHSCPT=ACHSCPT+1

 S ACHS=$O(^TMP("ACHSEOB",$J,"F",ACHS)) G END:'ACHS S ACHSX=^(ACHS)

 ;BEGIN Y2K BLOCK

 ;S F=$E(ACHSX,35,39)_"^"_2_$E(ACHSX,23,28)_"^"_2_$E(ACHSX,29,34)

 ;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)

 K ACHSTEMP D REC2^ACHSEOBB(ACHSX,.ACHSTEMP)

 S F=ACHSTEMP("F",10)_"^"_ACHSTEMP("F",8)_"^"_ACHSTEMP("F",9)

 S F=F_"^"_ACHSTEMP("F",11)_"^"_ACHSTEMP("F",12)_"^"_ACHSTEMP("F",13)

 S F=F_"^"_ACHSTEMP("F",14)_"^"_ACHSTEMP("F",15)_"^"_ACHSTEMP("F",16)

 ;END Y2K BLOCK

 S $P(^ACHSEOBE(ACHSNON,3,0),U,3)=ACHSCPT,$P(^(0),U,4)=ACHSCPT

 S ^ACHSEOBE(ACHSNON,3,ACHSCPT,0)=F

 G F3

 ;

END ;

 S DIK="^ACHSEOBE(",DA=ACHSNON

 D IX1^DIK

 K ACHSNON,ACHSCPT,F,ACHSX

 Q

 ;

DFN ;

 ;I don't think that this module is ever used

 ;   4/11/01     pmf

 ;

 S DFN=$O(^AUPNPAT("D",X,DFN))

 I DFN="" S DFN=ACHSEOBR("B",8) Q

 I $D(^AUPNPAT("D",X,DFN,DUZ(2))) Q

 G DFN

 ;

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

 +2       ;ACHS*3.1*23 Added the 4th and 5th procedure

 +3       ;

 +4        IF '$DATA(^ACHSEOBE(0))

               SET ^ACHSEOBE(0)="CHS NON-PROCESSED EOBRS^9002065^0^0"

 +5        SET ACHSNON=$PIECE($GET(^ACHSEOBE(0)),U,3)+1

 +6        SET $PIECE(^ACHSEOBE(0),U,3)=ACHSNON

 +7        SET ACHSNON1=$PIECE($GET(^ACHSEOBE(0)),U,4)+1

 +8        SET $PIECE(^ACHSEOBE(0),U,4)=ACHSNON1

 +9       ;

 +10       SET ^ACHSEOBE(ACHSNON,0)=ACHSEOBR("A",12)_"^"_ACHSEOBR("A",1)_"^"_ACHSEOBR("A",2)_"^"_ACHSEOBR("A",5)_"^"_ACHSEOBR("A",8)

 +11      ;

 +12       SET ^ACHSEOBE(ACHSNON,0)=$GET(^ACHSEOBE(ACHSNON,0))_"^"_ACHSEOBR("A",9)_"^"_ACHSEOBR("A",10)_"^"_ACHSEOBR("A",11)_"^"_ACHSEOBR("A",13)_"^"_ACHSEOBR("A",14)_"^"_ACHSEOBR("A",15)

 +13      ;

 +14       SET ^ACHSEOBE(ACHSNON,1)=ACHSEOBR("B",8)_"^"_ACHSEOBR("B",9)_"^"_ACHSEOBR("B",10)_"^"_ACHSEOBR("B",11)_"^"_ACHSEOBR("B",12)

 +15      ;

 +16       SET ^ACHSEOBE(ACHSNON,1)=$GET(^ACHSEOBE(ACHSNON,1))_"^"_ACHSEOBR("C",8)_"^"_ACHSEOBR("C",9)_"^"_ACHSEOBR("C",10)_"^"_ACHSEOBR("C",11)_"^"_ACHSEOBR("C",12)

 +17      ;

 +18       SET ^ACHSEOBE(ACHSNON,1)=$GET(^ACHSEOBE(ACHSNON,1))_"^"_$GET(ACHSEOBR("C",14))_"^"_$GET(ACHSEOBR("C",15))_"^"_ACHSEOBR("C",16)_"^"_ACHSEOBR("C",13)

 +19      ;

 +20       SET ^ACHSEOBE(ACHSNON,2)=ACHSEOBR("D",8)_"^"_ACHSEOBR("D",9)_"^"_ACHSEOBR("D",10)_"^"_ACHSEOBR("D",11)

 +21      ;

 +22      ;ACHS*3.1*23 CHG "E" TO VAR ACHSREJ FOR REC E OR J AND ADDED ACHSREJ IN P

 +23       SET ^ACHSEOBE(ACHSNON,2)=$GET(^ACHSEOBE(ACHSNON,2))_"^"_ACHSEOBR(ACHSREJ,8)_"^"_ACHSEOBR(ACHSREJ,9)_"^"_ACHSEOBR(ACHSREJ,10)

 +24      ;

 +25       SET ^ACHSEOBE(ACHSNON,2)=$GET(^ACHSEOBE(ACHSNON,2))_"^"_ACHSEOBR(ACHSREJ,11)_"^"_ACHSEOBR(ACHSREJ,12)_"^"_ACHSEOBR(ACHSREJ,13)_"^"_ACHSEOBR(ACHSREJ,14)_"^"_$GET(ACHSEOBR(ACHSREJ,15))_"^"_$GET(ACHSEOBR(ACHSREJ,16))_"^"_ACHSREJ

 +26      ;

 +27      ;I $D(ACHSEOBR("G")) S ^ACHSEOBE(ACHSNON,4)=ACHSEOBR("G",8)_"^"_ACHSEOBR("G",9)_"^"_ACHSEOBR("G",10)  ;ACHS*3.1*23

 +28      ;ACHS*3.1*23

           IF $DATA(ACHSEOBR("G"))

               SET ^ACHSEOBE(ACHSNON,4)=ACHSEOBR("G",8)_"^"_ACHSEOBR("G",9)_"^"_ACHSEOBR("G",10)_"^"_$GET(ACHSEOBR("G",11))_"^"_$GET(ACHSEOBR("G",12))

 +29      ;

 +30       IF '$DATA(^ACHSEOBE(ACHSNON,3,0))

               SET ^ACHSEOBE(ACHSNON,3,0)="CPT PROCEDURES^9002065.037^0^0"

 +31       NEW ACHS,ACHSBR,ACHSCLM

 +32       SET ACHSPO=ACHSEOBR("A",12)

           SET (ACHS,ACHSBR,ACHSCLM)=0

 +33       SET ACHSCPT=$PIECE($GET(^ACHSEOBE(ACHSNON,3,0)),U,3)

F         ;

 +1        SET ACHSBR=$ORDER(^ACHSEOBR("P",ACHSPO,ACHSBR))

 +2        IF ACHSBR=""

               GOTO F3

F1        ;

 +1        SET ACHSEOBR=^ACHSEOBR(ACHSZFPT,ACHSBR)

 +2        IF $EXTRACT(ACHSEOBR,19)'="F"

               SET ACHSBR=ACHSBR+1

               GOTO F1

 +3        IF ACHSCLM'=0&$EXTRACT(ACHSEOBR,9,18)'=ACHSCLM

               GOTO F

 +4        DO F2

 +5        SET ACHSBR=ACHSBR+1

           SET ACHSCLM=$EXTRACT(ACHSEOBR,9,18)

 +6        GOTO F1

 +7       ;

F2        ;

 +1        SET ACHS=ACHS+1

           SET ^TMP("ACHSEOB",$JOB,"F",ACHS)=ACHSEOBR

 +2        QUIT 

 +3       ;

F3        ;

 +1        SET ACHSCPT=ACHSCPT+1

 +2        SET ACHS=$ORDER(^TMP("ACHSEOB",$JOB,"F",ACHS))

           IF 'ACHS

               GOTO END

           SET ACHSX=^(ACHS)

 +3       ;BEGIN Y2K BLOCK

 +4       ;S F=$E(ACHSX,35,39)_"^"_2_$E(ACHSX,23,28)_"^"_2_$E(ACHSX,29,34)

 +5       ;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)

 +6        KILL ACHSTEMP

           DO REC2^ACHSEOBB(ACHSX,.ACHSTEMP)

 +7        SET F=ACHSTEMP("F",10)_"^"_ACHSTEMP("F",8)_"^"_ACHSTEMP("F",9)

 +8        SET F=F_"^"_ACHSTEMP("F",11)_"^"_ACHSTEMP("F",12)_"^"_ACHSTEMP("F",13)

 +9        SET F=F_"^"_ACHSTEMP("F",14)_"^"_ACHSTEMP("F",15)_"^"_ACHSTEMP("F",16)

 +10      ;END Y2K BLOCK

 +11       SET $PIECE(^ACHSEOBE(ACHSNON,3,0),U,3)=ACHSCPT

           SET $PIECE(^(0),U,4)=ACHSCPT

 +12       SET ^ACHSEOBE(ACHSNON,3,ACHSCPT,0)=F

 +13       GOTO F3

 +14      ;

END       ;

 +1        SET DIK="^ACHSEOBE("

           SET DA=ACHSNON

 +2        DO IX1^DIK

 +3        KILL ACHSNON,ACHSCPT,F,ACHSX

 +4        QUIT 

 +5       ;

DFN       ;

 +1       ;I don't think that this module is ever used

 +2       ;   4/11/01     pmf

 +3       ;

 +4        SET DFN=$ORDER(^AUPNPAT("D",X,DFN))

 +5        IF DFN=""

               SET DFN=ACHSEOBR("B",8)

               QUIT 

 +6        IF $DATA(^AUPNPAT("D",X,DFN,DUZ(2)))

               QUIT 

 +7        GOTO DFN

 +8       ;