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

28 lines
2.0 KiB
Mathematica

SOWKPAOQ ;B'HAM ISC/SAB-Routine to print all Queued Amis report ; 22 Apr 93 / 12:10 PM [ 09/26/94 2:46 PM ]
;;3.0; Social Work ;**34,53**;27 Apr 93
S SOWKAB="ALL"
BEG W ! S %DT="AEXP",%DT("A")="ALL CASES STARTING FROM: " D ^%DT G:"^"[X CLOS G:Y'>0 BEG S SOWKFD=Y
EN W ! S %DT("A")="ALL CASES ENDING: " D ^%DT G:"^"[X CLOS G:Y'>0 EN S SOWKFB=Y G:$D(SOWK) DEV
F L=0:0 W !,"Do you want Complete Service " S %=2 D YN^DICN Q:% I %Y["?" D YN^SOWKHELP
I %=1 S SWA=1,SWB=0 G DEV
F L=0:0 W !,"Do you want report by Supervisor " S %=2 D YN^DICN Q:% I %Y["?" D YN^SOWKHELP
I %=1 S SWB=1,SWA=0
G:%=2 SWW G:%=-1 CLOS S DIC="^VA(200,",DIC(0)="AEQ",DIC("A")="Enter Supervisor's last name: ",D="B",DIC("S")="I $D(^VA(200,""ASWC"",+Y))"
D IX^DIC G:"^"[X CLOS K DIC S SWZ=+Y G:Y'>0 CLOS G DEV
SWW S DIC("S")="I $D(^VA(200,+Y,654)),$P(^VA(200,+Y,654),""^"")",DIC="^VA(200,",DIC(0)="AEQ",DIC("A")="Enter Social Worker's last name: "
D ^DIC G:"^"[X CLOS K DIC S SWZ=+Y G:Y'>0 CLOS S (SWA,SWB)=0 G DEV
Q
DEV W !!,"WARNING !!!",!?5,"This report is formatted for 132 columns and will be",!?5,"difficult to read if printed to the screen.",!
K ZTSK,OUT,%ZIS,IOP 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 ZTRTN=$S($D(SOWK):"ENQ3^SOWKPAOQ",SWA:"ENQ^SOWKPAOQ",SWB:"ENQ1^SOWKPAOQ",'SWA&'SWB:"ENQ2^SOWKPAOQ",1:"ENQ^SOWKPAOQ") F G="SOWKAB","X","SOWKFD","SWZ","SOWKFB","SWB","SWA","SOWKDIV","SOWK" S:$D(@G) ZTSAVE(G)=""
I K IO("Q") S ZTDESC="PRINT ALL AMIS REPORTS OPTION" D ^%ZTLOAD I '$D(ZTSK) K %DT,G Q
I $D(ZTSK) K %DT,G,ZTSK W !!,"Task Queued to Print",! Q
ENQ I $D(SWA),SWA D ENQ^SOWKPAO,ENQ^SOWKRF,EN2^SOWKLC,ENQ^SOWKDSC G CLOS
ENQ1 I $D(SWB),SWB D ENQ^SOWKPAO,ENQ^SOWKRF,ENQ1^SOWKLC,ENQ^SOWKDSC G CLOS
ENQ2 I $D(SWB),'SWA,'SWB D ENQ^SOWKPAO,ENQ2^SOWKRF,ENQ2^SOWKLC,ENQ^SOWKDSC G CLOS
ENQ3 I $D(SOWK) D ENQ^SOWKPAOD,ENQ^SOWKRFD,ENQ^SOWKLCD,ENQ^SOWKDSC G CLOS
Q
CLOS W:$E(IOST)'["C" @IOF D ^%ZISC K SOWKAB,SWA,SWB,%DT,DIC,G,POP,X,Y,SWZ,SOWKFB,SOWKFD,IOP,%,%Y,D,L,SOWKAB,SWA,SWB D:$D(ZTSK) KILL^%ZTLOAD
Q