17 lines
1.0 KiB
Mathematica
17 lines
1.0 KiB
Mathematica
SOWKPAD ;B'HAM ISC/SAB-Routine to print addresses of RCHs ; 06 Mar 97 / 10:15 AM
|
|
;;3.0; Social Work ;**48**;27 Apr 93
|
|
AK W !,"BE SURE LABELS ARE IN PRINTER PROPERLY"
|
|
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
|
|
G:%=2!(%=-1) CLOS
|
|
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
|
|
K SOWKION I $D(IO("Q")) S ZTDESC="RESIDENTIAL CARE HOME ADDRESS LIST",ZTRTN="ENQ^SOWKPAD"
|
|
I K IO("Q") D ^%ZTLOAD W:$D(ZTSK) !,"LABELS WILL PRINT LATER",! K G,ZTSK G CLOS
|
|
ENQ F I=0:0 S I=$O(^SOWK(652,I)) Q:'I S RCH=^SOWK(652,I,0) D AD
|
|
CLOS W:$E(IOST)'["C" @IOF D ^%ZISC
|
|
K G,Q,%Y,%,I,N,SWA,SWC,SWN,SWS,SWSS,SWZ,SWZA,IOP,POP,RCH D:$D(ZTSK) KILL^%ZTLOAD
|
|
Q Q
|
|
AD 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
|
|
PRINT ;PRINT MODULE
|
|
U IO W SWN,!,SWA W:$P(RCH,"^",14)]"" !,$P(RCH,"^",14) W !,SWC_", ",SWSS,!,?10,SWZ,!!!!! W:$P(RCH,"^",14)="" !
|
|
Q
|