ACHSEOBM ; IHS/ITSC/TPF/PMF - BUILD CHS EOBR MESSAGE FILE ;
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**15,16,21,22**;JUN 11, 2001;Build 43
;ACHS*3.1*15 1.26.2009 IHS/OIT/FCJ REMOVED DLAYGO WHEN ADDING MESSAGES
;ACHS*3.1*16 IHS.OIT.FCJ FIXED DUPLICATE MESSAGE ISSUE
;
S (ACHSRCT,ACHSMCNT,ACHSMFLG)=0,ACHSOMSG=""
K ACHSAEND
U IO(0)
W !,"BUILDING CHS EOBR MESSAGE FILE...",!!
A1 ; Read past the FI header info at the top of the file.
U IO
;ACHS*3.1*21 CHANGED NEXT LINE TO TEST FOR OS
;F R ACHSEOBR:5 G:ACHSEOBR="" B0A S:ACHSISAO ACHSEOBR=$E(ACHSEOBR,3,85) S ACHSRCT=ACHSRCT+1 G:ACHSRCT>100 END1^ACHSEOB1 Q:$E(ACHSEOBR,1,2)="$$" ; note for SAC: this is a file read, not an interactive read
F R ACHSEOBR:5 G:ACHSEOBR="" B0A S:ACHSISAO ACHSEOBR=$S($$OS^ACHS=2:$E(ACHSEOBR,1,82),1:$E(ACHSEOBR,3,85)) S ACHSRCT=ACHSRCT+1 G:ACHSRCT>100 END1^ACHSEOB1 Q:$E(ACHSEOBR,1,2)="$$" ; note for SAC: this is a file read, not an interactive read
;
B0 ;
I +$E(ACHSEOBR,3,4)<1 G B0A
S ACHSRCT=0,X=$S(ACHSISAO=0:9,ACHSISAO=1:8),ACHSEOBD=$E(ACHSEOBR,3,X)
I 'ACHSISAO S ACHSEBSQ=+$P(ACHSEOBR," ",2)
;ACHS*3.1*22 MOD SEQ # TO READ ICD FOR ICD-9 FIX
;I ACHSISAO S X=ACHSEOBD,X=$E(X,5,6)_$E(X,1,4),ACHSEOBD=$S($E(X,1,2)>50:2,1:3)_X,ACHSAOSQ=+$P(ACHSEOBR," ",3)
I ACHSISAO S X=ACHSEOBD,X=$E(X,5,6)_$E(X,1,4),ACHSEOBD=$S($E(X,1,2)>50:2,1:3)_X,ACHSAOSQ=$S($P(ACHSEOBR," ",3)?1N.N:+$P(ACHSEOBR," ",3),1:$P(ACHSEOBR," ",3))
B2 ;
U IO
R ACHSEOBR:5 ;SAC-FILE READ
;I ACHSISAO S ACHSEOBR=$E(ACHSEOBR,3,85) ;ACHS*3.1*21
S:ACHSISAO ACHSEOBR=$S($$OS^ACHS=2:$E(ACHSEOBR,1,82),1:$E(ACHSEOBR,3,85)) ;ACHS*3.1*21
I ACHSRCT=1,$E(ACHSEOBR,1,2)="$$" U IO(0) W "NO MESSAGE RECORDS TO PROCESS" Q
S ACHSRCT=ACHSRCT+1
I $E(ACHSEOBR,1,2)="$$" G MSGEND
S ACHSSEQ=$E(ACHSEOBR,1,3),ACHSMSG=$E(ACHSEOBR,4,7)
I ACHSOMSG=ACHSMSG G B3
;ACHS*3.1*15 1.26.2009 IHS/OIT/FCJ REMOVED DLAYGO
;S DIC="^ACHSEOBM(",DIC(0)="ZML",X=ACHSMSG,DLAYGO=9002076
S DIC="^ACHSEOBM(",DIC(0)="ZML",X=ACHSMSG
U IO(0)
S Y="" ;ACHS*3.1*16 IHS.OIT.FCJ ADDED LINE
I $D(^ACHSEOBM("B",ACHSMSG)) S Y=$O(^ACHSEOBM("B",ACHSMSG,Y)) ;ACHS*3.1*16 IHS.OIT.FCJ NEW LINE CHANGED NXT LINE TO ELSE
E D ^DIC
;K DLAYGO ;ACHS*3.1*16 IHS.OIT.FCJ DLAYGO NO LONGER BEING SET
I +Y<1 U IO(0) W !,ACHSMSG," ADD TO EOBR MESSAGE FILE <FAILED> - NOTIFY SUPERVISOR" S ACHSTERR=1 D RTRN^ACHS G B2
S DA=+Y,ACHSMCNT=ACHSMCNT+1,ACHSMLN=0
U IO(0)
W $J(ACHSMSG,10)
K ^ACHSEOBM(DA,1) ; Remove old message text.
B3 ;
I 'ACHSISAO S ACHSM3=$E(ACHSEOBR,8,85) G B4
I ACHSSEQ#2'=0 S ACHSM1=$E(ACHSEOBR,8,46),ACHSOMSG=ACHSMSG G B2
S ACHSM2=$E(ACHSEOBR,8,46),ACHSM3=ACHSM1_ACHSM2
B4 ;
S ACHSMLN=ACHSMLN+1,^ACHSEOBM(DA,1,ACHSMLN,0)=$$SB^ACHS($$RPL^ACHS(ACHSM3," "," "))
S $P(^ACHSEOBM(DA,1,0),U,3,4)=ACHSMLN_U_ACHSMLN
S $P(^ACHSEOBM(DA,0),U,2)=DT,ACHSOMSG=ACHSMSG
G B2
;
MSGEND ;
U IO(0)
W !
Q:ACHSMCNT=0
W !!,ACHSMCNT," EOBR MESSAGES ADDED/UPDATED",!!
Q:'ACHSISAO
Q:+$$AOP^ACHS(2,9)=0
Q:ACHSAOSQ="ICD9" ;ACHS*3.1*22 FX FOR READIN OF ICD-9 FX FILE
I $$AOP^ACHS(2,9)="999" S $P(^ACHSAOP(DUZ(2),2),U,9)=0
I $$AOP^ACHS(2,9)+1'=ACHSAOSQ S ACHSMFLG=2
Q
;
FAC ;
I $D(^ACHSF(DUZ(2),17,"B",ACHSEOBD)) S ACHSMFLG=1 Q
S X=""
I ACHSFCSQ+1'=ACHSEBSQ S ACHSMFLG=2 Q
Q
;
B0A ;
U IO(0)
W *7,!,"PROCESSING ERROR ENCOUNTERED FOR EOBR FILE"
D RTRN^ACHS
S ACHSAEND=1 ;ACHS*3.1*21
G ABEND^ACHSEOB
;
ACHSEOBM ; IHS/ITSC/TPF/PMF - BUILD CHS EOBR MESSAGE FILE ;
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**15,16,21,22**;JUN 11, 2001;Build 43
+2 ;ACHS*3.1*15 1.26.2009 IHS/OIT/FCJ REMOVED DLAYGO WHEN ADDING MESSAGES
+3 ;ACHS*3.1*16 IHS.OIT.FCJ FIXED DUPLICATE MESSAGE ISSUE
+4 ;
+5 SET (ACHSRCT,ACHSMCNT,ACHSMFLG)=0
SET ACHSOMSG=""
+6 KILL ACHSAEND
+7 USE IO(0)
+8 WRITE !,"BUILDING CHS EOBR MESSAGE FILE...",!!
A1 ; Read past the FI header info at the top of the file.
+1 USE IO
+2 ;ACHS*3.1*21 CHANGED NEXT LINE TO TEST FOR OS
+3 ;F R ACHSEOBR:5 G:ACHSEOBR="" B0A S:ACHSISAO ACHSEOBR=$E(ACHSEOBR,3,85) S ACHSRCT=ACHSRCT+1 G:ACHSRCT>100 END1^ACHSEOB1 Q:$E(ACHSEOBR,1,2)="$$" ; note for SAC: this is a file read, not an interactive read
+4 ; note for SAC: this is a file read, not an interactive read
FOR
READ ACHSEOBR:5
IF ACHSEOBR=""
GOTO B0A
IF ACHSISAO
SET ACHSEOBR=$SELECT($$OS^ACHS=2:$E(ACHSEOBR,1,82),1:$EXTRACT(ACHSEOBR,3,85))
SET ACHSRCT=ACHSRCT+1
IF ACHSRCT>100
GOTO END1^ACHSEOB1
IF $EXTRACT(ACHSEOBR,1,2)="$$"
QUIT
+5 ;
B0 ;
+1 IF +$EXTRACT(ACHSEOBR,3,4)<1
GOTO B0A
+2 SET ACHSRCT=0
SET X=$SELECT(ACHSISAO=0:9,ACHSISAO=1:8)
SET ACHSEOBD=$EXTRACT(ACHSEOBR,3,X)
+3 IF 'ACHSISAO
SET ACHSEBSQ=+$PIECE(ACHSEOBR," ",2)
+4 ;ACHS*3.1*22 MOD SEQ # TO READ ICD FOR ICD-9 FIX
+5 ;I ACHSISAO S X=ACHSEOBD,X=$E(X,5,6)_$E(X,1,4),ACHSEOBD=$S($E(X,1,2)>50:2,1:3)_X,ACHSAOSQ=+$P(ACHSEOBR," ",3)
+6 IF ACHSISAO
SET X=ACHSEOBD
SET X=$EXTRACT(X,5,6)_$EXTRACT(X,1,4)
SET ACHSEOBD=$SELECT($EXTRACT(X,1,2)>50:2,1:3)_X
SET ACHSAOSQ=$SELECT($PIECE(ACHSEOBR," ",3)?1N.N:+$PIECE(ACHSEOBR," ",3),1:$PIECE(ACHSEOBR," ",3))
B2 ;
+1 USE IO
+2 ;SAC-FILE READ
READ ACHSEOBR:5
+3 ;I ACHSISAO S ACHSEOBR=$E(ACHSEOBR,3,85) ;ACHS*3.1*21
+4 ;ACHS*3.1*21
IF ACHSISAO
SET ACHSEOBR=$SELECT($$OS^ACHS=2:$E(ACHSEOBR,1,82),1:$EXTRACT(ACHSEOBR,3,85))
+5 IF ACHSRCT=1
IF $EXTRACT(ACHSEOBR,1,2)="$$"
USE IO(0)
WRITE "NO MESSAGE RECORDS TO PROCESS"
QUIT
+6 SET ACHSRCT=ACHSRCT+1
+7 IF $EXTRACT(ACHSEOBR,1,2)="$$"
GOTO MSGEND
+8 SET ACHSSEQ=$EXTRACT(ACHSEOBR,1,3)
SET ACHSMSG=$EXTRACT(ACHSEOBR,4,7)
+9 IF ACHSOMSG=ACHSMSG
GOTO B3
+10 ;ACHS*3.1*15 1.26.2009 IHS/OIT/FCJ REMOVED DLAYGO
+11 ;S DIC="^ACHSEOBM(",DIC(0)="ZML",X=ACHSMSG,DLAYGO=9002076
+12 SET DIC="^ACHSEOBM("
SET DIC(0)="ZML"
SET X=ACHSMSG
+13 USE IO(0)
+14 ;ACHS*3.1*16 IHS.OIT.FCJ ADDED LINE
SET Y=""
+15 ;ACHS*3.1*16 IHS.OIT.FCJ NEW LINE CHANGED NXT LINE TO ELSE
IF $DATA(^ACHSEOBM("B",ACHSMSG))
SET Y=$ORDER(^ACHSEOBM("B",ACHSMSG,Y))
+16 IF '$TEST
DO ^DIC
+17 ;K DLAYGO ;ACHS*3.1*16 IHS.OIT.FCJ DLAYGO NO LONGER BEING SET
+18 IF +Y<1
USE IO(0)
WRITE !,ACHSMSG," ADD TO EOBR MESSAGE FILE <FAILED> - NOTIFY SUPERVISOR"
SET ACHSTERR=1
DO RTRN^ACHS
GOTO B2
+19 SET DA=+Y
SET ACHSMCNT=ACHSMCNT+1
SET ACHSMLN=0
+20 USE IO(0)
+21 WRITE $JUSTIFY(ACHSMSG,10)
+22 ; Remove old message text.
KILL ^ACHSEOBM(DA,1)
B3 ;
+1 IF 'ACHSISAO
SET ACHSM3=$EXTRACT(ACHSEOBR,8,85)
GOTO B4
+2 IF ACHSSEQ#2'=0
SET ACHSM1=$EXTRACT(ACHSEOBR,8,46)
SET ACHSOMSG=ACHSMSG
GOTO B2
+3 SET ACHSM2=$EXTRACT(ACHSEOBR,8,46)
SET ACHSM3=ACHSM1_ACHSM2
B4 ;
+1 SET ACHSMLN=ACHSMLN+1
SET ^ACHSEOBM(DA,1,ACHSMLN,0)=$$SB^ACHS($$RPL^ACHS(ACHSM3," "," "))
+2 SET $PIECE(^ACHSEOBM(DA,1,0),U,3,4)=ACHSMLN_U_ACHSMLN
+3 SET $PIECE(^ACHSEOBM(DA,0),U,2)=DT
SET ACHSOMSG=ACHSMSG
+4 GOTO B2
+5 ;
MSGEND ;
+1 USE IO(0)
+2 WRITE !
+3 IF ACHSMCNT=0
QUIT
+4 WRITE !!,ACHSMCNT," EOBR MESSAGES ADDED/UPDATED",!!
+5 IF 'ACHSISAO
QUIT
+6 IF +$$AOP^ACHS(2,9)=0
QUIT
+7 ;ACHS*3.1*22 FX FOR READIN OF ICD-9 FX FILE
IF ACHSAOSQ="ICD9"
QUIT
+8 IF $$AOP^ACHS(2,9)="999"
SET $PIECE(^ACHSAOP(DUZ(2),2),U,9)=0
+9 IF $$AOP^ACHS(2,9)+1'=ACHSAOSQ
SET ACHSMFLG=2
+10 QUIT
+11 ;
FAC ;
+1 IF $DATA(^ACHSF(DUZ(2),17,"B",ACHSEOBD))
SET ACHSMFLG=1
QUIT
+2 SET X=""
+3 IF ACHSFCSQ+1'=ACHSEBSQ
SET ACHSMFLG=2
QUIT
+4 QUIT
+5 ;
B0A ;
+1 USE IO(0)
+2 WRITE *7,!,"PROCESSING ERROR ENCOUNTERED FOR EOBR FILE"
+3 DO RTRN^ACHS
+4 ;ACHS*3.1*21
SET ACHSAEND=1
+5 GOTO ABEND^ACHSEOB
+6 ;
