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

ACDRLU1.m

Go to the documentation of this file. 
  1. ACDRLU1 ;IHS/ADC/EDE/KML - GEN RET UTIL;
  1.  ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
  1.  ;
  1. MCR ;display all current medicare data
  1.  NEW ACDMIFN
  1.  I '$D(^DPT(P,0)) G MCRX
  1.  I $P(^DPT(P,0),U,19) G MCRX
  1.  I '$D(^AUPNPAT(P,0)) G MCRX
  1.  I '$D(^AUPNMCR(P,11)) G MCRX
  1.  I $D(^DPT(P,.35)),$P(^(.35),U)]"",$P(^(.35),U)<D G MCRX
  1.  S ACDMIFN=0 F  S ACDMIFN=$O(^AUPNMCR(P,11,ACDMIFN)) Q:ACDMIFN'=+ACDMIFN  D
  1.  .Q:$P(^AUPNMCR(P,11,ACDMIFN,0),U)>D
  1.  .I $P(^AUPNMCR(P,11,ACDMIFN,0),U,2)]"",$P(^(0),U,2)<ACDACE Q
  1.  .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:"-")_"]"
  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)
  1.  .Q
  1. MCRX ;
  1.  K Y,Z
  1.  Q
  1.  ;
  1. MCD ;
  1.  NEW ACDMIFN,ACDNIFN
  1.  I '$D(^DPT(P,0)) G MCDX
  1.  I $P(^DPT(P,0),U,19) G MCDX
  1.  I '$D(^AUPNPAT(P,0)) G MCDX
  1.  I $D(^DPT(P,.35)),$P(^(.35),U)]"",$P(^(.35),U)<D G MCDX
  1.  S ACDMIFN=0 F  S ACDMIFN=$O(^AUPNMCD("B",P,ACDMIFN)) Q:ACDMIFN'=+ACDMIFN  D
  1.  .Q:'$D(^AUPNMCD(ACDMIFN,11))
  1.  .S ACDNIFN=0 F  S ACDNIFN=$O(^AUPNMCD(ACDMIFN,11,ACDNIFN)) Q:ACDNIFN'=+ACDNIFN  D
  1.  ..Q:ACDNIFN>D
  1.  ..I $P(^AUPNMCD(ACDMIFN,11,ACDNIFN,0),U,2)]"",$P(^(0),U,2)<D Q
  1.  ..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:"<>")
  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)
  1.  ..Q
  1.  .Q
  1.  ;
  1. MCDX ;
  1.  Q
  1.  ;
  1. PI ;
  1.  NEW ACDMIFN,ACDFLG
  1.  I '$D(^DPT(P,0)) G PIX
  1.  I $P(^DPT(P,0),U,19) G PIX
  1.  I '$D(^AUPNPAT(P,0)) G PIX
  1.  I '$D(^AUPNPRVT(P,11)) G PIX
  1.  I $D(^DPT(P,.35)),$P(^(.35),U)]"",$P(^(.35),U)<D G PIX
  1.  S ACDMIFN=0 F  S ACDMIFN=$O(^AUPNPRVT(P,11,ACDMIFN)) Q:ACDMIFN'=+ACDMIFN  D
  1.  .Q:$P(^AUPNPRVT(P,11,ACDMIFN,0),U)=""
  1.  .S ACDNAME=$P(^AUPNPRVT(DFN,11,ACDMIFN,0),U) Q:ACDNAME=""
  1.  .Q:$P(^AUTNINS(ACDNAME,0),U)["AHCCCS"
  1.  .Q:$P(^AUPNPRVT(P,11,ACDMIFN,0),U,6)>D
  1.  .I $P(^AUPNPRVT(P,11,ACDMIFN,0),U,7)]"",$P(^(0),U,7)<ACDACE Q
  1.  .S ACDPCNT=ACDPCNT+1,ACDPRNM(ACDPCNT)=$P(^AUTNINS($P(^AUPNPRVT(P,11,ACDMIFN,0),U),0),U)
  1.  .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)
  1.  .Q
  1. PIX ;
  1.  Q
  1. CALLDIE ;EP
  1.  Q:'$D(DA)
  1.  Q:'$D(DIE)
  1.  K DIV,DIU,DIY,DIW,DIG,DIH
  1.  NEW ACDG S ACDG=DIE_DA_")" L +(@ACDG):10 E  W !!,"Can't lock global",! Q
  1.  Q:'$D(DR)
  1.  D ^DIE
  1.  L -(@ACDG):10
  1.  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
  1.  Q
  1. PAUSE ;EP
  1.  Q:$E(IOST)'="C"!(IO'=IO(0))
  1.  W ! S DIR(0)="EO",DIR("A")="Hit return to continue...." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  Q
  1. DONE ;ENTRY POINT - END OF REPORT TIME DISPLAY
  1.  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
  1.  .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
  1.  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
  1.  W:$D(IOF) @IOF
  1.  K ACDTS,ACDS,ACDH,ACDM,ACDET
  1.  Q
  1.  ;