source: WorldVistAEHR/trunk/r/SOCIAL_WORK-SOW-SWBH-SWFG/SOWKCS.m@ 1800

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

initial load of WorldVistAEHR

File size: 1.4 KB
Line 
1SOWKCS ;B'HAM ISC/SAB-Routine to inquire into RCH file by worker ; 04 Feb 93 / 2:36 PM
2 ;;3.0; Social Work ;;27 Apr 93
3SEA W ! S DIC("S")="I $D(^VA(200,+Y,654)),$P(^VA(200,+Y,654),""^"")",DIC("A")="SELECT WORKER: ",DIC="^VA(200,",DIC(0)="AQEM" D ^DIC G:"^"[X CLO G SEA:Y<0 S DA=+Y K DIC
4 K %ZIS,IOP,ZTSK S SOWKION=ION,%ZIS="QM" D ^%ZIS K %ZIS I POP S IOP=SOWKION D ^%ZIS K IOP,SOWKION G CLO
5 K SOWKION I $D(IO("Q")) S ZTDESC="RCH INQUIRY REPORT",ZTRTN="ENQ^SOWKCS" F G="COM","DA" S:$D(@G) ZTSAVE(G)=""
6 I K IO("Q") D ^%ZTLOAD W:$D(ZTSK) !!,"Task Queued to Print",! K ZTSK,DA,G G CLO Q
7ENQ U IO W:$Y @IOF W "HOME REGISTRY FOR A SINGLE WORKER: ",$S($G(COM):"COMPLETE",1:"SUMMARY"),!,"SOCIAL WORKER: "_$P(^VA(200,DA,0),"^"),!! G LOK
8CLO W ! W:$E(IOST)'["C" @IOF D ^%ZISC K COM,SWNB,DA,DIC,A,I,IOP,POP,%ZIS,STA,SWD,SWN,SWSN,X,Y D:$D(ZTSK) KILL^%ZTLOAD Q
9 Q
10PRI U IO W !,"HOME: ",?25,SWN,!,"LAST ASSESSMENT DATE: ",?25,SWD,!,"NUMBER OF BEDS: ",?25,SWNB,!,"ADDRESS 1: ",?25,$P(A,"^",5)
11 W !,"ADDRESS 2: ",?25,$P(A,"^",14),!,"CITY: ",?25,$P(A,"^",6),!,"STATE: ",?25,STA,!,"ZIP: ",?25,$P(A,"^",8),!,"TELEPHONE 1: ",?25,$P(A,"^",9),!,"TELEPHONE 2: ",?25,$P(A,"^",15) Q:'$G(COM)
12 W !,"LICENSED BY STATE ?: ",?25,$P(A,"^",10),!,"VETS ONLY ?: ",?25,$P(A,"^",12),!
13 Q
14LOK F I=0:0 S I=$O(^SOWK(652,I)) Q:'I S A=^SOWK(652,I,0) I $P(A,"^",4)=DA S SWN=$P(A,"^"),SWSN=$P(A,"^",3),SWNB=$P(A,"^",11),Y=$P(A,"^",13) X ^DD("DD") S SWD=Y,STA=$P(A,"^",7),STA=$P(^DIC(5,STA,0),"^") D PRI
15 G CLO Q
Note: See TracBrowser for help on using the repository browser.