AUP6I004 ; ; 31-AUG-2004
;;93.2;AUP6;;AUG 31, 2004
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
;;^UTILITY(U,$J,"PKG",404,0)
;;=AUP6^AUP6^FIELD .14 OF 9000001 FOR PT 6
;;^UTILITY(U,$J,"PKG",404,4,0)
;;=^9.44PA^1^1
;;^UTILITY(U,$J,"PKG",404,4,1,0)
;;=9000001
;;^UTILITY(U,$J,"PKG",404,4,1,1,0)
;;=^9.45A^1^1
;;^UTILITY(U,$J,"PKG",404,4,1,1,1,0)
;;=PRIMARY CARE PROVIDER
;;^UTILITY(U,$J,"PKG",404,4,1,1,"B","PRIMARY CARE PROVIDER",1)
;;=
;;^UTILITY(U,$J,"PKG",404,4,1,222)
;;=y^n^^n^^^n
;;^UTILITY(U,$J,"PKG",404,4,1,223)
;;=
;;^UTILITY(U,$J,"PKG",404,4,"B",9000001,1)
;;=
;;^UTILITY(U,$J,"PKG",404,22,0)
;;=^9.49I^1^1
;;^UTILITY(U,$J,"PKG",404,22,1,0)
;;=93.2^3040831
;;^UTILITY(U,$J,"PKG",404,22,"B",93.2,1)
;;=
;;^UTILITY(U,$J,"SBF",9000001,9000001)
;;=
AUP6I004 ; ; 31-AUG-2004
+1 ;;93.2;AUP6;;AUG 31, 2004
+2 FOR I=1:2
SET X=$TEXT(Q+I)
IF X=""
QUIT
SET Y=$EXTRACT($TEXT(Q+I+1),4,999)
SET X=$EXTRACT(X,4,999)
IF $ASCII(Y)=126
SET I=I+1
SET Y=$EXTRACT(Y,2,999)_$EXTRACT($TEXT(Q+I+1),5,999)
IF $ASCII(Y)=61
SET Y=$EXTRACT(Y,2,999)
XECUTE NO
IF '$TEST
SET @X=Y
Q QUIT
+1 ;;^UTILITY(U,$J,"PKG",404,0)
+2 ;;=AUP6^AUP6^FIELD .14 OF 9000001 FOR PT 6
+3 ;;^UTILITY(U,$J,"PKG",404,4,0)
+4 ;;=^9.44PA^1^1
+5 ;;^UTILITY(U,$J,"PKG",404,4,1,0)
+6 ;;=9000001
+7 ;;^UTILITY(U,$J,"PKG",404,4,1,1,0)
+8 ;;=^9.45A^1^1
+9 ;;^UTILITY(U,$J,"PKG",404,4,1,1,1,0)
+10 ;;=PRIMARY CARE PROVIDER
+11 ;;^UTILITY(U,$J,"PKG",404,4,1,1,"B","PRIMARY CARE PROVIDER",1)
+12 ;;=
+13 ;;^UTILITY(U,$J,"PKG",404,4,1,222)
+14 ;;=y^n^^n^^^n
+15 ;;^UTILITY(U,$J,"PKG",404,4,1,223)
+16 ;;=
+17 ;;^UTILITY(U,$J,"PKG",404,4,"B",9000001,1)
+18 ;;=
+19 ;;^UTILITY(U,$J,"PKG",404,22,0)
+20 ;;=^9.49I^1^1
+21 ;;^UTILITY(U,$J,"PKG",404,22,1,0)
+22 ;;=93.2^3040831
+23 ;;^UTILITY(U,$J,"PKG",404,22,"B",93.2,1)
+24 ;;=
+25 ;;^UTILITY(U,$J,"SBF",9000001,9000001)
+26 ;;=