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

APC6I002.m

Go to the documentation of this file.
APC6I002 ; ; 04-FEB-2003
 ;;2.0;IHS RPMS/PCC Data Entry;**6**;MAR 09, 1999
 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",528,"DR",2,9000010)
 ;;=I $P($G(APCDPARM),U,16)'="Y" W !!,$C(7),"Your site parameters file does not indicate that Outside Location can be entered!",! S Y="@1";2101;@1;
 ;;^UTILITY(U,$J,"DIE",528,"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,"DIE",555,0)
 ;;=APCD HL (HL)^2930304.1721^^9000010^^^^
 ;;^UTILITY(U,$J,"DIE",555,"DR",1,9000010)
 ;;=.22;
 ;;^UTILITY(U,$J,"DIE",556,0)
 ;;=APCD HL (HL)^2930304.1721^^9000001^^^^
 ;;^UTILITY(U,$J,"DIE",556,"DIAB",2,0,9000001,0)
 ;;=LOOKUP:VISIT:
 ;;^UTILITY(U,$J,"DIE",556,"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",556,"DR",2,9000010)
 ;;=.22;
 ;;^UTILITY(U,$J,"DIE",556,"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,"DIE",598,0)
 ;;=APCD ECOD (ECOD)^3001109.1523^^9000010^^^^
 ;;^UTILITY(U,$J,"DIE",598,"DIAB",1,0,9000010,1)
 ;;=LOOKUP:V POV:
 ;;^UTILITY(U,$J,"DIE",598,"DIAB",1,1,9000010.07,0)
 ;;=.09;"Enter E-CODE"
 ;;^UTILITY(U,$J,"DIE",598,"DIAB",2,1,9000010.07,0)
 ;;=.11;PLACE OF ACCIDENT/INJURY
 ;;^UTILITY(U,$J,"DIE",598,"DR",1,9000010)
 ;;=S APCDSWD=9000010.07,APCDSWV=APCDVSIT D ^APCDSW S:APCDLOOK APCDLOOK="`"_APCDLOOK;
 ;;^UTILITY(U,$J,"DIE",598,"DR",1,9000010,1)
 ;;=^9000010.07^AUPNVPOV(^^X DR(99,1,9.2) S Y(101)=$S($D(^AUPNVPOV(D0,0)):^(0),1:"") S X=$S('$D(^ICD9(+$P(Y(101),U,1),0)):"",1:$P(^(0),U,1)) S D0=I(0,0) S X=$S(D(0)>0:D(0),1:"");K APCDLOOK,APCDSWV,APCDSWD;
 ;;^UTILITY(U,$J,"DIE",598,"DR",2,9000010.07)
 ;;=.09Enter E-CODE~;.11PLACE OF ACCIDENT/INJURY~;
 ;;^UTILITY(U,$J,"DIE",598,"DR",99,1,9.2)
 ;;=X $P(^DD(9000010,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="^AUPNVPOV(",DIC(0)="NMF" D ^DIC S (D,D0,D(0))=+Y
 ;;^UTILITY(U,$J,"DIE",599,0)
 ;;=APCD STG (STG)^2930607.0749^^9000001^^^^
 ;;^UTILITY(U,$J,"DIE",599,"DIAB",1,1,9000010,1)
 ;;=LOOKUP:V POV:
 ;;^UTILITY(U,$J,"DIE",599,"DIAB",2,0,9000001,0)
 ;;=LOOKUP:VISIT:
 ;;^UTILITY(U,$J,"DIE",599,"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",599,"DR",2,9000010)
 ;;=S APCDSWD=9000010.07,APCDSWV=DA D ^APCDSW S:APCDLOOK APCDLOOK="`"_APCDLOOK;
 ;;^UTILITY(U,$J,"DIE",599,"DR",2,9000010,1)
 ;;=^9000010.07^AUPNVPOV(^^X DR(99,2,9.2) S Y(201)=$S($D(^AUPNVPOV(D0,0)):^(0),1:"") S X=$S('$D(^ICD9(+$P(Y(201),U,1),0)):"",1:$P(^(0),U,1)) S D0=I(100,0) S X=$S(D(0)>0:D(0),1:"");
 ;;^UTILITY(U,$J,"DIE",599,"DR",3,9000010.07)
 ;;=.05;
 ;;^UTILITY(U,$J,"DIE",599,"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,"DIE",599,"DR",99,2,9.2)
 ;;=X $P(^DD(9000010,9999,0),U,5,99) S Y(101)=X S I(100,0)=$S($D(D0):D0,1:"") S X=Y(101) K DIC S DIC="^AUPNVPOV(",DIC(0)="NMF" D ^DIC S (D,D0,D(0))=+Y
 ;;^UTILITY(U,$J,"DIE",604,0)
 ;;=APCD ECOD (ECOD)^3001109.1524^^9000001^^^^
 ;;^UTILITY(U,$J,"DIE",604,"DIAB",1,1,9000010,1)
 ;;=LOOKUP:V POV:
 ;;^UTILITY(U,$J,"DIE",604,"DIAB",1,2,9000010.07,0)
 ;;=.09;"Enter E-CODE"
 ;;^UTILITY(U,$J,"DIE",604,"DIAB",2,0,9000001,0)
 ;;=LOOKUP:VISIT:
 ;;^UTILITY(U,$J,"DIE",604,"DIAB",2,2,9000010.07,0)
 ;;=PLACE OF ACC;"PLACE OF ACCIDENT/INJURY"
 ;;^UTILITY(U,$J,"DIE",604,"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",604,"DR",2,9000010)
 ;;=S APCDSWD=9000010.07,APCDSWV=DA D ^APCDSW S:APCDLOOK APCDLOOK="`"_APCDLOOK;
 ;;^UTILITY(U,$J,"DIE",604,"DR",2,9000010,1)
 ;;=^9000010.07^AUPNVPOV(^^X DR(99,2,9.2) S Y(201)=$S($D(^AUPNVPOV(D0,0)):^(0),1:"") S X=$S('$D(^ICD9(+$P(Y(201),U,1),0)):"",1:$P(^(0),U,1)) S D0=I(100,0) S X=$S(D(0)>0:D(0),1:"");
 ;;^UTILITY(U,$J,"DIE",604,"DR",3,9000010.07)
 ;;=.09Enter E-CODE~;.11PLACE OF ACCIDENT/INJURY~;
 ;;^UTILITY(U,$J,"DIE",604,"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