ACHSDREA ; IHS/ITSC/TPF/PMF - LIST ACTIVE DENIAL REASONS ;
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**18**;JUN 11, 2001
;ACHS*3.1*18 TEST FOR INACTIVE DENIAL OPTIONS
;
W !!!
S %ZIS="QP"
D ^%ZIS
I POP D HOME^%ZIS G END
I '$D(IO("Q")) G START
S ZTRTN="START^ACHSDREA",ZTDESC=$P($P($T(ACHSDREA),"-",2)," ",2,5)
D ^%ZTLOAD
Q
;
START ;EP - From TaskMan.
N ACHSDFAC,ACHSDHDR,ACHSDO,ACHSDOT,ACHSDROP,ACHSDT,ACHSTIME,ACHSDX,DIW,DIWF,DIWL,DIWR
D NOW^ACHS
S ACHSDFAC=$$LOC^ACHS(),ACHSTIME=$P(ACHSTIME,"@",1),ACHSDHDR="CHS "_$P($P($T(ACHSDREA),"-",2)," ",2,5)
U IO
S DIWR=IOM-5,DIWF="W",ACHSDX=0
GO ;
S ACHSDX=$O(^ACHSDENS(ACHSDX))
G END:+ACHSDX=0,GO:'$D(^ACHSDENS(ACHSDX,0))
I $D(^ACHSDENS(ACHSDX,10)),$P($G(^ACHSDENS(ACHSDX,10)),U)'="",$P($G(^ACHSDENS(ACHSDX,10)),U)<DT G GO
D HDR
G END:$G(ACHSQUIT)
W !!?5,$P($G(^ACHSDENS(ACHSDX,0)),U),!!
S ACHSDT=0,X="",DIWL=6
RTXT ;
F S ACHSDT=$O(^ACHSDENS(ACHSDX,1,ACHSDT)) Q:+ACHSDT=0 G GO:'$D(^ACHSDENS(ACHSDX,1,ACHSDT,0)) S X=$G(^ACHSDENS(ACHSDX,1,ACHSDT,0)) D ^DIWP
D ^DIWW
I $Y>(IOSL-6) D HDR G END:$G(ACHSQUIT)
I '$D(^ACHSDENS(ACHSDX,20,0)) W !! G GO
S ACHSDO=0
OPT ;
S ACHSDO=$O(^ACHSDENS(ACHSDX,20,ACHSDO))
G GO:+ACHSDO=0
S ACHSDROP=$P($G(^ACHSDENS(ACHSDX,20,ACHSDO,0)),U)
I $P(^ACHSDENS(ACHSDX,20,ACHSDO,0),U,2) G OPT ;ACHS*3.1*18 IHS.OIT.FCJ
W !?10,"OPTION: ",?10,ACHSDROP
S ACHSDOT=0,X="",DIWL=11
F S ACHSDOT=$O(^ACHSDENS(ACHSDX,20,ACHSDO,1,ACHSDOT)) Q:+ACHSDOT=0 S X=$G(^ACHSDENS(ACHSDX,20,ACHSDO,1,ACHSDOT,0)) D ^DIWP
D ^DIWW
I $Y>(IOSL-6) D HDR G END:$G(ACHSQUIT)
G OPT
;
END ;
D ^%ZISC
Q
;
HDR ;
D RTRN^ACHS
Q:$G(ACHSQUIT)
W @IOF,$$C^ACHS(ACHSDHDR,IOM),!,$$C^ACHS(ACHSDFAC,IOM),!,$$C^ACHS(ACHSTIME,IOM)
Q
;
ACHSDREA ; IHS/ITSC/TPF/PMF - LIST ACTIVE DENIAL REASONS ;
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**18**;JUN 11, 2001
+2 ;ACHS*3.1*18 TEST FOR INACTIVE DENIAL OPTIONS
+3 ;
+4 WRITE !!!
+5 SET %ZIS="QP"
+6 DO ^%ZIS
+7 IF POP
DO HOME^%ZIS
GOTO END
+8 IF '$DATA(IO("Q"))
GOTO START
+9 SET ZTRTN="START^ACHSDREA"
SET ZTDESC=$PIECE($PIECE($TEXT(ACHSDREA),"-",2)," ",2,5)
+10 DO ^%ZTLOAD
+11 QUIT
+12 ;
START ;EP - From TaskMan.
+1 NEW ACHSDFAC,ACHSDHDR,ACHSDO,ACHSDOT,ACHSDROP,ACHSDT,ACHSTIME,ACHSDX,DIW,DIWF,DIWL,DIWR
+2 DO NOW^ACHS
+3 SET ACHSDFAC=$$LOC^ACHS()
SET ACHSTIME=$PIECE(ACHSTIME,"@",1)
SET ACHSDHDR="CHS "_$PIECE($PIECE($TEXT(ACHSDREA),"-",2)," ",2,5)
+4 USE IO
+5 SET DIWR=IOM-5
SET DIWF="W"
SET ACHSDX=0
GO ;
+1 SET ACHSDX=$ORDER(^ACHSDENS(ACHSDX))
+2 IF +ACHSDX=0
GOTO END
IF '$DATA(^ACHSDENS(ACHSDX,0))
GOTO GO
+3 IF $DATA(^ACHSDENS(ACHSDX,10))
IF $PIECE($GET(^ACHSDENS(ACHSDX,10)),U)'=""
IF $PIECE($GET(^ACHSDENS(ACHSDX,10)),U)<DT
GOTO GO
+4 DO HDR
+5 IF $GET(ACHSQUIT)
GOTO END
+6 WRITE !!?5,$PIECE($GET(^ACHSDENS(ACHSDX,0)),U),!!
+7 SET ACHSDT=0
SET X=""
SET DIWL=6
RTXT ;
+1 FOR
SET ACHSDT=$ORDER(^ACHSDENS(ACHSDX,1,ACHSDT))
IF +ACHSDT=0
QUIT
IF '$DATA(^ACHSDENS(ACHSDX,1,ACHSDT,0))
GOTO GO
SET X=$GET(^ACHSDENS(ACHSDX,1,ACHSDT,0))
DO ^DIWP
+2 DO ^DIWW
+3 IF $Y>(IOSL-6)
DO HDR
IF $GET(ACHSQUIT)
GOTO END
+4 IF '$DATA(^ACHSDENS(ACHSDX,20,0))
WRITE !!
GOTO GO
+5 SET ACHSDO=0
OPT ;
+1 SET ACHSDO=$ORDER(^ACHSDENS(ACHSDX,20,ACHSDO))
+2 IF +ACHSDO=0
GOTO GO
+3 SET ACHSDROP=$PIECE($GET(^ACHSDENS(ACHSDX,20,ACHSDO,0)),U)
+4 ;ACHS*3.1*18 IHS.OIT.FCJ
IF $PIECE(^ACHSDENS(ACHSDX,20,ACHSDO,0),U,2)
GOTO OPT
+5 WRITE !?10,"OPTION: ",?10,ACHSDROP
+6 SET ACHSDOT=0
SET X=""
SET DIWL=11
+7 FOR
SET ACHSDOT=$ORDER(^ACHSDENS(ACHSDX,20,ACHSDO,1,ACHSDOT))
IF +ACHSDOT=0
QUIT
SET X=$GET(^ACHSDENS(ACHSDX,20,ACHSDO,1,ACHSDOT,0))
DO ^DIWP
+8 DO ^DIWW
+9 IF $Y>(IOSL-6)
DO HDR
IF $GET(ACHSQUIT)
GOTO END
+10 GOTO OPT
+11 ;
END ;
+1 DO ^%ZISC
+2 QUIT
+3 ;
HDR ;
+1 DO RTRN^ACHS
+2 IF $GET(ACHSQUIT)
QUIT
+3 WRITE @IOF,$$C^ACHS(ACHSDHDR,IOM),!,$$C^ACHS(ACHSDFAC,IOM),!,$$C^ACHS(ACHSTIME,IOM)
+4 QUIT
+5 ;
