VistA-WorldVistAEHR/r/SOCIAL_WORK-SOW-SWBH-SWFG/SOWKPAD.m

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