ACHSDSTR.m

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