ACHSDSTR ;IHS/OIT/FCJ-DOCUMENT STATUS REPORT BY FY; [ 09/06/2000 2:56 PM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**26**;JUN 11, 2001;Build 43
;3.1*26 IHS/OIT/FCJ NEW RTN
;
;ACHSRTYP VAR IS SET IN THE MENU OPTION AND WILL PREVENT A THE FILE PROMPT AND DIFFERENT FIELDS
;
A ;
W !!,$$C^XBFUNC("*** DOCUMENT STATUS REPORT ***",80)
W !!,$$C^XBFUNC("for "_$P(^DIC(4,DUZ(2),0),"^"),80)
S ACHSIO=IO
D ^ACHSVAR,LINES^ACHSFU,BM^ACHS
A2 ;
W !!,"Enter the BEGINNING ISSUE DATE for this report: " D READ^ACHSFU Q:$D(DUOUT)!$D(DFOUT)!$D(DTOUT)!$D(DLOUT) S:$D(DQOUT) Y="?" S X=Y,%DT="XEP" D ^%DT G A2:Y<1 S BDATE=Y I Y>DT W !!,*7,"Do not use future dates." G A2
A3 ;
W !!,"Enter the ENDING ISSUE DATE for this report: " D READ^ACHSFU Q:$D(DFOUT)!$D(DTOUT)!$D(DLOUT) G A2:$D(DUOUT) S:$D(DQOUT) Y="?" S X=Y,%DT="XEP" D ^%DT G A3:Y<1 S EDATE=Y I Y>DT W !!,*7,"Do not use future dates." G A3
G B:BDATE'>EDATE W !!,*7,"INVALID ENTRY - The END is before the BEGINNING." G A2
B ;
W !!,"Which type of report?",!!," 1. OPEN DOCUMENTS only",!," 2. CLOSED DOCUMENTS only",!," 3. COMBINED list",!!," ENTER OPTION (1-3) 3//" D READ^ACHSFU I $D(DLOUT)!(Y="") S Y=3
G ENDQ:$D(DTOUT)!$D(DFOUT),QUES:$D(DQOUT),A:$D(DUOUT) I "123"[Y&(Y>0)&(Y<4) S TYPE=Y G C
W !!,*7," Enter only a 1, 2, or 3" G B
QUES ;
W !!,"Choice 1 - only open documents will be listed.",!,"Choice 2 - only documents which have been paid or cancelled will be listed.",!,"Choice 3 - open and closed documents will be listed together." G B
C ;
W !!,"TYPE OF DATA ON REPORT: ",!!," 1. TOTALS ONLY",!," 2. DETAILED DOCUMENTS & TOTALS",!!," ENTER 1 or 2: 1//" D READ^ACHSFU I $D(DLOUT)!(Y="") S Y=1
G ENDQ:$D(DTOUT)!$D(DFOUT),B:$D(DUOUT) I "12"[Y&(Y>0)&(Y<3) S TOTONLY=Y
I (TOTONLY'=1)&(TOTONLY'=2) W *7," ??" H 2 G C
D ;
W !!,"Enter Fiscal Year (e.g. 2016): " D READ^ACHSFU
G ENDQ:$D(DTOUT)!$D(DFOUT),C:$D(DUOUT)!$D(DLOUT)
I Y'?4N W *7," ??" H 2 G D
I '$D(^ACHS(9,DUZ(2),"FY",Y)) U 0 W !!,*7,"NO DATA ON FILE FOR FY!!" H 2 G D
S TOTFYN=$E(Y,4) S TOTFY=$E(Y,3,4)
FILE ;CREATE A FILE
I ACHSRTYP=2 S ACHSFIL=0 G DEVICE
S %=$$DIR^XBDIR("Y","Create a file","N","","","^D HELP^ACHS(""H2"",""ACHSVUR2"")",2)
G D:$D(DUOUT),ENDQ:$D(DTOUT)
S ACHSFIL=%
DEVICE ;
W ! K IOP,%ZIS("B") S %ZIS="PQ" D ^%ZIS K %ZIS I IO="" W !,*7,"No device specified." S IOP=$I D ^%ZIS Q
I $D(IO("Q"))#2,$E(IOST)'="P" W *7,!,"Please queue to printers only." K IO("Q") G DEVICE
I $D(IO("Q")) K IO("Q") S ZTRTN="^ACHSDSTR1",ZTDESC="CHS Document Status, Type "_TYPE_", "_$E(BDATE,2,7)_" to "_$E(EDATE,2,7) F G="DUZ(2)","BDATE","EDATE","TYPE","TOTFY","TOTFYN","TOTONLY" S ZTSAVE(G)=""
I D ^%ZTLOAD G ENDQ
I IO=$I G ^ACHSDSTR1
S IOP=IO D ^%ZIS I 'POP G ^ACHSDSTR1
W !,*7,"Device ",IO," busy." G DEVICE
ENDQ ;
K ACHSIO,BDATE,DTOUT,DQOUT,DLOUT,DUOUT,DFOUT,EDATE,X,Y
Q
ACHSDSTR ;IHS/OIT/FCJ-DOCUMENT STATUS REPORT BY FY; [ 09/06/2000 2:56 PM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**26**;JUN 11, 2001;Build 43
+2 ;3.1*26 IHS/OIT/FCJ NEW RTN
+3 ;
+4 ;ACHSRTYP VAR IS SET IN THE MENU OPTION AND WILL PREVENT A THE FILE PROMPT AND DIFFERENT FIELDS
+5 ;
A ;
+1 WRITE !!,$$C^XBFUNC("*** DOCUMENT STATUS REPORT ***",80)
+2 WRITE !!,$$C^XBFUNC("for "_$PIECE(^DIC(4,DUZ(2),0),"^"),80)
+3 SET ACHSIO=IO
+4 DO ^ACHSVAR
DO LINES^ACHSFU
DO BM^ACHS
A2 ;
+1 WRITE !!,"Enter the BEGINNING ISSUE DATE for this report: "
DO READ^ACHSFU
IF $DATA(DUOUT)!$DATA(DFOUT)!$DATA(DTOUT)!$DATA(DLOUT)
QUIT
IF $DATA(DQOUT)
SET Y="?"
SET X=Y
SET %DT="XEP"
DO ^%DT
IF Y<1
GOTO A2
SET BDATE=Y
IF Y>DT
WRITE !!,*7,"Do not use future dates."
GOTO A2
A3 ;
+1 WRITE !!,"Enter the ENDING ISSUE DATE for this report: "
DO READ^ACHSFU
IF $DATA(DFOUT)!$DATA(DTOUT)!$DATA(DLOUT)
QUIT
IF $DATA(DUOUT)
GOTO A2
IF $DATA(DQOUT)
SET Y="?"
SET X=Y
SET %DT="XEP"
DO ^%DT
IF Y<1
GOTO A3
SET EDATE=Y
IF Y>DT
WRITE !!,*7,"Do not use future dates."
GOTO A3
+2 IF BDATE'>EDATE
GOTO B
WRITE !!,*7,"INVALID ENTRY - The END is before the BEGINNING."
GOTO A2
B ;
+1 WRITE !!,"Which type of report?",!!," 1. OPEN DOCUMENTS only",!," 2. CLOSED DOCUMENTS only",!," 3. COMBINED list",!!," ENTER OPTION (1-3) 3//"
DO READ^ACHSFU
IF $DATA(DLOUT)!(Y="")
SET Y=3
+2 IF $DATA(DTOUT)!$DATA(DFOUT)
GOTO ENDQ
IF $DATA(DQOUT)
GOTO QUES
IF $DATA(DUOUT)
GOTO A
IF "123"[Y&(Y>0)&(Y<4)
SET TYPE=Y
GOTO C
+3 WRITE !!,*7," Enter only a 1, 2, or 3"
GOTO B
QUES ;
+1 WRITE !!,"Choice 1 - only open documents will be listed.",!,"Choice 2 - only documents which have been paid or cancelled will be listed.",!,"Choice 3 - open and closed documents will be listed together."
GOTO B
C ;
+1 WRITE !!,"TYPE OF DATA ON REPORT: ",!!," 1. TOTALS ONLY",!," 2. DETAILED DOCUMENTS & TOTALS",!!," ENTER 1 or 2: 1//"
DO READ^ACHSFU
IF $DATA(DLOUT)!(Y="")
SET Y=1
+2 IF $DATA(DTOUT)!$DATA(DFOUT)
GOTO ENDQ
IF $DATA(DUOUT)
GOTO B
IF "12"[Y&(Y>0)&(Y<3)
SET TOTONLY=Y
+3 IF (TOTONLY'=1)&(TOTONLY'=2)
WRITE *7," ??"
HANG 2
GOTO C
D ;
+1 WRITE !!,"Enter Fiscal Year (e.g. 2016): "
DO READ^ACHSFU
+2 IF $DATA(DTOUT)!$DATA(DFOUT)
GOTO ENDQ
IF $DATA(DUOUT)!$DATA(DLOUT)
GOTO C
+3 IF Y'?4N
WRITE *7," ??"
HANG 2
GOTO D
+4 IF '$DATA(^ACHS(9,DUZ(2),"FY",Y))
USE 0
WRITE !!,*7,"NO DATA ON FILE FOR FY!!"
HANG 2
GOTO D
+5 SET TOTFYN=$EXTRACT(Y,4)
SET TOTFY=$EXTRACT(Y,3,4)
FILE ;CREATE A FILE
+1 IF ACHSRTYP=2
SET ACHSFIL=0
GOTO DEVICE
+2 SET %=$$DIR^XBDIR("Y","Create a file","N","","","^D HELP^ACHS(""H2"",""ACHSVUR2"")",2)
+3 IF $DATA(DUOUT)
GOTO D
IF $DATA(DTOUT)
GOTO ENDQ
+4 SET ACHSFIL=%
DEVICE ;
+1 WRITE !
KILL IOP,%ZIS("B")
SET %ZIS="PQ"
DO ^%ZIS
KILL %ZIS
IF IO=""
WRITE !,*7,"No device specified."
SET IOP=$IO
DO ^%ZIS
QUIT
+2 IF $DATA(IO("Q"))#2
IF $EXTRACT(IOST)'="P"
WRITE *7,!,"Please queue to printers only."
KILL IO("Q")
GOTO DEVICE
+3 IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTRTN="^ACHSDSTR1"
SET ZTDESC="CHS Document Status, Type "_TYPE_", "_$EXTRACT(BDATE,2,7)_" to "_$EXTRACT(EDATE,2,7)
FOR G="DUZ(2)","BDATE","EDATE","TYPE","TOTFY","TOTFYN","TOTONLY"
SET ZTSAVE(G)=""
+4 IF $TEST
DO ^%ZTLOAD
GOTO ENDQ
+5 IF IO=$IO
GOTO ^ACHSDSTR1
+6 SET IOP=IO
DO ^%ZIS
IF 'POP
GOTO ^ACHSDSTR1
+7 WRITE !,*7,"Device ",IO," busy."
GOTO DEVICE
ENDQ ;
+1 KILL ACHSIO,BDATE,DTOUT,DQOUT,DLOUT,DUOUT,DFOUT,EDATE,X,Y
+2 QUIT
