Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABMDERR

ABMDERR.m

Go to the documentation of this file.
  1. ABMDERR ; IHS/ASDST/DMJ - ERROR PROCESSOR ;
  1. ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
  1. ;
  1. ; IHS/DID/DMJ - 5/6/1999 - NOIS QAA-0599-130004 Patch 1
  1. ; not setting zero node under site
  1. ; multiple fixed at line EDIT+5
  1. ;
  1. Q:$D(ABMP("WORKSHEET"))
  1. S ABME("L")="",$P(ABME("L"),"-",80)=""
  1. I '$D(ABME("CHK")) W !,ABME("L")
  1. I $D(ABME("CHK")),$D(ABME("TITL")) W !?(80-$L(ABME("TITL"))\2),ABME("TITL"),!
  1. 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
  1. I ABME("I")>1 W !,ABME("L")
  1. G XIT:$D(DUOUT)!$D(DIROUT)!$D(DQOUT),XIT2:$D(ABME("CONT"))
  1. I '$D(ABME("CHK")) D HLP
  1. G XIT
  1. ;
  1. WRT Q:'$D(^ABMDERR(ABME,0))!'$G(ABMP("INS"))
  1. S ABME("COND")=$P($G(^ABMDERR(ABME,31,DUZ(2),0)),"^",3)
  1. I ABME("COND")="",$D(^ABMDERR(ABME,11,ABMP("INS"))) S ABME("COND")="E"
  1. I ABME("COND")="",'$G(ABMP("EXP")) S ABME("COND")="W"
  1. I ABME("COND")="",$D(^ABMDERR(ABME,21,+$G(ABMP("EXP")),0)) S ABME("COND")="E"
  1. S:ABME("COND")="" ABME("COND")=$P(^ABMDERR(ABME,0),"^",3)
  1. S:ABME("COND")="" ABME("COND")="W"
  1. I ABME("COND")="W",$P($G(^ABMDERR(ABME,31,DUZ(2),0)),U,4) S ABME("I")=ABME("I")-1 Q
  1. W !,$S(ABME("COND")="E":" ERROR:",1:"WARNING:")
  1. W $E(ABME+1000,2,4)," - ",$P(^ABMDERR(ABME,0),U)
  1. W:$P(ABME(ABME),U)]"" " (",$P(ABME(ABME),U),")"
  1. I $G(ABMP("INS"))]"",$D(ABMC("CTR")) D
  1. .Q:ABME("COND")'="E"
  1. .S ABMC("CTR")=ABMC("CTR")+1
  1. Q
  1. ;
  1. EOP D PAUSE^ABMDE1
  1. Q
  1. ;
  1. QUE ;EP for Errors when Queued
  1. 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
  1. ;
  1. XIT K ABME
  1. XIT2 K DIRUT,DIROUT,DUOUT Q
  1. ;
  1. CNT ;EP for counting errors
  1. S ABME="" F ABME("I")=1:1 S ABME=$O(ABME(ABME)) Q:'ABME
  1. S ABM("ERR")=ABME("I")-1
  1. G XIT2
  1. ;
  1. HLP ;EP for Correctivce Action Prompt
  1. 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"
  1. D ^DIR K DIR
  1. I $D(DIROUT)!$D(DIRUT) G XIT2
  1. I '$D(^ABMDERR(+Y,0)) W *7,!,"INVALID ENTRY: ",X," is not Defined in the Error File!" G HLP
  1. D SHOW G HLP
  1. ;
  1. 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")
  1. S ABME("L")="",$P(ABME("L"),"-",80)=""
  1. W !,ABME("L")
  1. W !,"Corrective Action:"
  1. S ABMU("LM")=20,ABMU("RM")=79
  1. S ABMU("TXT")=$P(^ABMDERR(+Y,0),U,2)
  1. D ^ABMDWRAP
  1. W !,ABME("L")
  1. Q
  1. ;
  1. 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
  1. Q
  1. EDIT ;EP - EDIT ENTRIES
  1. W !
  1. S DIC="^ABMDERR(",DIC(0)="AEMQ",DIC("S")="I '$P(^(0),""^"",5)" D ^DIC K DIC Q:Y<0 D
  1. .S DA(1)=+Y
  1. .S DIE="^ABMDERR("_DA(1)_",31,",DA=DUZ(2),DR=".03;.04"
  1. .S:'$D(^ABMDERR(DA(1),31,DA,0)) ^(0)=DA,^ABMDERR(DA(1),31,"B",DA,DA)=""
  1. .D ^DIE
  1. .S DA=DA(1),DR="11;21",DIE="^ABMDERR(" D ^DIE
  1. Q