| [613] | 1 | PRPFU1 ;ALTOONA/CTB PATIENT FUNDS UTILITY PROGRAM ;11/22/96 4:47 PM
|
|---|
| 2 | V ;;3.0;PATIENT FUNDS;**6**;JUNE 1, 1989
|
|---|
| 3 | ;ENTRY TO BREAK OUT FULL DESSCIPTION FROM SET OF CODES
|
|---|
| 4 | ;VARIABLES: X=INTERNAL VALUE
|
|---|
| 5 | ; DD=DD NUMBER
|
|---|
| 6 | ; F=FIELD NUMBER
|
|---|
| 7 | ;RETURNS DESCRIPTION VALUE IN VARIABLE Y
|
|---|
| 8 | ;RETURNS %=1 WHEN SUCCESSFUL, %=0 WHEN LOOKUP FAILED
|
|---|
| 9 | ;X,DD,F ARE KILLED
|
|---|
| 10 | SE I X="" S Y="" Q
|
|---|
| 11 | S I=2 D SET,Y^DIQ,KILL Q
|
|---|
| 12 | SET K Y S U="^",%=0,Y="" Q:'$D(X)!('$D(DD))!('$D(F))
|
|---|
| 13 | Q:X=""!(DD="")!(F="")
|
|---|
| 14 | S Y=X,X="S C=$P(^DD("_DD_","_F_",0),U,"_I_")" X X Q
|
|---|
| 15 | Q
|
|---|
| 16 | KILL K DD,I,C,X,F Q
|
|---|
| 17 | EXIT ;MASTER MENU EXIT LINE
|
|---|
| 18 | K PRPF Q
|
|---|
| 19 | DATE(Y) ;FUNCTION TO RETURN DATE IN EXTERNAL FORMAT
|
|---|
| 20 | D D Q Y
|
|---|
| 21 | ;
|
|---|
| 22 | D ;CONVERTS FILEMAN INTERNAL DATE TO EXTERNAL FORMAT
|
|---|
| 23 | S:Y Y=$S($E(Y,4,5):$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",+$E(Y,4,5))_" ",1:"")_$S($E(Y,6,7):+$E(Y,6,7)_",",1:"")_($E(Y,1,3)+1700)_$P("@"_$E(Y_0,9,10)_":"_$E(Y_"000",11,12),"^",Y[".")
|
|---|
| 24 | Q
|
|---|
| 25 | MSG ;;PRINTS MESSAGE CONTAINED IN X. IF IT DOESNT FIT ON ONE LINE, X IS PRINTED ON THE NEXT LINE.
|
|---|
| 26 | N X1,X2,ZX Q:'$D(X) I $S('$D(IOM):1,IOM="":1,1:0) W $P(X,"*") R X:2 K X Q
|
|---|
| 27 | I ($L($P(X,"*"))+4+$X)>IOM W !,?(IOM-($L($P(X,"*"))+4))
|
|---|
| 28 | F ZX=1:1 D BRK:($L(X)+6)>IOM W " ",$P(X,"*"),! Q:'$D(X1) S X=X1 K X1
|
|---|
| 29 | W:X["*" *7
|
|---|
| 30 | Q
|
|---|
| 31 | BRK N I
|
|---|
| 32 | S X1=X F I=1:1 Q:$L($P(X," ",1,I))>(IOM-6)!($L(X)<(IOM-6)) S X1=$P(X," ",1,I)
|
|---|
| 33 | S X2=$P(X," ",I,999),X=X1,X1=X2 K X2 Q
|
|---|
| 34 | DGINPW S DFN(.1)="",DOA="" K VAINDT D INP^VADPT Q:$D(VAIN)<10
|
|---|
| 35 | I $D(VAIN(4)),VAIN(4)]"" S DFN(.1)=$P(VAIN(4),"^",2)
|
|---|
| 36 | I $D(VAIN(7)),VAIN(7)]"" S DOA=$P(VAIN(7),"^",2)
|
|---|
| 37 | K VAIN
|
|---|
| 38 | Q
|
|---|
