©2011-2018 Open Source Electronic Health Record Alliance
This work is licensed under a Creative Commons Attribution 3.0 Unported License
This work is licensed under a Creative Commons Attribution 3.0 Unported License
AVAPI005 ; ; 15-AUG-1995 [ 06/03/2002 5:21 PM ]
;;93.2;PATCHES FOR VA SUPPPORT FILES;;AUG 15, 1995;Build 12
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
Q Q
;;^DD(200,53.5,1,2,3)
;;=Used to keep files 6 & 200 in sync.
;;^DD(200,53.5,1,2,"DT")
;;=2940511
;;^DD(200,53.5,1,999999901,0)
;;=^^TRIGGER^200^9999999.09
;;^DD(200,53.5,1,999999901,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)
;;^DD(200,53.5,1,999999901,1.1)
;;=S X=DIV X $P(^DD(200,9999999.039,0),U,5,99) S Y(1)=X S X=Y(1)
;;^DD(200,53.5,1,999999901,1.4)
;;=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
;;^DD(200,53.5,1,999999901,2)
;;=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)
;;^DD(200,53.5,1,999999901,2.4)
;;=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
;;^DD(200,53.5,1,999999901,"CREATE VALUE")
;;=IHS ADC
;;^DD(200,53.5,1,999999901,"DELETE VALUE")
;;=@
;;^DD(200,53.5,1,999999901,"DT")
;;=2930517
;;^DD(200,53.5,1,999999901,"FIELD")
;;=IHS ADC INDEX
;;^DD(200,53.5,3)
;;=Enter provider class of provider (MD, PA etc).
;;^DD(200,53.5,20,0)
;;=^.3LA^1^1
;;^DD(200,53.5,20,1,0)
;;=PS
;;^DD(200,53.5,21,0)
;;=^^1^1^2920930^
;;^DD(200,53.5,21,1,0)
;;=This field is used to show the provider class.
;;^DD(200,53.5,23,0)
;;=^^1^1^2920930^
;;^DD(200,53.5,23,1,0)
;;=pointer.
;;^DD(200,53.5,"DT")
;;=2940511
;;^DD(200,9999999.09,0)
;;=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! "
;;^DD(200,9999999.09,1,0)
;;=^.1
;;^DD(200,9999999.09,1,1,0)
;;=200^ACXIHS09^MUMPS
;;^DD(200,9999999.09,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
;;^DD(200,9999999.09,1,1,2)
;;=N % S %=$P(^DIC(3,DA,0),U,16) I %]"",$D(^DIC(6,%,9999999)) S $P(^(9999999),U,9)=""
;;^DD(200,9999999.09,1,1,"DT")
;;=2930519
;;^DD(200,9999999.09,1,2,0)
;;=200^GIHS
;;^DD(200,9999999.09,1,2,1)
;;=S ^VA(200,"GIHS",$E(X,1,30),DA)=""
;;^DD(200,9999999.09,1,2,2)
;;=K ^VA(200,"GIHS",$E(X,1,30),DA)
;;^DD(200,9999999.09,1,2,"DT")
;;=2930518
;;^DD(200,9999999.09,3)
;;=Answer must be 4-6 characters in length.
;;^DD(200,9999999.09,5,1,0)
;;=200^53.5^999999901
;;^DD(200,9999999.09,5,2,0)
;;=200^9999999.01^2
;;^DD(200,9999999.09,5,3,0)
;;=200^9999999.02^3
;;^DD(200,9999999.09,9)
;;=^
;;^DD(200,9999999.09,"DT")
;;=2930519