source: WorldVistAEHR/trunk/r/SOCIAL_WORK-SOW-SWBH-SWFG/SOWKHR1.m@ 846

Last change on this file since 846 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.2 KB
RevLine 
[613]1SOWKHR1 ;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),!!
12AD 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
28IC 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
35FDTTM(Y) ;return formatted date
36 D DD^%DT
37 Q $S(Y[1700:"",1:Y)
Note: See TracBrowser for help on using the repository browser.