| 1 | XUTMG145 ;SEA/RDS - TaskMan: Globals: Code for File 14.5 ;5/17/91 12:54 ;
|
|---|
| 2 | ;;8.0;KERNEL;;Jul 10, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | IT01 ;input transform for field .01
|
|---|
| 7 | I $L(X)>30!($L(X)<2)!'(X'?1P.E) K X Q
|
|---|
| 8 | I $D(DA)#2,DA]"",$D(^%ZIS(14.5,DA,0))#2,$P(^(0),U)=X Q
|
|---|
| 9 | I $O(^%ZIS(14.5,"B",X,""))]"" K X S ZTUNIQUE=0 Q
|
|---|
| 10 | Q
|
|---|
| 11 | ;
|
|---|
| 12 | S01 ;set statement for field .01
|
|---|
| 13 | N DIG,DIH,DIU,DIV,ZT,ZT1,ZTDA,ZTD0,ZTS,ZTX
|
|---|
| 14 | S ZTX=X,ZTDA=DA,DIH=14.6
|
|---|
| 15 | S ZT1="" F ZT=0:0 S ZT1=$O(^%ZIS(14.6,ZT1)) Q:ZT1="" I $D(^%ZIS(14.6,ZT1,0))#2 S ZTS=^(0) D S01A
|
|---|
| 16 | S X=ZTX,DA=ZTDA Q
|
|---|
| 17 | ;
|
|---|
| 18 | S01A ;S01--re-crossreference appropriate fields
|
|---|
| 19 | S DA=ZT1,D0=ZT1,DIV(0)=DA,DIU=ZTDA,DIV=ZTDA
|
|---|
| 20 | I $P(ZTS,U,5)=ZTDA S DIG=1 D ^DICR Q
|
|---|
| 21 | I $P(ZTS,U,6)=ZTDA S DIG=2 D ^DICR Q
|
|---|
| 22 | Q
|
|---|
| 23 | ;
|
|---|
