ACDRLU1 ;IHS/ADC/EDE/KML - GEN RET UTIL;
;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
;
MCR ;display all current medicare data
NEW ACDMIFN
I '$D(^DPT(P,0)) G MCRX
I $P(^DPT(P,0),U,19) G MCRX
I '$D(^AUPNPAT(P,0)) G MCRX
I '$D(^AUPNMCR(P,11)) G MCRX
I $D(^DPT(P,.35)),$P(^(.35),U)]"",$P(^(.35),U)<D G MCRX
S ACDMIFN=0 F S ACDMIFN=$O(^AUPNMCR(P,11,ACDMIFN)) Q:ACDMIFN'=+ACDMIFN D
.Q:$P(^AUPNMCR(P,11,ACDMIFN,0),U)>D
.I $P(^AUPNMCR(P,11,ACDMIFN,0),U,2)]"",$P(^(0),U,2)<ACDACE Q
.S ACDPCNT=ACDPCNT+1,ACDPRNM(ACDPCNT)=$P(^AUPNMCR(DFN,0),U,3)_" ["_$S($P(^(0),U,4)]"":$P(^AUTTMCS($P(^(0),U,4),0),U),1:"-")_"]"
.S ACDPCNT=ACDPCNT+1,Y=$P(^AUPNMCR(DFN,11,ACDMIFN,0),U),Z=$P(^(0),U,2),ACDPRNM(ACDPCNT)=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)_"-" I Z]"" S ACDPRNM(ACDPCNT)=ACDPRNM(ACDPCNT)_$E(Z,4,5)_"/"_$E(Z,6,7)_"/"_$E(Y,2,3)
.Q
MCRX ;
K Y,Z
Q
;
MCD ;
NEW ACDMIFN,ACDNIFN
I '$D(^DPT(P,0)) G MCDX
I $P(^DPT(P,0),U,19) G MCDX
I '$D(^AUPNPAT(P,0)) G MCDX
I $D(^DPT(P,.35)),$P(^(.35),U)]"",$P(^(.35),U)<D G MCDX
S ACDMIFN=0 F S ACDMIFN=$O(^AUPNMCD("B",P,ACDMIFN)) Q:ACDMIFN'=+ACDMIFN D
.Q:'$D(^AUPNMCD(ACDMIFN,11))
.S ACDNIFN=0 F S ACDNIFN=$O(^AUPNMCD(ACDMIFN,11,ACDNIFN)) Q:ACDNIFN'=+ACDNIFN D
..Q:ACDNIFN>D
..I $P(^AUPNMCD(ACDMIFN,11,ACDNIFN,0),U,2)]"",$P(^(0),U,2)<D Q
..S ACDPCNT=ACDPCNT+1,ACDPRNM(ACDPCNT)=$P(^AUPNMCD(ACDMIFN,0),U,3)_"/"_$S($P(^AUPNMCD(ACDMIFN,0),U,2)]"":$P(^AUTNINS($P(^AUPNMCD(ACDMIFN,0),U,2),0),U),1:"<>")
..S ACDPCNT=ACDPCNT+1,Y=$P(^AUPNMCD(ACDMIFN,11,ACDNIFN,0),U),Z=$P(^(0),U,2),ACDPRNM(ACDPCNT)=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)_"-" I Z]"" S ACDPRNM(ACDPCNT)=ACDPRNM(ACDPCNT)_$E(Z,4,5)_"/"_$E(Z,6,7)_"/"_$E(Y,2,3)
..Q
.Q
;
MCDX ;
Q
;
PI ;
NEW ACDMIFN,ACDFLG
I '$D(^DPT(P,0)) G PIX
I $P(^DPT(P,0),U,19) G PIX
I '$D(^AUPNPAT(P,0)) G PIX
I '$D(^AUPNPRVT(P,11)) G PIX
I $D(^DPT(P,.35)),$P(^(.35),U)]"",$P(^(.35),U)<D G PIX
S ACDMIFN=0 F S ACDMIFN=$O(^AUPNPRVT(P,11,ACDMIFN)) Q:ACDMIFN'=+ACDMIFN D
.Q:$P(^AUPNPRVT(P,11,ACDMIFN,0),U)=""
.S ACDNAME=$P(^AUPNPRVT(DFN,11,ACDMIFN,0),U) Q:ACDNAME=""
.Q:$P(^AUTNINS(ACDNAME,0),U)["AHCCCS"
.Q:$P(^AUPNPRVT(P,11,ACDMIFN,0),U,6)>D
.I $P(^AUPNPRVT(P,11,ACDMIFN,0),U,7)]"",$P(^(0),U,7)<ACDACE Q
.S ACDPCNT=ACDPCNT+1,ACDPRNM(ACDPCNT)=$P(^AUTNINS($P(^AUPNPRVT(P,11,ACDMIFN,0),U),0),U)
.S ACDPCNT=ACDPCNT+1,Y=$P(^AUPNPRVT(DFN,11,ACDMIFN,0),U,6),Z=$P(^(0),U,7),ACDPRNM(ACDPCNT)=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)_"-" I Z]"" S ACDPRNM(ACDPCNT)=ACDPRNM(ACDPCNT)_$E(Z,4,5)_"/"_$E(Z,6,7)_"/"_$E(Z,2,3)
.Q
PIX ;
Q
CALLDIE ;EP
Q:'$D(DA)
Q:'$D(DIE)
K DIV,DIU,DIY,DIW,DIG,DIH
NEW ACDG S ACDG=DIE_DA_")" L +(@ACDG):10 E W !!,"Can't lock global",! Q
Q:'$D(DR)
D ^DIE
L -(@ACDG):10
K DIE,DIC,DR,DA,D0,D,D1,DO,%X,%Y,X,A,Z,DIU,DIV,DIY,DIW,DIADD,DLAYGO,%,%E,%D,%W,DI,DIFLD,DIG,DIH,DK,DL,DISYS,ACDG
Q
PAUSE ;EP
Q:$E(IOST)'="C"!(IO'=IO(0))
W ! S DIR(0)="EO",DIR("A")="Hit return to continue...." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q
DONE ;ENTRY POINT - END OF REPORT TIME DISPLAY
I $D(ACDET) S ACDTS=(86400*($P(ACDET,",")-$P(ACDBT,",")))+($P(ACDET,",",2)-$P(ACDBT,",",2)),ACDH=$P(ACDTS/3600,".") S:ACDH="" ACDH=0 D
.S ACDTS=ACDTS-(ACDH*3600),ACDM=$P(ACDTS/60,".") S:ACDM="" ACDM=0 S ACDTS=ACDTS-(ACDM*60),ACDS=ACDTS W !!,"RUN TIME (H.M.S): ",ACDH,".",ACDM,".",ACDS
I $E(IOST)="C",IO=IO(0) S DIR(0)="EO",DIR("A")="End of report. HIT RETURN" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
W:$D(IOF) @IOF
K ACDTS,ACDS,ACDH,ACDM,ACDET
Q
;
ACDRLU1 ;IHS/ADC/EDE/KML - GEN RET UTIL;
+1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
+2 ;
MCR ;display all current medicare data
+1 NEW ACDMIFN
+2 IF '$DATA(^DPT(P,0))
GOTO MCRX
+3 IF $PIECE(^DPT(P,0),U,19)
GOTO MCRX
+4 IF '$DATA(^AUPNPAT(P,0))
GOTO MCRX
+5 IF '$DATA(^AUPNMCR(P,11))
GOTO MCRX
+6 IF $DATA(^DPT(P,.35))
IF $PIECE(^(.35),U)]""
IF $PIECE(^(.35),U)<D
GOTO MCRX
+7 SET ACDMIFN=0
FOR
SET ACDMIFN=$ORDER(^AUPNMCR(P,11,ACDMIFN))
IF ACDMIFN'=+ACDMIFN
QUIT
Begin DoDot:1
+8 IF $PIECE(^AUPNMCR(P,11,ACDMIFN,0),U)>D
QUIT
+9 IF $PIECE(^AUPNMCR(P,11,ACDMIFN,0),U,2)]""
IF $PIECE(^(0),U,2)<ACDACE
QUIT
+10 SET ACDPCNT=ACDPCNT+1
SET ACDPRNM(ACDPCNT)=$PIECE(^AUPNMCR(DFN,0),U,3)_" ["_$SELECT($PIECE(^(0),U,4)]"":$PIECE(^AUTTMCS($PIECE(^(0),U,4),0),U),1:"-")_"]"
+11 SET ACDPCNT=ACDPCNT+1
SET Y=$PIECE(^AUPNMCR(DFN,11,ACDMIFN,0),U)
SET Z=$PIECE(^(0),U,2)
SET ACDPRNM(ACDPCNT)=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)_"-"
IF Z]""
SET ACDPRNM(ACDPCNT)=ACDPRNM(ACDPCNT)_$EXTRACT(Z,4,5)_"/"_$EXTRACT(Z,6,7)_"/"_$EXTRACT(Y,2,3)
+12 QUIT
End DoDot:1
MCRX ;
+1 KILL Y,Z
+2 QUIT
+3 ;
MCD ;
+1 NEW ACDMIFN,ACDNIFN
+2 IF '$DATA(^DPT(P,0))
GOTO MCDX
+3 IF $PIECE(^DPT(P,0),U,19)
GOTO MCDX
+4 IF '$DATA(^AUPNPAT(P,0))
GOTO MCDX
+5 IF $DATA(^DPT(P,.35))
IF $PIECE(^(.35),U)]""
IF $PIECE(^(.35),U)<D
GOTO MCDX
+6 SET ACDMIFN=0
FOR
SET ACDMIFN=$ORDER(^AUPNMCD("B",P,ACDMIFN))
IF ACDMIFN'=+ACDMIFN
QUIT
Begin DoDot:1
+7 IF '$DATA(^AUPNMCD(ACDMIFN,11))
QUIT
+8 SET ACDNIFN=0
FOR
SET ACDNIFN=$ORDER(^AUPNMCD(ACDMIFN,11,ACDNIFN))
IF ACDNIFN'=+ACDNIFN
QUIT
Begin DoDot:2
+9 IF ACDNIFN>D
QUIT
+10 IF $PIECE(^AUPNMCD(ACDMIFN,11,ACDNIFN,0),U,2)]""
IF $PIECE(^(0),U,2)<D
QUIT
+11 SET ACDPCNT=ACDPCNT+1
SET ACDPRNM(ACDPCNT)=$PIECE(^AUPNMCD(ACDMIFN,0),U,3)_"/"_$SELECT($PIECE(^AUPNMCD(ACDMIFN,0),U,2)]"":$PIECE(^AUTNINS($PIECE(^AUPNMCD(ACDMIFN,0),U,2),0),U),1:"<>")
+12 SET ACDPCNT=ACDPCNT+1
SET Y=$PIECE(^AUPNMCD(ACDMIFN,11,ACDNIFN,0),U)
SET Z=$PIECE(^(0),U,2)
SET ACDPRNM(ACDPCNT)=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)_"-"
IF Z]""
SET ACDPRNM(ACDPCNT)=ACDPRNM(ACDPCNT)_$EXTRACT(Z,4,5)_"/"_$EXTRACT(Z,6,7)_"/"_$EXTRACT(Y,2,3)
+13 QUIT
End DoDot:2
+14 QUIT
End DoDot:1
+15 ;
MCDX ;
+1 QUIT
+2 ;
PI ;
+1 NEW ACDMIFN,ACDFLG
+2 IF '$DATA(^DPT(P,0))
GOTO PIX
+3 IF $PIECE(^DPT(P,0),U,19)
GOTO PIX
+4 IF '$DATA(^AUPNPAT(P,0))
GOTO PIX
+5 IF '$DATA(^AUPNPRVT(P,11))
GOTO PIX
+6 IF $DATA(^DPT(P,.35))
IF $PIECE(^(.35),U)]""
IF $PIECE(^(.35),U)<D
GOTO PIX
+7 SET ACDMIFN=0
FOR
SET ACDMIFN=$ORDER(^AUPNPRVT(P,11,ACDMIFN))
IF ACDMIFN'=+ACDMIFN
QUIT
Begin DoDot:1
+8 IF $PIECE(^AUPNPRVT(P,11,ACDMIFN,0),U)=""
QUIT
+9 SET ACDNAME=$PIECE(^AUPNPRVT(DFN,11,ACDMIFN,0),U)
IF ACDNAME=""
QUIT
+10 IF $PIECE(^AUTNINS(ACDNAME,0),U)["AHCCCS"
QUIT
+11 IF $PIECE(^AUPNPRVT(P,11,ACDMIFN,0),U,6)>D
QUIT
+12 IF $PIECE(^AUPNPRVT(P,11,ACDMIFN,0),U,7)]""
IF $PIECE(^(0),U,7)<ACDACE
QUIT
+13 SET ACDPCNT=ACDPCNT+1
SET ACDPRNM(ACDPCNT)=$PIECE(^AUTNINS($PIECE(^AUPNPRVT(P,11,ACDMIFN,0),U),0),U)
+14 SET ACDPCNT=ACDPCNT+1
SET Y=$PIECE(^AUPNPRVT(DFN,11,ACDMIFN,0),U,6)
SET Z=$PIECE(^(0),U,7)
SET ACDPRNM(ACDPCNT)=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)_"-"
IF Z]""
SET ACDPRNM(ACDPCNT)=ACDPRNM(ACDPCNT)_$EXTRACT(Z,4,5)_"/"_$EXTRACT(Z,6,7)_"/"_$EXTRACT(Z,2,3)
+15 QUIT
End DoDot:1
PIX ;
+1 QUIT
CALLDIE ;EP
+1 IF '$DATA(DA)
QUIT
+2 IF '$DATA(DIE)
QUIT
+3 KILL DIV,DIU,DIY,DIW,DIG,DIH
+4 NEW ACDG
SET ACDG=DIE_DA_")"
LOCK +(@ACDG):10
IF '$TEST
WRITE !!,"Can't lock global",!
QUIT
+5 IF '$DATA(DR)
QUIT
+6 DO ^DIE
+7 LOCK -(@ACDG):10
+8 KILL DIE,DIC,DR,DA,D0,D,D1,DO,%X,%Y,X,A,Z,DIU,DIV,DIY,DIW,DIADD,DLAYGO,%,%E,%D,%W,DI,DIFLD,DIG,DIH,DK,DL,DISYS,ACDG
+9 QUIT
PAUSE ;EP
+1 IF $EXTRACT(IOST)'="C"!(IO'=IO(0))
QUIT
+2 WRITE !
SET DIR(0)="EO"
SET DIR("A")="Hit return to continue...."
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 QUIT
DONE ;ENTRY POINT - END OF REPORT TIME DISPLAY
+1 IF $DATA(ACDET)
SET ACDTS=(86400*($PIECE(ACDET,",")-$PIECE(ACDBT,",")))+($PIECE(ACDET,",",2)-$PIECE(ACDBT,",",2))
SET ACDH=$PIECE(ACDTS/3600,".")
IF ACDH=""
SET ACDH=0
Begin DoDot:1
+2 SET ACDTS=ACDTS-(ACDH*3600)
SET ACDM=$PIECE(ACDTS/60,".")
IF ACDM=""
SET ACDM=0
SET ACDTS=ACDTS-(ACDM*60)
SET ACDS=ACDTS
WRITE !!,"RUN TIME (H.M.S): ",ACDH,".",ACDM,".",ACDS
End DoDot:1
+3 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
SET DIR(0)="EO"
SET DIR("A")="End of report. HIT RETURN"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+4 IF $DATA(IOF)
WRITE @IOF
+5 KILL ACDTS,ACDS,ACDH,ACDM,ACDET
+6 QUIT
+7 ;
