source: WorldVistAEHR/trunk/r/SOCIAL_WORK-SOW-SWBH-SWFG/SOWKBH.m@ 770

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

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1SOWKBH ;B'HAM ISC/SAB-Print routine for Community Resource Module ; 22 Jan 93 / 9:58 AM [ 07/18/94 1:02 PM ]
2 ;;3.0; Social Work ;**33,60,61**;27 Apr 93
3ASK W !!,"Do you want",!?5,"Single level sort (S)" R !?5,"Multiple level sort (M): S// ",SW:DTIME S:SW="" SW="S" G:"^"[SW!('$T) CLO
4 I "SM"'[$E(SW) W !!,"'S' for single level sort",!,"'M' for multiple level sort" G ASK
5 W $S("S"[$E(SW):" SINGLE LEVEL SORT",1:" MULTIPLE LEVEL SORT"),@IOF G @$S("S"[$E(SW):"SORT1",1:"SORT2")
6DEV K %ZIS,IOP,ZTSK S SOWKION=ION,%ZIS="QM" D ^%ZIS K %ZIS I POP S IOP=SOWKION D ^%ZIS K POP,IOP,SOWKION,SWP,DA,DIC,DIE,DR,FF,I,SW,SWE,X,Y G CLO Q
7 K SOWKION I $D(IO("Q")) S ZTDESC="COMMUNITY RESOURCE MODULE REPORT",ZTRTN="SWDE^SOWKBH",G="DA" S:$D(@G) ZTSAVE(G)="" D ^%ZTLOAD K SWP,G,DA,DIC,DIE,DR,FF,I,IOP,SW,SWDE,SWE,X,Y,ZTSK G CLO Q
8SWDE D PRI
9CLO I $E(IOST)["C" R !,"PRESS RETURN TO CONTINUE or '^' TO EXIT: ",SWXX:DTIME
10 W:$E(IOST)'["C" @IOF D ^%ZISC K BY,D,D0,FLDS,Z0,SWP,DA,DIC,DIE,DR,FF,I,SW,SWDE,SWE,SWXX,X,Y D:$D(ZTSK) KILL^%ZTLOAD
11 Q
12PRI U IO W:$Y @IOF W !,"AGENCY:",?30,$P(^SOWK(656,DA,0),"^"),!,"STREET ADDRESS 1:",?30,$P($G(^(0)),"^",2),!,"STREET ADDRESS 2:",?30,$P($G(^SOWK(656,DA,4)),"^",3),!,"CITY:",?30,$P($G(^SOWK(656,DA,0)),"^",3),!
13 W "STATE:",?30,$S($P($G(^SOWK(656,DA,4)),"^",2)="":"",1:$P($G(^DIC(5,$P(^SOWK(656,DA,4),"^",2),0)),"^")),!,"COUNTY:",?30,$P($G(^SOWK(656,DA,4)),"^"),!,"ZIP:",?30,$P($G(^SOWK(656,DA,0)),"^",5),!
14 W "PHONE NUMBER:",?30,$P($G(^SOWK(656,DA,0)),"^",6),!,"PHONE NUMBER #2:",?30,$P($G(^SOWK(656,DA,1)),"^",4),!,"FAX NUMBER:",?30,$P($G(^SOWK(656,DA,0)),"^",8),!,"HOURS:",?30,$P($G(^(0)),"^",7)
15 W !,"SERVICE:",?30,$P($G(^SOWK(656,DA,1)),"^"),!,"ELIGIBILITY:",?30,$P($G(^(1)),"^",2),!,"FEES:",?30,$P($G(^(1)),"^",3),!
16 W "REFERRAL:",?30,$P($G(^SOWK(656,DA,2)),"^"),!,"COMMENTS:",?30,$E($P($G(^SOWK(656,DA,2)),"^",2),1,48),!?30,$E($P($G(^SOWK(656,DA,2)),"^",2),49,70)
17 W !,"DATE OF INFO:",?30 S Y=$P($G(^(2)),"^",3) X ^DD("DD") W Y,!,"VA LIAISON:",?30,$P($G(^SOWK(656,DA,2)),"^",4),!,"SPECIAL POPULATION:",?30,$P($G(^(2)),"^",6)
18 W !,"TYPE:" F I=0:0 S I=$O(^SOWK(656,DA,3,I)) Q:'I W ?30,$P($G(^SOWK(656,DA,3,I,0)),"^")_", "
19 Q
20LOK ;SOW*3*60 (Dave B)
21 W !,"AD will stand for ADDICTION",!,"DA will stand for DAY CARE",!,"EM will stand for EMPLOYMENT",!,"FI will stand for FINANCES",!,"FO will stand for FOOD",!,"HE will stand for HEALTH"
22 W !,"HO will stand for HOUSING",!,"IH will stand for IN HOME SERVICES",!,"IN will stand for INFORMATION/REFERRALS",!,"LE will stand for LEGAL",!,"MH will stand for MENTAL HEALTH"
23 W !,"SH will stand for SELF HELP",!,"SP will stand for SP ED/RECREATION",!,"TR will stand for TRANSPORTATION",!,"VO will stand for VOLUNTEER"
24 W ! Q
25EN1 ;ENTRY POINT TO GET A VALID COUNTY FOR A SELECTED STATE/013086
26 S Z0=$S($D(^SOWK(656,D0,4)):+$P(^(4),"^",2),1:0) S DIC="^DIC(5,Z0,1,",DIC(0)="QEM" D ^DIC
27 Q
28SORT1 W !!,?25,"SINGLE LEVEL SORT",!!,"Select By: ",!,?5,"County",!,?5,"Agency",!,?5,"City",!,?5,"Zip",!,?5,"Type " R !,"Enter two or more characters: ",SW:DTIME G:"^"[SW!('$T) CLO S SW=$E(SW,1,2)
29SEA W @IOF,!! S DR=".01:99",(DIC,DIE)="^SOWK(656,",DIC(0)="AEQ",DIC("A")=$S(SW="CO":"COUNTY: ",SW="TY":"TYPE: ",SW="CI":"CITY: ",SW="ZI":"ZIP: ",SW="AG":"AGENCY: ",1:"1") D:SW="TY" LOK I DIC("A") D HLP G SORT1
30 ;
31 ;SOW*3*60 (Dave B, removed $T check on next line 12/12/99)
32TY S D=$S(SW="CO":"M",SW="TY":"C",SW="CI":"E",SW="ZI":"D",1:"B") D IX^DIC G:"^"[X CLO G:Y'>0 TY S DA=+Y K DIC G DEV
33 Q
34SORT2 W !!,?25,"MULTIPLE SORT"
35 S ZTDESC="COMMUNITY RESOURCE MODULE PRINT OPTION",BY="@",FLDS="[SOWKBHP]",DIC="^SOWK(656," D EN1^DIP G CLO
36 Q
37HLP W !,"Enter",!!?5,"CO for COUNTY",!!?5,"AG for AGENCY",!!?5,"CI for CITY",!!?5,"ZI for ZIP",!!?5,"TY for TYPE" Q
Note: See TracBrowser for help on using the repository browser.