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

APC3I001.m

Go to the documentation of this file.
APC3I001 ; ; 13-JUL-2000
 ;;2.0;IHS RPMS/PCC Data Entry;**3**;AUG 24, 2000
 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,"DIE",1769,0)
 ;;=APCD CC (CC)^3000710.1321^^9000010^^^^
 ;;^UTILITY(U,$J,"DIE",1769,"DR",1,9000010)
 ;;=1401;
 ;;^UTILITY(U,$J,"DIE",1770,0)
 ;;=APCD CC (CC)^3000710.1321^^9000001^^^^
 ;;^UTILITY(U,$J,"DIE",1770,"DIAB",2,0,9000001,0)
 ;;=LOOKUP:VISIT:
 ;;^UTILITY(U,$J,"DIE",1770,"DR",1,9000001)
 ;;=S APCDPAT=DA D ^APCDVLK S:APCDLOOK APCDLOOK="`"_APCDLOOK;^9000010^AUPNVSIT(^^X DR(99,1,9.2) S Y(101)=$S($D(^AUPNVSIT(D0,0)):^(0),1:"") S X=$P(Y(101),U,1) S D0=I(0,0) S X=$S(D(0)>0:D(0),1:"");
 ;;^UTILITY(U,$J,"DIE",1770,"DR",2,9000010)
 ;;=1401;
 ;;^UTILITY(U,$J,"DIE",1770,"DR",99,1,9.2)
 ;;=X $P(^DD(9000001,9999,0),U,5,99) S Y(1)=X S I(0,0)=$S($D(D0):D0,1:"") S X=Y(1) K DIC S DIC="^AUPNVSIT(",DIC(0)="NMF" D ^DIC S (D,D0,D(0))=+Y
 ;;^UTILITY(U,$J,"PKG",323,0)
 ;;=APC3 - DATA ENTRY PATCH 3^APC3^APC3 - DATA ENTRY PATCH 3
 ;;^UTILITY(U,$J,"PKG",323,22,0)
 ;;=^9.49I^1^1
 ;;^UTILITY(U,$J,"PKG",323,22,1,0)
 ;;=1.0^3000713
 ;;^UTILITY(U,$J,"PKG",323,22,"B","1.0",1)
 ;;=
 ;;^UTILITY(U,$J,"PKG",323,"DIE",0)
 ;;=^9.47^2^2
 ;;^UTILITY(U,$J,"PKG",323,"DIE",1,0)
 ;;=APCD CC (CC)^9000010
 ;;^UTILITY(U,$J,"PKG",323,"DIE",2,0)
 ;;=APCD CC (CC)^9000001