DGA400 ;ALB/MRL - AMIS 401-420 GENERATION OF FILE ;01 JAN 1988@2300
;;5.3;Registration;**50**;Aug 13, 1993
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
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
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
;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
S X=$O(^DG(391.1,"AR",DGA,400)) G PAT:X>420!(X<401) W !!,"Totals already on file for '",DGA1,"..."
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
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
CODE D ASK^DGGECSA G Q:%<0 S DGCODFLG=%
W ! F I=1:1 S J=$P($T(T+I),";;",2) Q:J="" W !,J
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
;U IO
S DGHOME=1 G ^DGA4001
DV S DGPR="A" G QUE:'$P(^DG(43,1,"GL"),"^",2)
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
DV1 S DIC="^DG(40.8,",DIC(0)="AEMQZ" D ^DIC Q:Y'>0 S DGPR=+Y
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
;U IO
G @DGPGM
UP S $P(^DG(43,1,"AMIS"),"^",3)=1,$P(^("AMIS"),"^",4)=+DUZ,$P(^("AMIS"),"^",5)=1 Q
Q G QUIT1^DGA4002
T ;
;;In the process of generating this report I will check for "open" or "pending"
;;dispositions which may be remaining on file for this timeframe. If any "open"
;;dispositions are found you will be advised via a mailman message and the data
;;necessary for the report will not be generated. A separate option is available
;;to list these "open" and "pending" dispositions. "Pending" dispositions should
;;be changed to another status as soon as possible but this status does not impact
;;the generation of the AMIS 401-420 reports.
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGA400 2797 printed Apr 09, 2024@21:38:58 Page 2
DGA400 ;ALB/MRL - AMIS 401-420 GENERATION OF FILE ;01 JAN 1988@2300
+1 ;;5.3;Registration;**50**;Aug 13, 1993
+2 SET (DGDEV,IOP)="HOME"
DO ^%ZIS
KILL IOP
if '$DATA(U)
SET U="^"
if '$DATA(DTIME)
SET DTIME=300
IF '$DATA(DT)
SET %DT=""
SET X="T"
DO ^%DT
SET DT=+Y
+3 IF $SELECT('$DATA(DUZ):1,('$DATA(DUZ)#2):1,'$DATA(^VA(200,+DUZ,0)):1,1:0)
WRITE !!,"I DON'T KNOW WHO YOU ARE...UNABLE TO PROCEED!",*7
QUIT
EN SET DGWR=1
DO ^DGA4002
if DGE
GOTO Q
WRITE !
SET %DT="EA"
SET %DT("A")="Select AMIS 401-420 MONTH/YEAR: "
DO ^%DT
if Y'>0
GOTO Q
KILL %DT
SET DGA=$EXTRACT(Y,1,5)_"00"
SET DGAE=$EXTRACT(Y,1,5)_"31.2359"
XECUTE ^DD("DD")
SET DGA1=Y
+1 ;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
+2 SET X=$ORDER(^DG(391.1,"AR",DGA,400))
if X>420!(X<401)
GOTO PAT
WRITE !!,"Totals already on file for '",DGA1,"..."
GEN WRITE !,"DO YOU WISH TO REGENERATE (WHICH CAN TAKE A WHILE)"
SET %=2
DO YN^DICN
if %=1
GOTO PAT
if %=2
GOTO DV
if %
GOTO Q
WRITE !!?4,"YES - To regenerate the totals for '",DGA1,"'.",!?4,"NO - To QUIT this process immediately.",!
GOTO GEN
PAT WRITE !!,"Do you want a patient listing included with this report"
SET %=2
DO YN^DICN
if %=-1
GOTO Q
if %
SET DGAL=$SELECT(%=2:0,1:%)
IF '%
WRITE !!?4,"YES - To include a listing of all patients counted in these reports.",!?4,"NO - To exclude listing."
GOTO PAT
CODE DO ASK^DGGECSA
if %<0
GOTO Q
SET DGCODFLG=%
+1 WRITE !
FOR I=1:1
SET J=$PIECE($TEXT(T+I),";;",2)
if J=""
QUIT
WRITE !,J
+2 WRITE !!,"THIS REPORT IS FORMATTED TO RUN WITH A RIGHT MARGIN OF 132!",*7,!
SET DGA1=DGA
SET DGAE1=DGAE
SET (DGQUIT,DGHOME)=0
SET DGVAR="DGCODFLG^DGDEV^DGAL^DGA1^DGHOME^DUZ^DGQUIT^DGAE1"
SET DGPGM="^DGA4001"
DO ZIS^DGUTQ
IF POP
GOTO Q
+3 ;U IO
+4 SET DGHOME=1
GOTO ^DGA4001
DV SET DGPR="A"
if '$PIECE(^DG(43,1,"GL"),"^",2)
GOTO QUE
+1 WRITE !!,"PRINT REPORT FOR ALL DIVISIONS"
SET %=1
DO YN^DICN
if %=1
GOTO QUE
if %=2
GOTO DV1
if %
GOTO Q
WRITE !!?4,"YES - To print report for ALL divisions.",!?4,"NO - To select a specific division you wish to print."
GOTO DV
DV1 SET DIC="^DG(40.8,"
SET DIC(0)="AEMQZ"
DO ^DIC
if Y'>0
QUIT
SET DGPR=+Y
QUE WRITE !!,"THIS PRINTOUT IS FORMATTED TO OUTPUT WITH A 132-COLUMN RIGHT MARGIN!",*7
SET DGAL=0
SET DGVAR="DGA^DGPR^DGAL^DUZ"
SET DGPGM=$SELECT(DGPR="A":"REP1",1:"REP")_"^DGA4005"
DO ZIS^DGUTQ
if POP
GOTO Q
+1 ;U IO
+2 GOTO @DGPGM
UP SET $PIECE(^DG(43,1,"AMIS"),"^",3)=1
SET $PIECE(^("AMIS"),"^",4)=+DUZ
SET $PIECE(^("AMIS"),"^",5)=1
QUIT
Q GOTO QUIT1^DGA4002
T ;
+1 ;;In the process of generating this report I will check for "open" or "pending"
+2 ;;dispositions which may be remaining on file for this timeframe. If any "open"
+3 ;;dispositions are found you will be advised via a mailman message and the data
+4 ;;necessary for the report will not be generated. A separate option is available
+5 ;;to list these "open" and "pending" dispositions. "Pending" dispositions should
+6 ;;be changed to another status as soon as possible but this status does not impact
+7 ;;the generation of the AMIS 401-420 reports.
