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

AVAPI005.m

Go to the documentation of this file.
  1. AVAPI005 ; ; 15-AUG-1995 [ 06/03/2002 5:21 PM ]
  1. ;;93.2;PATCHES FOR VA SUPPPORT FILES;;AUG 15, 1995;Build 12
  1. Q:'DIFQ(200) F I=1:2 S X=$T(Q+I) Q:X="" S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,999) S:$A(Y)=61 Y=$E(Y,2,999) X NO E S @X=Y
  1. Q Q
  1. ;;^DD(200,53.5,1,2,3)
  1. ;;=Used to keep files 6 & 200 in sync.
  1. ;;^DD(200,53.5,1,2,"DT")
  1. ;;=2940511
  1. ;;^DD(200,53.5,1,999999901,0)
  1. ;;=^^TRIGGER^200^9999999.09
  1. ;;^DD(200,53.5,1,999999901,1)
  1. ;;=K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^VA(200,D0,9999999)):^(9999999),1:"") S X=$P(Y(1),U,9),X=X S DIU=X K Y X ^DD(200,53.5,1,999999901,1.1) X ^DD(200,53.5,1,999999901,1.4)
  1. ;;^DD(200,53.5,1,999999901,1.1)
  1. ;;=S X=DIV X $P(^DD(200,9999999.039,0),U,5,99) S Y(1)=X S X=Y(1)
  1. ;;^DD(200,53.5,1,999999901,1.4)
  1. ;;=S DIH=$S($D(^VA(200,DIV(0),9999999)):^(9999999),1:""),DIV=X S $P(^(9999999),U,9)=DIV,DIH=200,DIG=9999999.09 D ^DICR:$O(^DD(DIH,DIG,1,0))>0
  1. ;;^DD(200,53.5,1,999999901,2)
  1. ;;=K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^VA(200,D0,9999999)):^(9999999),1:"") S X=$P(Y(1),U,9),X=X S DIU=X K Y S X="" X ^DD(200,53.5,1,999999901,2.4)
  1. ;;^DD(200,53.5,1,999999901,2.4)
  1. ;;=S DIH=$S($D(^VA(200,DIV(0),9999999)):^(9999999),1:""),DIV=X S $P(^(9999999),U,9)=DIV,DIH=200,DIG=9999999.09 D ^DICR:$O(^DD(DIH,DIG,1,0))>0
  1. ;;^DD(200,53.5,1,999999901,"CREATE VALUE")
  1. ;;=IHS ADC
  1. ;;^DD(200,53.5,1,999999901,"DELETE VALUE")
  1. ;;=@
  1. ;;^DD(200,53.5,1,999999901,"DT")
  1. ;;=2930517
  1. ;;^DD(200,53.5,1,999999901,"FIELD")
  1. ;;=IHS ADC INDEX
  1. ;;^DD(200,53.5,3)
  1. ;;=Enter provider class of provider (MD, PA etc).
  1. ;;^DD(200,53.5,20,0)
  1. ;;=^.3LA^1^1
  1. ;;^DD(200,53.5,20,1,0)
  1. ;;=PS
  1. ;;^DD(200,53.5,21,0)
  1. ;;=^^1^1^2920930^
  1. ;;^DD(200,53.5,21,1,0)
  1. ;;=This field is used to show the provider class.
  1. ;;^DD(200,53.5,23,0)
  1. ;;=^^1^1^2920930^
  1. ;;^DD(200,53.5,23,1,0)
  1. ;;=pointer.
  1. ;;^DD(200,53.5,"DT")
  1. ;;=2940511
  1. ;;^DD(200,9999999.09,0)
  1. ;;=IHS ADC INDEX^FX^^9999999;9^K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>6!($L(X)<4) X I $D(X),$D(^DIC(6,"GIHS",X)),'$D(^DIC(6,"GIHS",X,DA)) K X W:'$D(ZTQUEUED) " THAT AFFIL-DISC-CODE ALREADY USED! "
  1. ;;^DD(200,9999999.09,1,0)
  1. ;;=^.1
  1. ;;^DD(200,9999999.09,1,1,0)
  1. ;;=200^ACXIHS09^MUMPS
  1. ;;^DD(200,9999999.09,1,1,1)
  1. ;;=N % S %=$P(^DIC(3,DA,0),U,16) I %]"" S:'$D(^DIC(6,%,9999999)) ^DIC(6,%,9999999)="" S $P(^(9999999),U,9)=X
  1. ;;^DD(200,9999999.09,1,1,2)
  1. ;;=N % S %=$P(^DIC(3,DA,0),U,16) I %]"",$D(^DIC(6,%,9999999)) S $P(^(9999999),U,9)=""
  1. ;;^DD(200,9999999.09,1,1,"DT")
  1. ;;=2930519
  1. ;;^DD(200,9999999.09,1,2,0)
  1. ;;=200^GIHS
  1. ;;^DD(200,9999999.09,1,2,1)
  1. ;;=S ^VA(200,"GIHS",$E(X,1,30),DA)=""
  1. ;;^DD(200,9999999.09,1,2,2)
  1. ;;=K ^VA(200,"GIHS",$E(X,1,30),DA)
  1. ;;^DD(200,9999999.09,1,2,"DT")
  1. ;;=2930518
  1. ;;^DD(200,9999999.09,3)
  1. ;;=Answer must be 4-6 characters in length.
  1. ;;^DD(200,9999999.09,5,1,0)
  1. ;;=200^53.5^999999901
  1. ;;^DD(200,9999999.09,5,2,0)
  1. ;;=200^9999999.01^2
  1. ;;^DD(200,9999999.09,5,3,0)
  1. ;;=200^9999999.02^3
  1. ;;^DD(200,9999999.09,9)
  1. ;;=^
  1. ;;^DD(200,9999999.09,"DT")
  1. ;;=2930519