source: WorldVistAEHR/trunk/r/SOCIAL_WORK-SOW-SWBH-SWFG/SOWKPAD.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.0 KB
Line 
1SOWKPAD ;B'HAM ISC/SAB-Routine to print addresses of RCHs ; 06 Mar 97 / 10:15 AM
2 ;;3.0; Social Work ;**48**;27 Apr 93
3AK W !,"BE SURE LABELS ARE IN PRINTER PROPERLY"
4 F Q=0:0 W !,"WHEN READY PRESS RETURN OR ENTER KEY. ARE YOU READY" S %=1 D YN^DICN Q:% I %Y["?" W @IOF D YN^SOWKHELP W ! G AK
5 G:%=2!(%=-1) CLOS
6 K IO("Q"),IOP,%ZIS,ZTSK S SOWKION=ION,%ZIS="QM",%ZIS("B")="" D ^%ZIS K %ZIS I POP S IOP=SOWKION D ^%ZIS K IOP,SOWKION G CLOS
7 K SOWKION I $D(IO("Q")) S ZTDESC="RESIDENTIAL CARE HOME ADDRESS LIST",ZTRTN="ENQ^SOWKPAD"
8 I K IO("Q") D ^%ZTLOAD W:$D(ZTSK) !,"LABELS WILL PRINT LATER",! K G,ZTSK G CLOS
9ENQ F I=0:0 S I=$O(^SOWK(652,I)) Q:'I S RCH=^SOWK(652,I,0) D AD
10CLOS W:$E(IOST)'["C" @IOF D ^%ZISC
11 K G,Q,%Y,%,I,N,SWA,SWC,SWN,SWS,SWSS,SWZ,SWZA,IOP,POP,RCH D:$D(ZTSK) KILL^%ZTLOAD
12Q Q
13AD S SWN=$P(RCH,"^"),SWA=$P(RCH,"^",5),SWC=$P(RCH,"^",6),SWS=$P(RCH,"^",7),SWZ=$P(RCH,"^",8),SWSS=$P(^DIC(5,SWS,0),"^") D PRINT Q
14PRINT ;PRINT MODULE
15 U IO W SWN,!,SWA W:$P(RCH,"^",14)]"" !,$P(RCH,"^",14) W !,SWC_", ",SWSS,!,?10,SWZ,!!!!! W:$P(RCH,"^",14)="" !
16 Q
Note: See TracBrowser for help on using the repository browser.