- ACDWUTL ;IHS/ADC/EDE/KML - UTL CODE 10:19;
- ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
- ;
- F ;EP Form feed
- ;//^ACDWRP*
- ;//^ACDWCD*
- K DIR,DUOUT I '$D(ZTQUEUED),$E(IOST)="C" S DIR("A")="Press <ret> to continue",DIR(0)="E" D ^DIR
- I $D(DIRUT) W @IOF Q
- ;
- ;-----------------------------------------------
- ;I $D(DIRUT) D S $ZT="CTRLC^ZU" S X=1/0
- ;I $D(DIRUT) D D ^%G G REST^XQ12
- ;I $D(DIRUT) D D UNWIND S $ZT="CTRLC^ZU" S X=1/0
- ;. I $D(ACDWDRV(1)) D EOJ^ACDWDRV1 Q
- ;. I $D(ACDWDRV(2)) D EOJ^ACDWDRV2 Q
- ;. I $D(ACDWDRV(3)) D EOJ^ACDWDRV3 Q
- ;. I $D(ACDWDRV(4)) D EOJ^ACDWDRV4 Q
- ;. I $D(ACDWDRV(5)) D EOJ^ACDWDRV5 Q
- ;. Q
- ;------------------------------------------------
- ;
- I $D(ACDWDRV(1)) D H^ACDWDRV1 Q
- I $D(ACDWDRV(2)) D H^ACDWDRV2 Q
- I $D(ACDWDRV(3)) D H^ACDWDRV3 Q
- I $D(ACDWDRV(4)) D H^ACDWDRV4 Q
- I $D(ACDWDRV(5)) D H^ACDWDRV5 Q
- Q
- ;
- UNWIND ;
- LOCK ;Unlock any locks
- I $D(^XUTL("XQ",$J,"T")) S %XQEA=^("T") S ^("T")=%XQEA-1 F %XQEA1=%XQEA I $D(^XUTL("XQ",$J,%XQEA1)),$P(^(%XQEA1),U,16) S %XQEA2=+^(%XQEA1) I $D(^DIC(19,%XQEA2,15)),$L(^(15)) X ^(15) ;Unwind Exit Action
- ;I $D(^XUTL("XQ",$J,"T")) S %XQEA=^("T") F %XQEA1=%XQEA,%XQEA-1 I $D(^XUTL("XQ",$J,%XQEA1)),$P(^(%XQEA1),U,16) S %XQEA2=+^(%XQEA1) I $D(^DIC(19,%XQEA2,15)),$L(^(15)) X ^(15) ;Unwind Exit Action
- K %XQEA,%XQEA1,%XQEA2
- Q
- ;
- C ;EP Bld combo drug list for report 3 ,51
- ;//^ACDWDRV1
- ;//^ACDWDRV2
- S (ACDLIST,ACDPP)="" F S ACDPP=$O(ACDDTA(ACDPP)) Q:ACDPP="" S:ACDLIST="" ACDLIST=$P(ACDPP,"=") S:ACDLIST'=""&($P(ACDPP,"=")'[ACDLIST) ACDLIST=ACDLIST_" - "_$P(ACDPP,"=")
- I ACDLIST'="",ACDLIST["-" D SLIST S ^TMP("CDMIS",$J,ACDLIST,ACDDFNP)=""
- Q
- ;
- C1 ;EP build combo problem list for reports 7. 64
- ;//^ACDWDRV1
- ;//^ACDWDRV2
- S (ACDLIST,ACDPP)="" F S ACDPP=$O(ACDPTA(ACDPP)) Q:ACDPP="" S:ACDLIST="" ACDLIST=$P(ACDPP,"=") S:ACDLIST'=""&($P(ACDPP,"=")'[ACDLIST) ACDLIST=ACDLIST_" - "_$P(ACDPP,"=")
- I ACDLIST'="",ACDLIST["-" D SLIST S ^TMP("CDMIS",$J,ACDLIST,ACDDFNP)=""
- Q
- ;
- SLIST ;Sort list
- K ACDLA F ACDL=1:1:$L(ACDLIST," - ") S ACDLA($P(ACDLIST," - ",ACDL))=""
- S ACDLIST="" F ACDL=0:0 S ACDL=$O(ACDLA(ACDL)) Q:'ACDL S:ACDLIST="" ACDLIST=ACDL S:ACDLIST'=""&(ACDL'[ACDLIST) ACDLIST=ACDLIST_" - "_ACDL
- S ACDL="" F S ACDL=$O(ACDLA(ACDL)) Q:ACDL="" I 'ACDL S:ACDLIST="" ACDLIST=ACDL S:ACDLIST'=""&(ACDL'[ACDLIST) ACDLIST=ACDLIST_" - "_ACDL
- Q
- ;
- HV ;EP set hdr vars
- ;//^ACDWDRV*
- S:'$D(ACDH(1)) $P(ACDH(1),"=",79)="="
- S ACDH(2)=$$DD^ACDFUNC(ACDFR)_" THROUGH "_$$DD^ACDFUNC(ACDTO)
- S ACDH(3)=0
- S ACDH(4)=$P(^VA(200,DUZ,0),U)_"@"_ACDSITE_$S($E(ACD6DIG)=9:"-HQ",$E(ACD6DIG,3,4)="00":"-AREA",1:"-FACILITY")
- D NOW^%DTC S Y=$$DD^ACDFUNC(%) S ACDH(4)="PRINTED: "_Y_" BY: "_ACDH(4)
- S ACDH(6)="UNIQ CLI"
- S ACDH(7)="#VISITS"
- S ACDH(8)="AVE V/C"
- S ACDH(9)="CONTACT TYPE"
- S ACDH(10)="ACTUAL PLACEMENT"
- S ACDH(11)="RECOMMENDED PLACEMENT"
- S ACDH(12)="AVE DAYS USED DRUGS"
- S ACDH(13)="AVERAGE DAYS USED ALCHOHOL"
- S ACDH(14)="DIFFERENCE REASON"
- S ACDH(15)="#SERVED"
- S ACDH(16)="LOCATION"
- S ACDH(17)="TARGET"
- S ACDH(18)="OUTCOME"
- S ACDH(19)="ACTIVITY"
- S ACDH(20)="COMPONENT/TYPE"
- S ACDH(21)="AGE RANGE"
- S ACDH(22)="AVE NS/V"
- S ACDH(50)="SEARCH CRITERIA IS: "
- S ACDH(51)="PRIMARY PROBLEM"
- S ACDH(52)="OTHER PROBLEM"
- S ACDH(53)="SEX"
- S ACDH(54)="COMPONENT"
- S ACDH(55)="COMPONENT/CODE TYPE"
- S ACDH(56)="AVE CLIENT STAGE"
- S ACDH(57)="AVE ARREST PER CLIENT"
- S ACDH(58)="AVE DAYS PER CLIENT"
- S ACDH(59)="UNIQ CLI"
- S ACDH(60)="ARRESTS"
- S ACDH(61)="TOTAL HOSPITAL DAYS"
- Q
- ;
- ASF ;EP Print user selection criteria
- ;;//^ACDWDRV*
- ;
- ;Stop if report page is > than 1 (only prnt on page 1)
- I ACDH(3)>1 Q
- ;
- K ACD3 W !
- I $D(ACDFAC),'$D(ACDFAC("*ALL*")) W !,"YOUR SELECTED FACILITIES ARE: " S ACD="" F S ACD=$O(ACDFAC(ACD)) Q:ACD="" S ACDLDA=$O(^AUTTLOC("C",ACD,0)) I ACDLDA S ACDP=$P(^AUTTLOC(ACDLDA,0),U,2)_$S(ACDFAC(ACD):"@"_ACDFAC(ACD),1:"") D ACDP
- I $D(ACDAREA),'$D(ACDAREA("*ALL*")) W !,"YOUR SELECTED AREAS ARE: " S ACD="" F S ACD=$O(ACDAREA(ACD)) Q:ACD="" S ACDLDA=$O(^AUTTAREA("C",ACD,0)) I ACDLDA S ACDP=$P(^AUTTAREA(ACDLDA,0),U)_$S(ACDAREA(ACD):"@"_ACDAREA(ACD),1:"") D ACDP
- I $D(ACDSU),'$D(ACDSU("*ALL*")) W !,"YOUR SELECTED SERVICE UNITS ARE: " S ACD="" F S ACD=$O(ACDSU(ACD)) Q:ACD="" S ACDLDA=$O(^AUTTSU("C",ACD,0)) I ACDLDA S ACDP=$P(^AUTTSU(ACDLDA,0),U)_$S(ACDSU(ACD):"@"_ACDSU(ACD),1:"") D ACDP
- I $D(ACDTRB),'$D(ACDTRB("*ALL*")) K ACD3 W !,"YOUR SELECTED TRIBES ARE: " S ACD="" F S ACD=$O(ACDTRB(ACD)) Q:ACD="" S ACDLDA=$O(^AUTTTRI("C",ACD,0)) I ACDLDA S ACDP=$P(^AUTTTRI(ACDLDA,0),U)_$S(ACDTRB(ACD):"@"_ACDTRB(ACD),1:"") D ACDP
- I $D(ACDSTA),'$D(ACDSTA("*ALL*")) K ACD3 W !,"YOUR SELECTED STATES ARE: " S ACD="" F S ACD=$O(ACDSTA(ACD)) Q:ACD="" S ACDLDA=$O(^DIC(5,"C",ACD,0)) I ACDLDA S ACDP=$P(^DIC(5,ACDLDA,0),U)_$S(ACDSTA(ACD):"@"_ACDSTA(ACD),1:"") D ACDP
- I $D(ACDCRST) K ACD3 W !,"YOUR SELECTED CONTACT TYPES ARE: " S ACD="" F S ACD=$O(ACDCRST(ACD)) Q:ACD="" S ACDP=ACD_"@"_ACDCRST(ACD) D ACDP
- W !
- Q
- ACDP ;Format output then prnt it
- S:'$D(ACD3) ACD3=0
- S ACD3=ACD3+1
- I $P(ACDP,"@",2)="" S $P(ACDP,"@",2)="00"
- W:ACD3=1 ! W:ACD3=1 $P(ACDP,"@",2)_" Visits(s) "_"-"_$E($P(ACDP,"@"),1,20) W:ACD3=2 ?37,$P(ACDP,"@",2)_" Visits(s) "_"-"_$E($P(ACDP,"@"),1,20) I ACD3=2 K ACD3
- Q
- RESET ;EP Reset counters after each report
- ;//^ACDWK
- ;//^ACDWDRV3
- I $D(ACDFAC) S ACD="" F S ACD=$O(ACDFAC(ACD)) Q:ACD="" S ACDFAC(ACD)=""
- I $D(ACDAREA) S ACD="" F S ACD=$O(ACDAREA(ACD)) Q:ACD="" S ACDAREA(ACD)=""
- I $D(ACDSU) S ACD="" F S ACD=$O(ACDSU(ACD)) Q:ACD="" S ACDSU(ACD)=""
- I $D(ACDTRB) S ACD="" F S ACD=$O(ACDTRB(ACD)) Q:ACD="" S ACDTRB(ACD)=""
- I $D(ACDSTA) S ACD="" F S ACD=$O(ACDSTA(ACD)) Q:ACD="" S ACDSTA(ACD)=""
- I $D(ACDCRST) S ACD="" F S ACD=$O(ACDCRST(ACD)) Q:ACD="" S ACDCRST(ACD)=""
- Q
- ERROR ;EP-Check for error codes after extrinsic calls
- ;//^ACDPIMP,^ACDVIMP
- I +Y W !!,"Error code: ",Y," detected from the black box"
- ACDWUTL ;IHS/ADC/EDE/KML - UTL CODE 10:19;
- +1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
- +2 ;
- F ;EP Form feed
- +1 ;//^ACDWRP*
- +2 ;//^ACDWCD*
- +3 KILL DIR,DUOUT
- IF '$DATA(ZTQUEUED)
- IF $EXTRACT(IOST)="C"
- SET DIR("A")="Press <ret> to continue"
- SET DIR(0)="E"
- DO ^DIR
- +4 IF $DATA(DIRUT)
- WRITE @IOF
- QUIT
- +5 ;
- +6 ;-----------------------------------------------
- +7 ;I $D(DIRUT) D S $ZT="CTRLC^ZU" S X=1/0
- +8 ;I $D(DIRUT) D D ^%G G REST^XQ12
- +9 ;I $D(DIRUT) D D UNWIND S $ZT="CTRLC^ZU" S X=1/0
- +10 ;. I $D(ACDWDRV(1)) D EOJ^ACDWDRV1 Q
- +11 ;. I $D(ACDWDRV(2)) D EOJ^ACDWDRV2 Q
- +12 ;. I $D(ACDWDRV(3)) D EOJ^ACDWDRV3 Q
- +13 ;. I $D(ACDWDRV(4)) D EOJ^ACDWDRV4 Q
- +14 ;. I $D(ACDWDRV(5)) D EOJ^ACDWDRV5 Q
- +15 ;. Q
- +16 ;------------------------------------------------
- +17 ;
- +18 IF $DATA(ACDWDRV(1))
- DO H^ACDWDRV1
- QUIT
- +19 IF $DATA(ACDWDRV(2))
- DO H^ACDWDRV2
- QUIT
- +20 IF $DATA(ACDWDRV(3))
- DO H^ACDWDRV3
- QUIT
- +21 IF $DATA(ACDWDRV(4))
- DO H^ACDWDRV4
- QUIT
- +22 IF $DATA(ACDWDRV(5))
- DO H^ACDWDRV5
- QUIT
- +23 QUIT
- +24 ;
- UNWIND ;
- +1 ;Unlock any locks
- LOCK
- +2 ;Unwind Exit Action
- IF $DATA(^XUTL("XQ",$JOB,"T"))
- SET %XQEA=^("T")
- SET ^("T")=%XQEA-1
- FOR %XQEA1=%XQEA
- IF $DATA(^XUTL("XQ",$JOB,%XQEA1))
- IF $PIECE(^(%XQEA1),U,16)
- SET %XQEA2=+^(%XQEA1)
- IF $DATA(^DIC(19,%XQEA2,15))
- IF $LENGTH(^(15))
- XECUTE ^(15)
- +3 ;I $D(^XUTL("XQ",$J,"T")) S %XQEA=^("T") F %XQEA1=%XQEA,%XQEA-1 I $D(^XUTL("XQ",$J,%XQEA1)),$P(^(%XQEA1),U,16) S %XQEA2=+^(%XQEA1) I $D(^DIC(19,%XQEA2,15)),$L(^(15)) X ^(15) ;Unwind Exit Action
- +4 KILL %XQEA,%XQEA1,%XQEA2
- +5 QUIT
- +6 ;
- C ;EP Bld combo drug list for report 3 ,51
- +1 ;//^ACDWDRV1
- +2 ;//^ACDWDRV2
- +3 SET (ACDLIST,ACDPP)=""
- FOR
- SET ACDPP=$ORDER(ACDDTA(ACDPP))
- IF ACDPP=""
- QUIT
- IF ACDLIST=""
- SET ACDLIST=$PIECE(ACDPP,"=")
- IF ACDLIST'=""&($PIECE(ACDPP,"=")'[ACDLIST)
- SET ACDLIST=ACDLIST_" - "_$PIECE(ACDPP,"=")
- +4 IF ACDLIST'=""
- IF ACDLIST["-"
- DO SLIST
- SET ^TMP("CDMIS",$JOB,ACDLIST,ACDDFNP)=""
- +5 QUIT
- +6 ;
- C1 ;EP build combo problem list for reports 7. 64
- +1 ;//^ACDWDRV1
- +2 ;//^ACDWDRV2
- +3 SET (ACDLIST,ACDPP)=""
- FOR
- SET ACDPP=$ORDER(ACDPTA(ACDPP))
- IF ACDPP=""
- QUIT
- IF ACDLIST=""
- SET ACDLIST=$PIECE(ACDPP,"=")
- IF ACDLIST'=""&($PIECE(ACDPP,"=")'[ACDLIST)
- SET ACDLIST=ACDLIST_" - "_$PIECE(ACDPP,"=")
- +4 IF ACDLIST'=""
- IF ACDLIST["-"
- DO SLIST
- SET ^TMP("CDMIS",$JOB,ACDLIST,ACDDFNP)=""
- +5 QUIT
- +6 ;
- SLIST ;Sort list
- +1 KILL ACDLA
- FOR ACDL=1:1:$LENGTH(ACDLIST," - ")
- SET ACDLA($PIECE(ACDLIST," - ",ACDL))=""
- +2 SET ACDLIST=""
- FOR ACDL=0:0
- SET ACDL=$ORDER(ACDLA(ACDL))
- IF 'ACDL
- QUIT
- IF ACDLIST=""
- SET ACDLIST=ACDL
- IF ACDLIST'=""&(ACDL'[ACDLIST)
- SET ACDLIST=ACDLIST_" - "_ACDL
- +3 SET ACDL=""
- FOR
- SET ACDL=$ORDER(ACDLA(ACDL))
- IF ACDL=""
- QUIT
- IF 'ACDL
- IF ACDLIST=""
- SET ACDLIST=ACDL
- IF ACDLIST'=""&(ACDL'[ACDLIST)
- SET ACDLIST=ACDLIST_" - "_ACDL
- +4 QUIT
- +5 ;
- HV ;EP set hdr vars
- +1 ;//^ACDWDRV*
- +2 IF '$DATA(ACDH(1))
- SET $PIECE(ACDH(1),"=",79)="="
- +3 SET ACDH(2)=$$DD^ACDFUNC(ACDFR)_" THROUGH "_$$DD^ACDFUNC(ACDTO)
- +4 SET ACDH(3)=0
- +5 SET ACDH(4)=$PIECE(^VA(200,DUZ,0),U)_"@"_ACDSITE_$SELECT($EXTRACT(ACD6DIG)=9:"-HQ",$EXTRACT(ACD6DIG,3,4)="00":"-AREA",1:"-FACILITY")
- +6 DO NOW^%DTC
- SET Y=$$DD^ACDFUNC(%)
- SET ACDH(4)="PRINTED: "_Y_" BY: "_ACDH(4)
- +7 SET ACDH(6)="UNIQ CLI"
- +8 SET ACDH(7)="#VISITS"
- +9 SET ACDH(8)="AVE V/C"
- +10 SET ACDH(9)="CONTACT TYPE"
- +11 SET ACDH(10)="ACTUAL PLACEMENT"
- +12 SET ACDH(11)="RECOMMENDED PLACEMENT"
- +13 SET ACDH(12)="AVE DAYS USED DRUGS"
- +14 SET ACDH(13)="AVERAGE DAYS USED ALCHOHOL"
- +15 SET ACDH(14)="DIFFERENCE REASON"
- +16 SET ACDH(15)="#SERVED"
- +17 SET ACDH(16)="LOCATION"
- +18 SET ACDH(17)="TARGET"
- +19 SET ACDH(18)="OUTCOME"
- +20 SET ACDH(19)="ACTIVITY"
- +21 SET ACDH(20)="COMPONENT/TYPE"
- +22 SET ACDH(21)="AGE RANGE"
- +23 SET ACDH(22)="AVE NS/V"
- +24 SET ACDH(50)="SEARCH CRITERIA IS: "
- +25 SET ACDH(51)="PRIMARY PROBLEM"
- +26 SET ACDH(52)="OTHER PROBLEM"
- +27 SET ACDH(53)="SEX"
- +28 SET ACDH(54)="COMPONENT"
- +29 SET ACDH(55)="COMPONENT/CODE TYPE"
- +30 SET ACDH(56)="AVE CLIENT STAGE"
- +31 SET ACDH(57)="AVE ARREST PER CLIENT"
- +32 SET ACDH(58)="AVE DAYS PER CLIENT"
- +33 SET ACDH(59)="UNIQ CLI"
- +34 SET ACDH(60)="ARRESTS"
- +35 SET ACDH(61)="TOTAL HOSPITAL DAYS"
- +36 QUIT
- +37 ;
- ASF ;EP Print user selection criteria
- +1 ;;//^ACDWDRV*
- +2 ;
- +3 ;Stop if report page is > than 1 (only prnt on page 1)
- +4 IF ACDH(3)>1
- QUIT
- +5 ;
- +6 KILL ACD3
- WRITE !
- +7 IF $DATA(ACDFAC)
- IF '$DATA(ACDFAC("*ALL*"))
- WRITE !,"YOUR SELECTED FACILITIES ARE: "
- SET ACD=""
- FOR
- SET ACD=$ORDER(ACDFAC(ACD))
- IF ACD=""
- QUIT
- SET ACDLDA=$ORDER(^AUTTLOC("C",ACD,0))
- IF ACDLDA
- SET ACDP=$PIECE(^AUTTLOC(ACDLDA,0),U,2)_$SELECT(ACDFAC(ACD):"@"_ACDFAC(ACD),1:"")
- DO ACDP
- +8 IF $DATA(ACDAREA)
- IF '$DATA(ACDAREA("*ALL*"))
- WRITE !,"YOUR SELECTED AREAS ARE: "
- SET ACD=""
- FOR
- SET ACD=$ORDER(ACDAREA(ACD))
- IF ACD=""
- QUIT
- SET ACDLDA=$ORDER(^AUTTAREA("C",ACD,0))
- IF ACDLDA
- SET ACDP=$PIECE(^AUTTAREA(ACDLDA,0),U)_$SELECT(ACDAREA(ACD):"@"_ACDAREA(ACD),1:"")
- DO ACDP
- +9 IF $DATA(ACDSU)
- IF '$DATA(ACDSU("*ALL*"))
- WRITE !,"YOUR SELECTED SERVICE UNITS ARE: "
- SET ACD=""
- FOR
- SET ACD=$ORDER(ACDSU(ACD))
- IF ACD=""
- QUIT
- SET ACDLDA=$ORDER(^AUTTSU("C",ACD,0))
- IF ACDLDA
- SET ACDP=$PIECE(^AUTTSU(ACDLDA,0),U)_$SELECT(ACDSU(ACD):"@"_ACDSU(ACD),1:"")
- DO ACDP
- +10 IF $DATA(ACDTRB)
- IF '$DATA(ACDTRB("*ALL*"))
- KILL ACD3
- WRITE !,"YOUR SELECTED TRIBES ARE: "
- SET ACD=""
- FOR
- SET ACD=$ORDER(ACDTRB(ACD))
- IF ACD=""
- QUIT
- SET ACDLDA=$ORDER(^AUTTTRI("C",ACD,0))
- IF ACDLDA
- SET ACDP=$PIECE(^AUTTTRI(ACDLDA,0),U)_$SELECT(ACDTRB(ACD):"@"_ACDTRB(ACD),1:"")
- DO ACDP
- +11 IF $DATA(ACDSTA)
- IF '$DATA(ACDSTA("*ALL*"))
- KILL ACD3
- WRITE !,"YOUR SELECTED STATES ARE: "
- SET ACD=""
- FOR
- SET ACD=$ORDER(ACDSTA(ACD))
- IF ACD=""
- QUIT
- SET ACDLDA=$ORDER(^DIC(5,"C",ACD,0))
- IF ACDLDA
- SET ACDP=$PIECE(^DIC(5,ACDLDA,0),U)_$SELECT(ACDSTA(ACD):"@"_ACDSTA(ACD),1:"")
- DO ACDP
- +12 IF $DATA(ACDCRST)
- KILL ACD3
- WRITE !,"YOUR SELECTED CONTACT TYPES ARE: "
- SET ACD=""
- FOR
- SET ACD=$ORDER(ACDCRST(ACD))
- IF ACD=""
- QUIT
- SET ACDP=ACD_"@"_ACDCRST(ACD)
- DO ACDP
- +13 WRITE !
- +14 QUIT
- ACDP ;Format output then prnt it
- +1 IF '$DATA(ACD3)
- SET ACD3=0
- +2 SET ACD3=ACD3+1
- +3 IF $PIECE(ACDP,"@",2)=""
- SET $PIECE(ACDP,"@",2)="00"
- +4 IF ACD3=1
- WRITE !
- IF ACD3=1
- WRITE $PIECE(ACDP,"@",2)_" Visits(s) "_"-"_$EXTRACT($PIECE(ACDP,"@"),1,20)
- IF ACD3=2
- WRITE ?37,$PIECE(ACDP,"@",2)_" Visits(s) "_"-"_$EXTRACT($PIECE(ACDP,"@"),1,20)
- IF ACD3=2
- KILL ACD3
- +5 QUIT
- RESET ;EP Reset counters after each report
- +1 ;//^ACDWK
- +2 ;//^ACDWDRV3
- +3 IF $DATA(ACDFAC)
- SET ACD=""
- FOR
- SET ACD=$ORDER(ACDFAC(ACD))
- IF ACD=""
- QUIT
- SET ACDFAC(ACD)=""
- +4 IF $DATA(ACDAREA)
- SET ACD=""
- FOR
- SET ACD=$ORDER(ACDAREA(ACD))
- IF ACD=""
- QUIT
- SET ACDAREA(ACD)=""
- +5 IF $DATA(ACDSU)
- SET ACD=""
- FOR
- SET ACD=$ORDER(ACDSU(ACD))
- IF ACD=""
- QUIT
- SET ACDSU(ACD)=""
- +6 IF $DATA(ACDTRB)
- SET ACD=""
- FOR
- SET ACD=$ORDER(ACDTRB(ACD))
- IF ACD=""
- QUIT
- SET ACDTRB(ACD)=""
- +7 IF $DATA(ACDSTA)
- SET ACD=""
- FOR
- SET ACD=$ORDER(ACDSTA(ACD))
- IF ACD=""
- QUIT
- SET ACDSTA(ACD)=""
- +8 IF $DATA(ACDCRST)
- SET ACD=""
- FOR
- SET ACD=$ORDER(ACDCRST(ACD))
- IF ACD=""
- QUIT
- SET ACDCRST(ACD)=""
- +9 QUIT
- ERROR ;EP-Check for error codes after extrinsic calls
- +1 ;//^ACDPIMP,^ACDVIMP
- +2 IF +Y
- WRITE !!,"Error code: ",Y," detected from the black box"