ABPAPCLG.m

ABPAPCLG ;PRINT DAILY CHECK LOG; [ 07/10/91  1:31 PM ]

 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991

 W !!,"<<< NOT AN ACCESS POINT - JOB ABORTED >>>",!! Q

 ;--------------------------------------------------------------------

CLEAR ;PROCEDURE TO KILL TEMPORARY LOCAL VARIABLES

 K L,DIC,BY,FROM,TO,X,Y,DHD,%DT,ABPADT,ABPAPG,ABPA("IO"),FINAL,DIR,DA2

 K ZTSK,ZTRTN,ZTDESC,ZTSAVE,ABPA("INS")

 K ABPA("CNUM"),ABPA("CAMT"),ABPA("SUM"),ABPA("CNT")

 Q

 ;--------------------------------------------------------------------

HEAD ;PROCEDURE TO DRAW SCREEN HEADING

 S ABPAHD1="Print DAILY CHECK TRANSMITTAL" D HEADER^ABPAMAIN

 Q

 ;--------------------------------------------------------------------

ACCT ;PROCEDURE TO GET ACCOUNTING POINT

 K DIC S DIC="^ABPACHKS(",DIC(0)="AEQZ",NOACCT=0

 S DIC("A")="Select ACCOUNTING POINT: " W !! D ^DIC I +Y<1 S NOACCT=1

 E  S ACCTPT=$P(Y(0,0),"^"),DA2=+Y

 Q

 ;--------------------------------------------------------------------

DATE ;PROCEDURE TO GET LOG DATE TO USE

 K ABPADT S %DT="AEPX",%DT("A")="Select LOG DATE: "

 S Y=DT D DD^%DT S %DT("B")=Y W ! D ^%DT Q:+Y'>0  S ABPADT=+Y

 I $D(^ABPACHKS("TR",ABPADT,"N",DA2))'=10 D  G DATE

 .W *7,!?5,"<<< NO UNREPORTED CHECKS FOUND FOR THIS DATE >>>"

 Q

 ;--------------------------------------------------------------------

TYPE ;PROCEDURE TO GET TYPE OF RUN

 K DIR S DIR(0)="SB^D:DRAFT;F:FINAL",DIR("A")="TYPE OF RUN",FINAL=0

 S DIR("?",1)="Select either DRAFT or FINAL mode.  DRAFT mode will"

 S DIR("?",2)="allow you to further edit any check entries on the log."

 S DIR("?",3)="Once you print a FINAL copy, you will not be allowed to"

 S DIR("?")="change any of the information on this log."

 S DIR("B")="DRAFT" W ! D ^DIR I Y="F" S FINAL=1

 I FINAL D

 .K DIR S DIR(0)="Y",DIR("B")="NO"

 .S DIR("A")="** FINAL COPY ***  ARE YOU SURE"

 .W !,*7 D ^DIR I Y=0 S FINAL=0

 K DIR Q

 ;--------------------------------------------------------------------

DEVICE ;PROCEDURE TO SELECT PRINTER DEVICE

 K %IS,%ZIS S %IS="PQ",%ZIS("A")="Select DEVICE or [Q]ueue: "

 D ^%ZIS Q:POP  I $D(IO("Q"))=1&($D(IO("S"))=1) D  G DEVICE

 .W ?5,*7,"<<< QUEUING TO A SLAVE PRINTER NOT ALLOWED >>>"

 I $E(IOST)'="P" D  G DEVICE

 .W ?5,*7,"<<< MUST BE A PRINTER TYPE DEVICE >>>"

 I $D(IO("Q")) D  Q

 .S ZTRTN="PRINT^ABPAPCLG",ZTDESC="Print DAILY CHECK TRANSMITTAL"

 .S ZTIO=IO,ZTSAVE("ABPA(")="",ZTSAVE("ACCTPT")="",ZTSAVE("ABPADT")=""

 .S ZTSAVE("FINAL")="",ZTSAVE("DA2")="" D ^%ZTLOAD

 .I $D(ZTSK) D QUEUED^ABPAMAIN

 U IO(0) W ! D WAIT^DICD U IO

 ;--------------------------------------------------------------------

PRINT ;ENTRY POINT - CALLED BY TASKMAN

 ;PROCEDURE TO PRINT THE CURRENT CHECK RECORDS

 K ^TMP("ABPAPCLG",$J,DA2) S ABPA("DTIN")=ABPADT D DTCVT^ABPAMAIN

 S ABPA("SUM")=0,DA(1)=0 F  D  Q:+DA(1)=0

 .S DA(1)=$O(^ABPACHKS("TR",ABPADT,"N",DA2,DA(1))) Q:+DA(1)=0

 .S ABPA("INS")="UNKNOWN" I $D(^ABPACHKS(DA2,"I",DA(1),0))=1 D

 ..S IPTR=^ABPACHKS(DA2,"I",DA(1),0)

 .I $D(^AUTNINS(IPTR,0))=1 S ABPA("INS")=$P(^(0),"^")

 .S DA=0 F  D  Q:+DA=0

 ..S DA=$O(^ABPACHKS("TR",ABPADT,"N",DA2,DA(1),DA)) Q:+DA=0

 ..S ABPADATA=^ABPACHKS(DA2,"I",DA(1),"C",DA,0)

 ..S ABPA("CNUM")=$P(ABPADATA,"^"),ABPA("CAMT")=$P(ABPADATA,"^",4)

 ..S ABPA("SUM")=ABPA("SUM")+ABPA("CAMT")

 ..S ^TMP("ABPAPCLG",$J,DA2,ABPA("INS"),ABPA("CNUM"))=ABPA("CAMT")

 S ABPAPG=0 D ^ABPACLHD

 S ABPA("CNT")=0,ABPA("INS")=0 F  D  Q:ABPA("INS")=""

 .S ABPA("INS")=$O(^TMP("ABPAPCLG",$J,DA2,ABPA("INS")))

 .Q:ABPA("INS")=""  S ABPA("CNUM")=0 F  D  Q:ABPA("CNUM")=""

 ..S ABPA("CNUM")=$O(^TMP("ABPAPCLG",$J,DA2,ABPA("INS"),ABPA("CNUM")))

 ..Q:ABPA("CNUM")=""  S ABPA("CNT")=ABPA("CNT")+1

 ..S ABPA("CAMT")=^TMP("ABPAPCLG",$J,DA2,ABPA("INS"),ABPA("CNUM"))

 ..W !?5,$J(ABPA("DTOUT"),8),?($X+3),ABPA("CNUM"),?33,ABPA("INS"),?65

 ..W $J(ABPA("CAMT"),9,2) I $Y>54 D ^ABPACLHD

 W !?16,"---------------",?65,"---------",!,"TOTAL",?65

 W $J(ABPA("SUM"),9,2),!,"COUNT",?16,ABPA("CNT") D END^ABPACLHD

 U IO(0) X ^%ZIS("C") K ^TMP("ABPAPCLG",$J,DA2)

 Q

 ;--------------------------------------------------------------------

MAIN ;ENTRY POINT - ROUTINE DRIVER

 D CLEAR,HEAD,ACCT I NOACCT D CLEAR Q

 D DATE I $D(ABPADT)'=1 G MAIN

 D TYPE I FINAL I $D(^TMP("ABPACLG1"))=10 D

 .W !!,"Please note: A 'Check Log Corrections Memo' will also be "

 .W "printed  ",!!

 W ! D DEVICE,CLEAR S IOP=$I D ^%ZIS K IOP

 Q

ABPAPCLG  ;PRINT DAILY CHECK LOG; [ 07/10/91  1:31 PM ]

 +1       ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991

 +2        WRITE !!,"<<< NOT AN ACCESS POINT - JOB ABORTED >>>",!!

           QUIT 

 +3       ;--------------------------------------------------------------------

CLEAR     ;PROCEDURE TO KILL TEMPORARY LOCAL VARIABLES

 +1        KILL L,DIC,BY,FROM,TO,X,Y,DHD,%DT,ABPADT,ABPAPG,ABPA("IO"),FINAL,DIR,DA2

 +2        KILL ZTSK,ZTRTN,ZTDESC,ZTSAVE,ABPA("INS")

 +3        KILL ABPA("CNUM"),ABPA("CAMT"),ABPA("SUM"),ABPA("CNT")

 +4        QUIT 

 +5       ;--------------------------------------------------------------------

HEAD      ;PROCEDURE TO DRAW SCREEN HEADING

 +1        SET ABPAHD1="Print DAILY CHECK TRANSMITTAL"

           DO HEADER^ABPAMAIN

 +2        QUIT 

 +3       ;--------------------------------------------------------------------

ACCT      ;PROCEDURE TO GET ACCOUNTING POINT

 +1        KILL DIC

           SET DIC="^ABPACHKS("

           SET DIC(0)="AEQZ"

           SET NOACCT=0

 +2        SET DIC("A")="Select ACCOUNTING POINT: "

           WRITE !!

           DO ^DIC

           IF +Y<1

               SET NOACCT=1

 +3       IF '$TEST

               SET ACCTPT=$PIECE(Y(0,0),"^")

               SET DA2=+Y

 +4        QUIT 

 +5       ;--------------------------------------------------------------------

DATE      ;PROCEDURE TO GET LOG DATE TO USE

 +1        KILL ABPADT

           SET %DT="AEPX"

           SET %DT("A")="Select LOG DATE: "

 +2        SET Y=DT

           DO DD^%DT

           SET %DT("B")=Y

           WRITE !

           DO ^%DT

           IF +Y'>0

               QUIT 

           SET ABPADT=+Y

 +3        IF $DATA(^ABPACHKS("TR",ABPADT,"N",DA2))'=10

               Begin DoDot:1

 +4                WRITE *7,!?5,"<<< NO UNREPORTED CHECKS FOUND FOR THIS DATE >>>"

               End DoDot:1

               GOTO DATE

 +5        QUIT 

 +6       ;--------------------------------------------------------------------

TYPE      ;PROCEDURE TO GET TYPE OF RUN

 +1        KILL DIR

           SET DIR(0)="SB^D:DRAFT;F:FINAL"

           SET DIR("A")="TYPE OF RUN"

           SET FINAL=0

 +2        SET DIR("?",1)="Select either DRAFT or FINAL mode.  DRAFT mode will"

 +3        SET DIR("?",2)="allow you to further edit any check entries on the log."

 +4        SET DIR("?",3)="Once you print a FINAL copy, you will not be allowed to"

 +5        SET DIR("?")="change any of the information on this log."

 +6        SET DIR("B")="DRAFT"

           WRITE !

           DO ^DIR

           IF Y="F"

               SET FINAL=1

 +7        IF FINAL

               Begin DoDot:1

 +8                KILL DIR

                   SET DIR(0)="Y"

                   SET DIR("B")="NO"

 +9                SET DIR("A")="** FINAL COPY ***  ARE YOU SURE"

 +10               WRITE !,*7

                   DO ^DIR

                   IF Y=0

                       SET FINAL=0

               End DoDot:1

 +11       KILL DIR

           QUIT 

 +12      ;--------------------------------------------------------------------

DEVICE    ;PROCEDURE TO SELECT PRINTER DEVICE

 +1        KILL %IS,%ZIS

           SET %IS="PQ"

           SET %ZIS("A")="Select DEVICE or [Q]ueue: "

 +2        DO ^%ZIS

           IF POP

               QUIT 

           IF $DATA(IO("Q"))=1&($DATA(IO("S"))=1)

               Begin DoDot:1

 +3                WRITE ?5,*7,"<<< QUEUING TO A SLAVE PRINTER NOT ALLOWED >>>"

               End DoDot:1

               GOTO DEVICE

 +4        IF $EXTRACT(IOST)'="P"

               Begin DoDot:1

 +5                WRITE ?5,*7,"<<< MUST BE A PRINTER TYPE DEVICE >>>"

               End DoDot:1

               GOTO DEVICE

 +6        IF $DATA(IO("Q"))

               Begin DoDot:1

 +7                SET ZTRTN="PRINT^ABPAPCLG"

                   SET ZTDESC="Print DAILY CHECK TRANSMITTAL"

 +8                SET ZTIO=IO

                   SET ZTSAVE("ABPA(")=""

                   SET ZTSAVE("ACCTPT")=""

                   SET ZTSAVE("ABPADT")=""

 +9                SET ZTSAVE("FINAL")=""

                   SET ZTSAVE("DA2")=""

                   DO ^%ZTLOAD

 +10               IF $DATA(ZTSK)

                       DO QUEUED^ABPAMAIN

               End DoDot:1

               QUIT 

 +11       USE IO(0)

           WRITE !

           DO WAIT^DICD

           USE IO

 +12      ;--------------------------------------------------------------------

PRINT     ;ENTRY POINT - CALLED BY TASKMAN

 +1       ;PROCEDURE TO PRINT THE CURRENT CHECK RECORDS

 +2        KILL ^TMP("ABPAPCLG",$JOB,DA2)

           SET ABPA("DTIN")=ABPADT

           DO DTCVT^ABPAMAIN

 +3        SET ABPA("SUM")=0

           SET DA(1)=0

           FOR 

               Begin DoDot:1

 +4                SET DA(1)=$ORDER(^ABPACHKS("TR",ABPADT,"N",DA2,DA(1)))

                   IF +DA(1)=0

                       QUIT 

 +5                SET ABPA("INS")="UNKNOWN"

                   IF $DATA(^ABPACHKS(DA2,"I",DA(1),0))=1

                       Begin DoDot:2

 +6                        SET IPTR=^ABPACHKS(DA2,"I",DA(1),0)

                       End DoDot:2

 +7                IF $DATA(^AUTNINS(IPTR,0))=1

                       SET ABPA("INS")=$PIECE(^(0),"^")

 +8                SET DA=0

                   FOR 

                       Begin DoDot:2

 +9                        SET DA=$ORDER(^ABPACHKS("TR",ABPADT,"N",DA2,DA(1),DA))

                           IF +DA=0

                               QUIT 

 +10                       SET ABPADATA=^ABPACHKS(DA2,"I",DA(1),"C",DA,0)

 +11                       SET ABPA("CNUM")=$PIECE(ABPADATA,"^")

                           SET ABPA("CAMT")=$PIECE(ABPADATA,"^",4)

 +12                       SET ABPA("SUM")=ABPA("SUM")+ABPA("CAMT")

 +13                       SET ^TMP("ABPAPCLG",$JOB,DA2,ABPA("INS"),ABPA("CNUM"))=ABPA("CAMT")

                       End DoDot:2

                       IF +DA=0

                           QUIT 

               End DoDot:1

               IF +DA(1)=0

                   QUIT 

 +14       SET ABPAPG=0

           DO ^ABPACLHD

 +15       SET ABPA("CNT")=0

           SET ABPA("INS")=0

           FOR 

               Begin DoDot:1

 +16               SET ABPA("INS")=$ORDER(^TMP("ABPAPCLG",$JOB,DA2,ABPA("INS")))

 +17               IF ABPA("INS")=""

                       QUIT 

                   SET ABPA("CNUM")=0

                   FOR 

                       Begin DoDot:2

 +18                       SET ABPA("CNUM")=$ORDER(^TMP("ABPAPCLG",$JOB,DA2,ABPA("INS"),ABPA("CNUM")))

 +19                       IF ABPA("CNUM")=""

                               QUIT 

                           SET ABPA("CNT")=ABPA("CNT")+1

 +20                       SET ABPA("CAMT")=^TMP("ABPAPCLG",$JOB,DA2,ABPA("INS"),ABPA("CNUM"))

 +21                       WRITE !?5,$JUSTIFY(ABPA("DTOUT"),8),?($X+3),ABPA("CNUM"),?33,ABPA("INS"),?65

 +22                       WRITE $JUSTIFY(ABPA("CAMT"),9,2)

                           IF $Y>54

                               DO ^ABPACLHD

                       End DoDot:2

                       IF ABPA("CNUM")=""

                           QUIT 

               End DoDot:1

               IF ABPA("INS")=""

                   QUIT 

 +23       WRITE !?16,"---------------",?65,"---------",!,"TOTAL",?65

 +24       WRITE $JUSTIFY(ABPA("SUM"),9,2),!,"COUNT",?16,ABPA("CNT")

           DO END^ABPACLHD

 +25       USE IO(0)

           XECUTE ^%ZIS("C")

           KILL ^TMP("ABPAPCLG",$JOB,DA2)

 +26       QUIT 

 +27      ;--------------------------------------------------------------------

MAIN      ;ENTRY POINT - ROUTINE DRIVER

 +1        DO CLEAR

           DO HEAD

           DO ACCT

           IF NOACCT

               DO CLEAR

               QUIT 

 +2        DO DATE

           IF $DATA(ABPADT)'=1

               GOTO MAIN

 +3        DO TYPE

           IF FINAL

               IF $DATA(^TMP("ABPACLG1"))=10

                   Begin DoDot:1

 +4                    WRITE !!,"Please note: A 'Check Log Corrections Memo' will also be "

 +5                    WRITE "printed  ",!!

                   End DoDot:1

 +6        WRITE !

           DO DEVICE

           DO CLEAR

           SET IOP=$IO

           DO ^%ZIS

           KILL IOP

 +7        QUIT