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