1 | DGA400 ;ALB/MRL - AMIS 401-420 GENERATION OF FILE ;01 JAN 1988@2300
|
---|
2 | ;;5.3;Registration;**50**;Aug 13, 1993
|
---|
3 | S (DGDEV,IOP)="HOME" D ^%ZIS K IOP S:'$D(U) U="^" S:'$D(DTIME) DTIME=300 I '$D(DT) S %DT="",X="T" D ^%DT S DT=+Y
|
---|
4 | I $S('$D(DUZ):1,('$D(DUZ)#2):1,'$D(^VA(200,+DUZ,0)):1,1:0) W !!,"I DON'T KNOW WHO YOU ARE...UNABLE TO PROCEED!",*7 Q
|
---|
5 | EN S DGWR=1 D ^DGA4002 G Q:DGE W ! S %DT="EA",%DT("A")="Select AMIS 401-420 MONTH/YEAR: " D ^%DT G Q:Y'>0 K %DT S DGA=$E(Y,1,5)_"00",DGAE=$E(Y,1,5)_"31.2359" X ^DD("DD") S DGA1=Y
|
---|
6 | ;I DGA>2871031 S X=$E(DGA,4,5),X1=$S('(X-1):12,1:X-1),X=2_$S(X'=12:$E(DGA,2,3),1:$E(DGA,2,3)-1)_X1_"00" I '$D(^DG(391,"AR",X,401)) S Y=X X ^DD("DD") W !!,*7,"Report for previous month of '",Y,"' must be run first...",!! G EN
|
---|
7 | S X=$O(^DG(391.1,"AR",DGA,400)) G PAT:X>420!(X<401) W !!,"Totals already on file for '",DGA1,"..."
|
---|
8 | GEN W !,"DO YOU WISH TO REGENERATE (WHICH CAN TAKE A WHILE)" S %=2 D YN^DICN G PAT:%=1,DV:%=2,Q:% W !!?4,"YES - To regenerate the totals for '",DGA1,"'.",!?4,"NO - To QUIT this process immediately.",! G GEN
|
---|
9 | PAT W !!,"Do you want a patient listing included with this report" S %=2 D YN^DICN G Q:%=-1 S:% DGAL=$S(%=2:0,1:%) I '% W !!?4,"YES - To include a listing of all patients counted in these reports.",!?4,"NO - To exclude listing." G PAT
|
---|
10 | CODE D ASK^DGGECSA G Q:%<0 S DGCODFLG=%
|
---|
11 | W ! F I=1:1 S J=$P($T(T+I),";;",2) Q:J="" W !,J
|
---|
12 | W !!,"THIS REPORT IS FORMATTED TO RUN WITH A RIGHT MARGIN OF 132!",*7,! S DGA1=DGA,DGAE1=DGAE,(DGQUIT,DGHOME)=0,DGVAR="DGCODFLG^DGDEV^DGAL^DGA1^DGHOME^DUZ^DGQUIT^DGAE1",DGPGM="^DGA4001" D ZIS^DGUTQ I POP G Q
|
---|
13 | ;U IO
|
---|
14 | S DGHOME=1 G ^DGA4001
|
---|
15 | DV S DGPR="A" G QUE:'$P(^DG(43,1,"GL"),"^",2)
|
---|
16 | W !!,"PRINT REPORT FOR ALL DIVISIONS" S %=1 D YN^DICN G QUE:%=1,DV1:%=2,Q:% W !!?4,"YES - To print report for ALL divisions.",!?4,"NO - To select a specific division you wish to print." G DV
|
---|
17 | DV1 S DIC="^DG(40.8,",DIC(0)="AEMQZ" D ^DIC Q:Y'>0 S DGPR=+Y
|
---|
18 | QUE W !!,"THIS PRINTOUT IS FORMATTED TO OUTPUT WITH A 132-COLUMN RIGHT MARGIN!",*7 S DGAL=0,DGVAR="DGA^DGPR^DGAL^DUZ",DGPGM=$S(DGPR="A":"REP1",1:"REP")_"^DGA4005" D ZIS^DGUTQ G Q:POP
|
---|
19 | ;U IO
|
---|
20 | G @DGPGM
|
---|
21 | UP S $P(^DG(43,1,"AMIS"),"^",3)=1,$P(^("AMIS"),"^",4)=+DUZ,$P(^("AMIS"),"^",5)=1 Q
|
---|
22 | Q G QUIT1^DGA4002
|
---|
23 | T ;
|
---|
24 | ;;In the process of generating this report I will check for "open" or "pending"
|
---|
25 | ;;dispositions which may be remaining on file for this timeframe. If any "open"
|
---|
26 | ;;dispositions are found you will be advised via a mailman message and the data
|
---|
27 | ;;necessary for the report will not be generated. A separate option is available
|
---|
28 | ;;to list these "open" and "pending" dispositions. "Pending" dispositions should
|
---|
29 | ;;be changed to another status as soon as possible but this status does not impact
|
---|
30 | ;;the generation of the AMIS 401-420 reports.
|
---|