Routine: APC6I003

APC6I003 ; ; 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",604,"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",605,0)

 ;;=APCD STG (STG)^2981202.1525^^9000010^^^^

 ;;^UTILITY(U,$J,"DIE",605,"DIAB",1,0,9000010,1)

 ;;=LOOKUP:V POV:

 ;;^UTILITY(U,$J,"DIE",605,"DR",1,9000010)

 ;;=S APCDSWD=9000010.07,APCDSWV=APCDVSIT D ^APCDSW S:APCDLOOK APCDLOOK="`"_APCDLOOK;

 ;;^UTILITY(U,$J,"DIE",605,"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",605,"DR",2,9000010.07)

 ;;=.05;

 ;;^UTILITY(U,$J,"DIE",605,"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",611,0)

 ;;=APCD EM (EM)^2950320.0751^^9000010^^^^

 ;;^UTILITY(U,$J,"DIE",611,"DR",1,9000010)

 ;;=.17;

 ;;^UTILITY(U,$J,"DIE",722,0)

 ;;=APCD APPT (APPT)^2960710.0831^^9000010^^^^

 ;;^UTILITY(U,$J,"DIE",722,"DR",1,9000010)

 ;;=.26;

 ;;^UTILITY(U,$J,"DIE",1688,0)

 ;;=APCD CKO (CKO)^2980507.0905^^9000010^^^^

 ;;^UTILITY(U,$J,"DIE",1688,"DR",1,9000010)

 ;;=I $P(^AUPNVSIT(DA,0),U,18)]"" S Y="@5";@3;S %DT="AEX",%DT("A")="Enter the CHECK OUT DATE: ",%DT("B")=$$FMTE^XLFDT($P(APCDDATE,".")) D ^%DT S APCDTD=Y K Y I APCDTD=-1,X="" S Y="@9";

 ;;^UTILITY(U,$J,"DIE",1688,"DR",1,9000010,1)

 ;;=I APCDTD=-1 W !,$C(7),"Enter a valid date" S Y="@3";W !,"  Enter CHECK OUT TIME: " R X;I X="" S Y="@9";I X["^" S Y="@9";S X=$$FMTE^XLFDT(APCDTD)_"@"_X W !,X;

 ;;^UTILITY(U,$J,"DIE",1688,"DR",1,9000010,2)

 ;;=S %DT="ETX" D ^%DT K:Y<1 X K Y I '$D(X) W !!,"Invalid time!!!",APCDBEEP S Y="@3";S APCDTX=X;.18///^S X=APCDTX;S Y="@9";@5;.18;@9;.31;K APCDTAW,APCDTD,APCDTX;

 ;;^UTILITY(U,$J,"DIE",1689,0)

 ;;=APCD AL (AL)^2980507.0907^^9000010^^^^

 ;;^UTILITY(U,$J,"DIE",1689,"DR",1,9000010)

 ;;=.31;

 ;;^UTILITY(U,$J,"DIE",1697,0)

 ;;=APCD TA (TA)^2980702.0831^^9000001^^^^

 ;;^UTILITY(U,$J,"DIE",1697,"DIAB",2,0,9000001,0)

 ;;=LOOKUP:VISIT:

 ;;^UTILITY(U,$J,"DIE",1697,"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",1697,"DR",2,9000010)

 ;;=.32;

 ;;^UTILITY(U,$J,"DIE",1697,"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",1704,0)

 ;;=APCD TA (TA)^2981005.2119^^9000010^^^^

 ;;^UTILITY(U,$J,"DIE",1704,"DR",1,9000010)

 ;;=.32;

 ;;^UTILITY(U,$J,"DIE",1706,0)

 ;;=APCD FL (FL)^2981123.0948^^9000010^^^^

 ;;^UTILITY(U,$J,"DIE",1706,"DR",1,9000010)

 ;;=1601;

 ;;^UTILITY(U,$J,"DIE",1709,0)

 ;;=APCD EM (EM)^2981123.0956^^9000001^^^^

 ;;^UTILITY(U,$J,"DIE",1709,"DIAB",2,0,9000001,0)

 ;;=LOOKUP:VISIT:

 ;;^UTILITY(U,$J,"DIE",1709,"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",1709,"DR",2,9000010)

 ;;=.17;

 ;;^UTILITY(U,$J,"DIE",1709,"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",1710,0)

 ;;=APCD FL (FL)^2981123.0957^^9000001^^^^

 ;;^UTILITY(U,$J,"DIE",1710,"DIAB",2,0,9000001,0)

 ;;=LOOKUP:VISIT:

 ;;^UTILITY(U,$J,"DIE",1710,"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",1710,"DR",2,9000010)

 ;;=1601;

 ;;^UTILITY(U,$J,"DIE",1710,"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",1711,0)

 ;;=APCD APPT (APPT)^2981123.0957^^9000001^^^^

 ;;^UTILITY(U,$J,"DIE",1711,"DIAB",2,0,9000001,0)

 ;;=LOOKUP:VISIT:

 ;;^UTILITY(U,$J,"DIE",1711,"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:"");

APC6I003.m