| [613] | 1 | DGHELP ;ALB/JDS - EXECUTABLE ADT HELP PROMPTS ; 14 JUN 84 11:29
|
|---|
| 2 | ;;5.3;Registration;;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | EN ;called from ques node on dispo multiple
|
|---|
| 5 | Q
|
|---|
| 6 | P305 W !!,"Enter a string of characters, 1-5 characters in length",!,"It must only contain:",?25,"'A' for Aide and Assistance amount"
|
|---|
| 7 | W !?25,"'H' for HB amount",!?25,"'S' for Social Security amount",!?25,"'R' for Retirement pay amount",!?25,"'D' for Disability amount."
|
|---|
| 8 | W !?25,"'P' for Pension amount"
|
|---|
| 9 | Q
|
|---|
| 10 | UP I X'?.UNP F %=1:1:$L(X) I $E(X,%)?1L S X=$E(X,0,%-1)_$C($A(X,%)-32)_$E(X,%+1,999)
|
|---|
| 11 | Q
|
|---|
| 12 | IN S %=0 D UP I X]""&(Z[(U_X)) F I=$F(Z,U_X):1 S %=$E(Z,I) Q:%=U!(%']"") W %
|
|---|
| 13 | E S %=-1
|
|---|
| 14 | S:'% X=$E(X,1) K Z
|
|---|
| 15 | Q
|
|---|
| 16 | LOCK I '$D(^XUSEC("DG ELIGIBILITY",DUZ)),$D(^DPT(DFN,.361)) I $P(^(.361),U,1)="V" W !,"Verification of Eligibility done Eligibility Key required to edit this field" K X
|
|---|
| 17 | Q
|
|---|
| 18 | LOC I '$D(^XUSEC("DG ELIGIBILITY",DUZ)) W !,"Eligibility Key required to edit this field" K X
|
|---|
| 19 | Q
|
|---|
| 20 | DOB S Y=$P(^DPT(DA,0),U,3) I Y,X<(100000+Y) K X X ^DD("DD") W !,"Patient's DOB is ",Y
|
|---|
| 21 | Q
|
|---|
| 22 | SSN I X'?.UN F %=1:1:$L(X) I $E(X,%)?1P S X=$E(X,0,%-1)_$E(X,%+1,999)
|
|---|
