1 | SOWKHR1 ;B'HAM ISC/SAB-ROUTINE TO PRINT HIGH RISK SCREENING PROFILES ; 01 Mar 93 / 8:47 AM
|
---|
2 | ;;3.0; Social Work ;;27 Apr 93
|
---|
3 | U IO W:$Y @IOF,! F Q=1:1:80 W "_"
|
---|
4 | W !,?20,"SOCIAL WORK SERVICE-REPORTS AND SUMMARIES"
|
---|
5 | F E=1:1:2 W ! F W=1:1:80 W "-"
|
---|
6 | W !,?23,"SOCIAL WORK HIGH RISK SCREENING PROFILE",!!
|
---|
7 | F B=0:0 S B=$O(S(B)) Q:'B W "WORKER: "_$P(^VA(200,$P(S(B),"^"),0),"^"),?45,$P(S(B),"^",2)_" "_$P(S(B),"^",3),!
|
---|
8 | I '$O(S(0)) W "SOCIAL WORKER: CASE NOT OPENED TO SOCIAL WORK SERVICE",!
|
---|
9 | W !,"DATE ADMITTED: "_$P(VAIN(7),"^",2),?$X+20,"DATE SCREENED:____________ ",!!
|
---|
10 | W "CLAIM #: "_VAEL(7),!,"PROVIDER: "_$P(VAIN(2),"^",2),!,"PATIENT ADDRESS: "_$S(VAPA(1)]"":VAPA(1)_" "_VAPA(2)_" "_VAPA(4)_", "_$P(VAPA(5),"^",2)_" "_VAPA(6)_" PHONE: "_VAPA(8),1:"PATIENT ADDRESS UNAVAILABLE"),!
|
---|
11 | W !,"NOK NAME: "_VAOA(9)_" "_"RELATIONSHIP: "_VAOA(10),!!,"NOK ADDRESS: "_VAOA(1)_" "_VAOA(2)_" "_VAOA(4)_", "_$P(VAOA(5),"^",2)_" "_VAOA(6)_" "_" PHONE: "_VAOA(8),!!
|
---|
12 | AD W !,"ADDITIONAL CONTACTS:" F Z=1:1:60 W "_"
|
---|
13 | W !! F Z=1:1:80 W "_"
|
---|
14 | W !!,"DOB: "_$P(VADM(3),"^",2)_" AGE: "_VADM(4)," MARITAL STATUS: "_$P(VADM(10),"^",2),!!,"EMPLOYMENT STATUS: "_$P(VAPD(7),"^",2) I MON D IC
|
---|
15 | I SK W !!,"INSURANCE COVERAGE: " F K=1:1 Q:'$D(IC(K)) W IC(K)_" "
|
---|
16 | W !!,"VETERANS STATUS: "_$S(+VAEL(3):"SC ",1:"NSC ") W:+VAMB(1) "A&A " W:+VAMB(2) "HB "
|
---|
17 | W ?55," SC CONDITION: "_$S(+VAEL(3):$P(VAEL(3),"^",2)_"%",1:""),!
|
---|
18 | W !,"ADMISSION DIAGNOSIS: "_VAIN(9)
|
---|
19 | W !!,"LOCATION LAST VA TREATMENT: " I $D(^DPT(DFN,1010.15)),$P(^DPT(DFN,1010.15),"^",2)]"" W $S($D(^DIC(4,$P(^DPT(DFN,1010.15),"^",2),0)):$P(^DIC(4,$P(^DPT(DFN,1010.15),"^",2),0),"^"),1:"UNKNOWN")
|
---|
20 | W !!,"POSITIVE SCREENING CRITERIA: " F T=1:1 Q:'$D(T(T)) W:$X+$L(T(T))>80 ! W T(T)
|
---|
21 | W !!,"SOCIAL WORKER ASSESSMENT & PLAN:" F Z=1:1:48 W "_"
|
---|
22 | F A=1:1:3 W !! F Z=1:1:80 W "_"
|
---|
23 | W !,"PATIENT NAME: "_$P(^DPT(DFN,0),"^"),!,"ID#: "_VA("PID"),?50 F Z=1:1:30 W "_"
|
---|
24 | W !,"WARD NO.: "_$P(VAIN(4),"^",2),!,"ROOM NO.: "_VAIN(5)
|
---|
25 | W ?50,"Social Worker",!!!,?25,"Social Work Service Reports and Summaries",!,?25,"10-9034 VAF VICE 10-1349" F T=1:1 Q:'$D(T(T)) S T(T)=""
|
---|
26 | I '$D(^SOWK(655,DFN)) S ^SOWK(655,DFN,0)=DFN,^SOWK(655,"B",DFN,DFN)="",^SOWK(655,0)=$P(^SOWK(655,0),"^",1,2)_"^"_DFN_"^"_($P(^SOWK(655,0),"^",4)+1),$P(^SOWK(655,DFN,0),"^",5)="HR" S (B,C,T,K)=0 K IC,S Q
|
---|
27 | E S $P(^SOWK(655,DFN,0),"^",5)="HR" S (B,C,T,K)=0 K S,IC Q
|
---|
28 | IC W !,"UNEARNED INCOME (Current):",!?5,"DISABILITY PAYMENT",?37,$J(DP,5,0),?45,"MILITARY RETIREMENT",?75,$J(MP,5,0)
|
---|
29 | W !?5,"A&A AMOUNT",?37,$J(AA,5,0),?45,"UNEMPLOYMENT COMPENSATION",?75,$J(VAINC(12),5,0),!?5,"HB AMOUNT",?37,$J(HB,5,0),?45,"OTHER RETIREMENT",?75,$J(OI,5,0)
|
---|
30 | W !?5,"VA PENSION",?37,$J(PE,5,0),?45,"TOTAL INCOME FROM EMPLOYMENT",?75,$J(VAINC(14),5,0),!,"INCOME SCREENING ("_$$FDTTM(VAINC(1))_"):",?45,"INTEREST,DIVIDEND,ANNUITY",?75,$J(VAINC(15),5,0)
|
---|
31 | W !,?5,"SOCIAL SECURITY (Includes SSI)",?37,$J(SI+SC,5,0),?45,"WORKERS COMP OR BLACK LUNG",?75,$J(VAINC(16),5,0),!,?5,"U.S. CIVIL SERVICE",?37,$J(VAINC(9),5,0),?45,"*ALL OTHER INCOME",?75,$J(VAINC(17),5,0)
|
---|
32 | W !,?5,"U.S. RAILROAD RETIREMENT",?37,$J(VAINC(10),5,0),?75 F N=1:1:5 W "-"
|
---|
33 | W !,"TOTAL INCOME:",?73,"$",?75,$J(INC,5,0),!,"*-This total may include amounts already listed under current 'UNEARNED INCOME'."
|
---|
34 | Q
|
---|
35 | FDTTM(Y) ;return formatted date
|
---|
36 | D DD^%DT
|
---|
37 | Q $S(Y[1700:"",1:Y)
|
---|