ABPARPCL ;RE-PRINT DAILY CHECK LOG; [ 08/07/91 9:34 AM ]
;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 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="Re-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,"Y",DA2))'=10 D G DATE
.W *7,!?5,"<<< NO PREVIOUSLY REPORTED CHECKS FOUND FOR THIS DATE >>>"
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^ABPARPCL",ZTDESC="Re-Print DAILY CHECK TRANSMITTAL"
.S ZTIO=IO,ZTSAVE("ABPA(")="",ZTSAVE("ACCTPT")="",ZTSAVE("ABPADT")=""
.S 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,"Y",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,"Y",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
W ! D DEVICE,CLEAR S IOP=$I D ^%ZIS K IOP
Q
ABPARPCL ;RE-PRINT DAILY CHECK LOG; [ 08/07/91 9:34 AM ]
+1 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 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="Re-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,"Y",DA2))'=10
Begin DoDot:1
+4 WRITE *7,!?5,"<<< NO PREVIOUSLY REPORTED CHECKS FOUND FOR THIS DATE >>>"
End DoDot:1
GOTO DATE
+5 QUIT
+6 ;--------------------------------------------------------------------
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^ABPARPCL"
SET ZTDESC="Re-Print DAILY CHECK TRANSMITTAL"
+8 SET ZTIO=IO
SET ZTSAVE("ABPA(")=""
SET ZTSAVE("ACCTPT")=""
SET ZTSAVE("ABPADT")=""
+9 SET ZTSAVE("DA2")=""
DO ^%ZTLOAD
IF $DATA(ZTSK)
DO QUEUED^ABPAMAIN
End DoDot:1
QUIT
+10 USE IO(0)
WRITE !
DO WAIT^DICD
USE IO
+11 ;--------------------------------------------------------------------
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,"Y",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,"Y",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 WRITE !
DO DEVICE
DO CLEAR
SET IOP=$IO
DO ^%ZIS
KILL IOP
+4 QUIT
