ABMDERR ; IHS/ASDST/DMJ - ERROR PROCESSOR ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;
; IHS/DID/DMJ - 5/6/1999 - NOIS QAA-0599-130004 Patch 1
; not setting zero node under site
; multiple fixed at line EDIT+5
;
Q:$D(ABMP("WORKSHEET"))
S ABME("L")="",$P(ABME("L"),"-",80)=""
I '$D(ABME("CHK")) W !,ABME("L")
I $D(ABME("CHK")),$D(ABME("TITL")) W !?(80-$L(ABME("TITL"))\2),ABME("TITL"),!
S ABME="" F ABME("I")=1:1 S ABME=$O(ABME(ABME)) Q:'ABME D:$Y>(IOSL-5) EOP Q:$D(DUOUT)!$D(DIROUT)!$D(DQOUT) D WRT
I ABME("I")>1 W !,ABME("L")
G XIT:$D(DUOUT)!$D(DIROUT)!$D(DQOUT),XIT2:$D(ABME("CONT"))
I '$D(ABME("CHK")) D HLP
G XIT
;
WRT Q:'$D(^ABMDERR(ABME,0))!'$G(ABMP("INS"))
S ABME("COND")=$P($G(^ABMDERR(ABME,31,DUZ(2),0)),"^",3)
I ABME("COND")="",$D(^ABMDERR(ABME,11,ABMP("INS"))) S ABME("COND")="E"
I ABME("COND")="",'$G(ABMP("EXP")) S ABME("COND")="W"
I ABME("COND")="",$D(^ABMDERR(ABME,21,+$G(ABMP("EXP")),0)) S ABME("COND")="E"
S:ABME("COND")="" ABME("COND")=$P(^ABMDERR(ABME,0),"^",3)
S:ABME("COND")="" ABME("COND")="W"
I ABME("COND")="W",$P($G(^ABMDERR(ABME,31,DUZ(2),0)),U,4) S ABME("I")=ABME("I")-1 Q
W !,$S(ABME("COND")="E":" ERROR:",1:"WARNING:")
W $E(ABME+1000,2,4)," - ",$P(^ABMDERR(ABME,0),U)
W:$P(ABME(ABME),U)]"" " (",$P(ABME(ABME),U),")"
I $G(ABMP("INS"))]"",$D(ABMC("CTR")) D
.Q:ABME("COND")'="E"
.S ABMC("CTR")=ABMC("CTR")+1
Q
;
EOP D PAUSE^ABMDE1
Q
;
QUE ;EP for Errors when Queued
S ABME="" F ABME("I")=1:1 S ABME=$O(ABME(ABME)) Q:'ABME I $P($G(^ABMDERR(ABME,31,DUZ(2),0)),U,3)="E" S ABMC("CTR")=ABMC("CTR")+1 Q
;
XIT K ABME
XIT2 K DIRUT,DIROUT,DUOUT Q
;
CNT ;EP for counting errors
S ABME="" F ABME("I")=1:1 S ABME=$O(ABME(ABME)) Q:'ABME
S ABM("ERR")=ABME("I")-1
G XIT2
;
HLP ;EP for Correctivce Action Prompt
K DIR W ! S DIR("A")=" Enter ERROR/WARNING NUMBER for CORRECTIVE ACTION (if Desired)",DIR(0)="FO^1:3",DIR("?")="RETURN to continue or ERROR NUMBER to display the Corrective Action"
D ^DIR K DIR
I $D(DIROUT)!$D(DIRUT) G XIT2
I '$D(^ABMDERR(+Y,0)) W *7,!,"INVALID ENTRY: ",X," is not Defined in the Error File!" G HLP
D SHOW G HLP
;
SHOW W !! S ABME("HD")="("_$S($P($G(^ABMDERR(+Y,31,DUZ(2),0)),U,3)="E":"ERROR:",1:"WARNING:")_X_" "_$P(^ABMDERR(+Y,0),U,1)_")" W ?(80-$L(ABME("HD"))\2),ABME("HD")
S ABME("L")="",$P(ABME("L"),"-",80)=""
W !,ABME("L")
W !,"Corrective Action:"
S ABMU("LM")=20,ABMU("RM")=79
S ABMU("TXT")=$P(^ABMDERR(+Y,0),U,2)
D ^ABMDWRAP
W !,ABME("L")
Q
;
LIST S ABMP("EOP")=$Y+16,Y=0 F S Y=$O(^ABMDERR(Y)) Q:'Y S X=Y D SHOW,EOP I $D(DUOUT)!$D(DTOUT)!$D(DIROUT) Q
Q
EDIT ;EP - EDIT ENTRIES
W !
S DIC="^ABMDERR(",DIC(0)="AEMQ",DIC("S")="I '$P(^(0),""^"",5)" D ^DIC K DIC Q:Y<0 D
.S DA(1)=+Y
.S DIE="^ABMDERR("_DA(1)_",31,",DA=DUZ(2),DR=".03;.04"
.S:'$D(^ABMDERR(DA(1),31,DA,0)) ^(0)=DA,^ABMDERR(DA(1),31,"B",DA,DA)=""
.D ^DIE
.S DA=DA(1),DR="11;21",DIE="^ABMDERR(" D ^DIE
Q
ABMDERR ; IHS/ASDST/DMJ - ERROR PROCESSOR ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;
+3 ; IHS/DID/DMJ - 5/6/1999 - NOIS QAA-0599-130004 Patch 1
+4 ; not setting zero node under site
+5 ; multiple fixed at line EDIT+5
+6 ;
+7 IF $DATA(ABMP("WORKSHEET"))
QUIT
+8 SET ABME("L")=""
SET $PIECE(ABME("L"),"-",80)=""
+9 IF '$DATA(ABME("CHK"))
WRITE !,ABME("L")
+10 IF $DATA(ABME("CHK"))
IF $DATA(ABME("TITL"))
WRITE !?(80-$LENGTH(ABME("TITL"))\2),ABME("TITL"),!
+11 SET ABME=""
FOR ABME("I")=1:1
SET ABME=$ORDER(ABME(ABME))
IF 'ABME
QUIT
IF $Y>(IOSL-5)
DO EOP
IF $DATA(DUOUT)!$DATA(DIROUT)!$DATA(DQOUT)
QUIT
DO WRT
+12 IF ABME("I")>1
WRITE !,ABME("L")
+13 IF $DATA(DUOUT)!$DATA(DIROUT)!$DATA(DQOUT)
GOTO XIT
IF $DATA(ABME("CONT"))
GOTO XIT2
+14 IF '$DATA(ABME("CHK"))
DO HLP
+15 GOTO XIT
+16 ;
WRT IF '$DATA(^ABMDERR(ABME,0))!'$GET(ABMP("INS"))
QUIT
+1 SET ABME("COND")=$PIECE($GET(^ABMDERR(ABME,31,DUZ(2),0)),"^",3)
+2 IF ABME("COND")=""
IF $DATA(^ABMDERR(ABME,11,ABMP("INS")))
SET ABME("COND")="E"
+3 IF ABME("COND")=""
IF '$GET(ABMP("EXP"))
SET ABME("COND")="W"
+4 IF ABME("COND")=""
IF $DATA(^ABMDERR(ABME,21,+$GET(ABMP("EXP")),0))
SET ABME("COND")="E"
+5 IF ABME("COND")=""
SET ABME("COND")=$PIECE(^ABMDERR(ABME,0),"^",3)
+6 IF ABME("COND")=""
SET ABME("COND")="W"
+7 IF ABME("COND")="W"
IF $PIECE($GET(^ABMDERR(ABME,31,DUZ(2),0)),U,4)
SET ABME("I")=ABME("I")-1
QUIT
+8 WRITE !,$SELECT(ABME("COND")="E":" ERROR:",1:"WARNING:")
+9 WRITE $EXTRACT(ABME+1000,2,4)," - ",$PIECE(^ABMDERR(ABME,0),U)
+10 IF $PIECE(ABME(ABME),U)]""
WRITE " (",$PIECE(ABME(ABME),U),")"
+11 IF $GET(ABMP("INS"))]""
IF $DATA(ABMC("CTR"))
Begin DoDot:1
+12 IF ABME("COND")'="E"
QUIT
+13 SET ABMC("CTR")=ABMC("CTR")+1
End DoDot:1
+14 QUIT
+15 ;
EOP DO PAUSE^ABMDE1
+1 QUIT
+2 ;
QUE ;EP for Errors when Queued
+1 SET ABME=""
FOR ABME("I")=1:1
SET ABME=$ORDER(ABME(ABME))
IF 'ABME
QUIT
IF $PIECE($GET(^ABMDERR(ABME,31,DUZ(2),0)),U,3)="E"
SET ABMC("CTR")=ABMC("CTR")+1
QUIT
+2 ;
XIT KILL ABME
XIT2 KILL DIRUT,DIROUT,DUOUT
QUIT
+1 ;
CNT ;EP for counting errors
+1 SET ABME=""
FOR ABME("I")=1:1
SET ABME=$ORDER(ABME(ABME))
IF 'ABME
QUIT
+2 SET ABM("ERR")=ABME("I")-1
+3 GOTO XIT2
+4 ;
HLP ;EP for Correctivce Action Prompt
+1 KILL DIR
WRITE !
SET DIR("A")=" Enter ERROR/WARNING NUMBER for CORRECTIVE ACTION (if Desired)"
SET DIR(0)="FO^1:3"
SET DIR("?")="RETURN to continue or ERROR NUMBER to display the Corrective Action"
+2 DO ^DIR
KILL DIR
+3 IF $DATA(DIROUT)!$DATA(DIRUT)
GOTO XIT2
+4 IF '$DATA(^ABMDERR(+Y,0))
WRITE *7,!,"INVALID ENTRY: ",X," is not Defined in the Error File!"
GOTO HLP
+5 DO SHOW
GOTO HLP
+6 ;
SHOW WRITE !!
SET ABME("HD")="("_$SELECT($PIECE($GET(^ABMDERR(+Y,31,DUZ(2),0)),U,3)="E":"ERROR:",1:"WARNING:")_X_" "_$PIECE(^ABMDERR(+Y,0),U,1)_")"
WRITE ?(80-$LENGTH(ABME("HD"))\2),ABME("HD")
+1 SET ABME("L")=""
SET $PIECE(ABME("L"),"-",80)=""
+2 WRITE !,ABME("L")
+3 WRITE !,"Corrective Action:"
+4 SET ABMU("LM")=20
SET ABMU("RM")=79
+5 SET ABMU("TXT")=$PIECE(^ABMDERR(+Y,0),U,2)
+6 DO ^ABMDWRAP
+7 WRITE !,ABME("L")
+8 QUIT
+9 ;
LIST SET ABMP("EOP")=$Y+16
SET Y=0
FOR
SET Y=$ORDER(^ABMDERR(Y))
IF 'Y
QUIT
SET X=Y
DO SHOW
DO EOP
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
QUIT
+1 QUIT
EDIT ;EP - EDIT ENTRIES
+1 WRITE !
+2 SET DIC="^ABMDERR("
SET DIC(0)="AEMQ"
SET DIC("S")="I '$P(^(0),""^"",5)"
DO ^DIC
KILL DIC
IF Y<0
QUIT
Begin DoDot:1
+3 SET DA(1)=+Y
+4 SET DIE="^ABMDERR("_DA(1)_",31,"
SET DA=DUZ(2)
SET DR=".03;.04"
+5 IF '$DATA(^ABMDERR(DA(1),31,DA,0))
SET ^(0)=DA
SET ^ABMDERR(DA(1),31,"B",DA,DA)=""
+6 DO ^DIE
+7 SET DA=DA(1)
SET DR="11;21"
SET DIE="^ABMDERR("
DO ^DIE
End DoDot:1
+8 QUIT
