- 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 ;
