| 1 | DGPMGLG5 ;ALB/LM - G&L GENERATION, CONT.; 27 APR 2003
|
|---|
| 2 | ;;5.3;Registration;**34,137,515,570**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | A ;
|
|---|
| 5 | S NLS=0 ; non-loss indicator
|
|---|
| 6 | I MV("TT")=2!(MV("TT")=3) D NLS ; MV("TT")=2 (transfer) MV("TT")=3 (disch)
|
|---|
| 7 | I MV("TT")=1!(MV("TT")=3)!(MV("TT")=6) D ID ; MV("TT")=1 (adm) MV("TT")=6 (TS transfer)
|
|---|
| 8 | ;
|
|---|
| 9 | Q Q
|
|---|
| 10 | ;
|
|---|
| 11 | NLS ; Non-Loss
|
|---|
| 12 | S X=$P(MDP,"^",18) ; type of movement
|
|---|
| 13 | I "^1^2^3^25^26^"[("^"_X_"^") S NLS=+X ; NLS=1 (PASS), NLS=2 (AA), NLS=3 (UA), NLS=25 (FROM AA TO UA), NLS=26 (FROM UA TO AA)
|
|---|
| 14 | S:MV("MT")=42 NLS=42 ; WHILE ASIH
|
|---|
| 15 | S:MV("MT")=47 NLS=47 ; DISCHARGE FROM NHCU/DOM WHILE ASIH
|
|---|
| 16 | Q
|
|---|
| 17 | ;
|
|---|
| 18 | ID ; ID info for patient and legend LEG(X) setup
|
|---|
| 19 | ; Q:MV("TT")'=1!(MV("TT")'=3) ; 1=adm, 3=disch
|
|---|
| 20 | ; Means Test
|
|---|
| 21 | ;I MT,$D(^DG(41.3,DFN,0)) S X=9999999.999998-TO S X=+$O(^DG(41.3,DFN,2,X)) I $D(^(X,0)) S X=$P(^(0),"^",2) I "^A^B^C^R^"[("^"_X_"^") S X=$C($A(X)+32),ID=ID_X,LEG(X)="" K X
|
|---|
| 22 | I MT,$D(^DGMT(408.31,"C",DFN)) N DGX,X D
|
|---|
| 23 | . S DGX=$$MTIENLT^DGMTU3(1,DFN,-TO)
|
|---|
| 24 | . I $D(^DGMT(408.31,+DGX,0)) D
|
|---|
| 25 | . . S X=$P(^(0),"^",3),X=$P(^DG(408.32,+X,0),"^",2)
|
|---|
| 26 | . . I $G(X)="P" D ;evaluate pending adjudication to MT (C) or GMT (G)
|
|---|
| 27 | . . . I '$D(DGX) S X="U" Q
|
|---|
| 28 | . . . S X=$$PA^DGMTUTL(DGX),X=$S('$D(X):"U",X="MT":"C",X="GMT":"G",1:"U")
|
|---|
| 29 | . . I "^A^B^C^G^R^"[("^"_X_"^") S X=$C($A(X)+32),ID=ID_X,LEG(X)="" K X,DGX
|
|---|
| 30 | INS ; Reimburse Insurance (+)
|
|---|
| 31 | S INS=0
|
|---|
| 32 | N DGINS,DGX
|
|---|
| 33 | ; API returns ONLY Active and Re-imbursable Insurance entries
|
|---|
| 34 | I $$INSUR^IBBAPI(DFN,"","",.DGINS,9) D
|
|---|
| 35 | . S DGX=0 F S DGX=$O(DGINS("IBBAPI","INSUR",DGX)) Q:'DGX S INS=INS+1
|
|---|
| 36 | S:INS>0 ID=ID_"+",LEG("+")=""
|
|---|
| 37 | K INS,INS1,JJ
|
|---|
| 38 | Q:MV("TT")'=3
|
|---|
| 39 | ; While ASIH (*), Discharge after less than 48 hours (#)
|
|---|
| 40 | I $D(^DGPM(+MV("CA"),0)) S X=^(0) S:$P(X,"^",15) ID=ID_"*",LEG("*")="" S X1=+X,X2=2 D C^%DTC I +MD'>X S ID=ID_"#",LEG("#")="" K X,X1,X2
|
|---|
| 41 | ; Absence (!)
|
|---|
| 42 | I MDP]"",$P(MDP,"^",2)=2 S X=$P(MDP,"^",18) I "^1^2^3^25^26^"[("^"_X_"^") S ID=ID_"!",LEG("!")="" K X
|
|---|
| 43 | Q
|
|---|
