- 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