ABPAUPCK ;PRINT UNPROCESSED CHECKS REPORT; [ 03/23/91 12:21 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,J,ABPA,R,RR,%IS,ABPAPG,AMT,CHKNO,CNT,DATA,DIR
K FLDS,INSNAME,INSPTR,K,NEWINS,RAMT,RDT,RRR,TAMT,TRAMT,ZTDESC,ZTDTH
K ZTIO,ZTRTN,IO("Q"),MTH,MT1,MT2,MT3,RT1,RT2,RT3
Q
;--------------------------------------------------------------------
HEAD ;PROCEDURE TO DRAW SCREEN HEADING
K ABPA("HD") S ABPA("HD",1)=ABPATLE
S ABPA("HD",2)="Print UNPROCESSED CHECKS REPORT" D ^ABPAHD W !!
Q
;--------------------------------------------------------------------
SUBHD ;PROCEDURE TO PRINT REPORT SUBHEADINGS
W !?60,"ORIGINAL",?70,"REMAINING"
W !,"PAYOR",?32,"RECEIVED",?48,"CHECK NO.",?62,"AMOUNT",?72,"BALANCE"
W !,"------------------------------",?32,"--------"
W ?42,"---------------",?59,"---------",?70,"---------",!
Q
;--------------------------------------------------------------------
DEVICE ;PROCEDURE TO SELECT PRINTER DEVICE
F J=0:0 K %IS,IOP D Q:$D(ABPA("IO"))=1!(POP)
.S %IS="NPQ",%IS("A")="Select DEVICE or [Q]ueue: "
.D ^%ZIS Q:POP I $E(IOST,1)'="P" D Q
..W *7,?5,"<<< NOT A PRINTER DEVICE >>>"
.S ABPA("IO")=+IO_";80;60"
Q
;--------------------------------------------------------------------
ZTLOAD ;PROCEDURE TO LOAD THE BACKGROUND TASK MANAGER
S ZTRTN="SETUP^ABPAUPCK",ZTIO=ABPA("IO")
S ZTDESC="UNPROCESSED CHECKS REPORT",ZTDTH=$H
S ZTSAVE("ABPATLE")="",ZTSAVE("XQO")="",ZTSAVE("ABPA(""IO"")")=""
D ^%ZTLOAD I $D(ZTSK)=1 W !!,"REQUEST QUEUED!! Task number: ",ZTSK
D PAUSE^ABPAMAIN
Q
;--------------------------------------------------------------------
SETUP ;PROCEDURE TO SETUP FILEMAN PRINT REQUEST
K ABPA("HD") S ABPA("HD",1)=ABPATLE,ABPA("HD",2)=$P(XQO,"^",2)
S ABPAPG=0 D ^ABPARPTH,SUBHD K ^TMP("ABPAUPCK")
S R=0 F J=0:0 D Q:+R=0
.S R=$O(^ABPACHKS("RB",1,R)) Q:+R=0
.S INSPTR=^ABPACHKS(1,"I",R,0),INSNAME=$P(^AUTNINS(INSPTR,0),"^")
.S RR=0 F K=0:0 D Q:+RR=0
..S RR=$O(^ABPACHKS("RB",1,R,RR)) Q:+RR=0
..S DATA=^ABPACHKS(1,"I",R,"C",RR,0)
..S RDT=$P($P(DATA,"^",2),".")
..S RDT=$E(RDT,4,5)_"/"_$E(RDT,6,7)_"/"_$E(RDT,2,3)
..S CHKNO=$P(DATA,"^",1)
..S AMT=$P(DATA,"^",4),RAMT=$P(DATA,"^",9)
..S ^TMP("ABPAUPCK",RDT,INSNAME,CHKNO)=AMT_"^"_RAMT
S (R,CNT,TAMT,TRAMT,MTH,MT1,MT2,MT3)=0 F J=0:0 D Q:R=""
.S R=$O(^TMP("ABPAUPCK",R)) Q:R="" I $E(R,1,2)'=MTH&(MTH'=0) D
..W !?42,"---------------",?59,"---------",?70,"---------"
..W !?23,"Monthly Sub-total"
..W ?42,$J(MT1,15),?59,$J(MT2,9,2),?70,$J(MT3,9,2)
..S (MT1,MT2,MT3)=0 I $Y>(IOSL-4) D ^ABPARPTH,SUBHD
.W ! S (RR,RT1,RT2,RT3)=0,MTH=$E(R,1,2) F K=0:0 D Q:RR=""
..S RR=$O(^TMP("ABPAUPCK",R,RR)) I RR="" D Q
...W !?42,"---------------",?59,"---------",?70,"---------"
...W !?25,"Daily Sub-total"
...W ?42,$J(RT1,15),?59,$J(RT2,9,2),?70,$J(RT3,9,2)
...I $Y>(IOSL-4) D ^ABPARPTH,SUBHD
..W !,RR S NEWINS=1,RRR=0 F L=0:0 D Q:RRR=""
...S RRR=$O(^TMP("ABPAUPCK",R,RR,RRR)) Q:RRR=""
...S DATA=^(RRR),AMT=+DATA,RAMT=$P(DATA,"^",2)
...S TAMT=TAMT+AMT,TRAMT=TRAMT+RAMT,CNT=CNT+1,RT1=RT1+1
...S RT2=RT2+AMT,RT3=RT3+RAMT,MT1=MT1+1,MT2=MT2+AMT,MT3=MT3+RAMT
...I 'NEWINS W !
...W ?32,R,?42,$J(RRR,15),?59,$J(AMT,9,2),?70,$J(RAMT,9,2)
...S NEWINS=0 I $Y>(IOSL-4) D ^ABPARPTH,SUBHD
W !?42,"---------------",?59,"---------",?70,"---------"
W !?23,"Monthly Sub-total"
W ?42,$J(MT1,15),?59,$J(MT2,9,2),?70,$J(MT3,9,2)
W !?42,"---------------",?59,"---------",?70,"---------",!?35,"Total"
W ?42,$J(CNT,15),?59,$J(TAMT,9,2),?70,$J(TRAMT,9,2)
D ^%AUCLS X ^%ZIS("C")
Q
;--------------------------------------------------------------------
MAIN ;ENTRY POINT - OVERALL ROUTINE DRIVER
D CLEAR,HEAD,DEVICE I $D(ABPA("IO"))'=1 D Q
.D CLEAR S IOP=$I D ^%ZIS K IOP
I $D(IO("Q"))=1 D ZTLOAD,CLEAR S IOP=$I D ^%ZIS K IOP Q
W !! D WAIT^DICD S IOP=ABPA("IO") D ^%ZIS K IOP U IO D SETUP
D CLEAR S IOP=$I D ^%ZIS K IOP U IO(0)
Q
;--------------------------------------------------------------------
AUTO ;PROCEDURE TO AUTO PRINT THIS REPORT - CALLED BY TASKMAN
S IOP=+IO_";80;60",ABPA("IO")=IOP D ^%ZIS K IOP
S ABPATLE="AO PRIVATE INSURANCE SYSTEM "
S ABPAVER=$O(^DIC(9.4,"C","ABPA",""))
I ABPAVER]"",$D(^DIC(9.4,ABPAVER,"VERSION")) D
.S ABPAVER="V."_^DIC(9.4,ABPAVER,"VERSION")
S ABPATLE=ABPATLE_ABPAVER,DUZ(2)=+^AUTTSITE(1,0)
S XQO="^UNPROCESSED CHECKS REPORT" D SETUP
Q
ABPAUPCK ;PRINT UNPROCESSED CHECKS REPORT; [ 03/23/91 12:21 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,J,ABPA,R,RR,%IS,ABPAPG,AMT,CHKNO,CNT,DATA,DIR
+2 KILL FLDS,INSNAME,INSPTR,K,NEWINS,RAMT,RDT,RRR,TAMT,TRAMT,ZTDESC,ZTDTH
+3 KILL ZTIO,ZTRTN,IO("Q"),MTH,MT1,MT2,MT3,RT1,RT2,RT3
+4 QUIT
+5 ;--------------------------------------------------------------------
HEAD ;PROCEDURE TO DRAW SCREEN HEADING
+1 KILL ABPA("HD")
SET ABPA("HD",1)=ABPATLE
+2 SET ABPA("HD",2)="Print UNPROCESSED CHECKS REPORT"
DO ^ABPAHD
WRITE !!
+3 QUIT
+4 ;--------------------------------------------------------------------
SUBHD ;PROCEDURE TO PRINT REPORT SUBHEADINGS
+1 WRITE !?60,"ORIGINAL",?70,"REMAINING"
+2 WRITE !,"PAYOR",?32,"RECEIVED",?48,"CHECK NO.",?62,"AMOUNT",?72,"BALANCE"
+3 WRITE !,"------------------------------",?32,"--------"
+4 WRITE ?42,"---------------",?59,"---------",?70,"---------",!
+5 QUIT
+6 ;--------------------------------------------------------------------
DEVICE ;PROCEDURE TO SELECT PRINTER DEVICE
+1 FOR J=0:0
KILL %IS,IOP
Begin DoDot:1
+2 SET %IS="NPQ"
SET %IS("A")="Select DEVICE or [Q]ueue: "
+3 DO ^%ZIS
IF POP
QUIT
IF $EXTRACT(IOST,1)'="P"
Begin DoDot:2
+4 WRITE *7,?5,"<<< NOT A PRINTER DEVICE >>>"
End DoDot:2
QUIT
+5 SET ABPA("IO")=+IO_";80;60"
End DoDot:1
IF $DATA(ABPA("IO"))=1!(POP)
QUIT
+6 QUIT
+7 ;--------------------------------------------------------------------
ZTLOAD ;PROCEDURE TO LOAD THE BACKGROUND TASK MANAGER
+1 SET ZTRTN="SETUP^ABPAUPCK"
SET ZTIO=ABPA("IO")
+2 SET ZTDESC="UNPROCESSED CHECKS REPORT"
SET ZTDTH=$HOROLOG
+3 SET ZTSAVE("ABPATLE")=""
SET ZTSAVE("XQO")=""
SET ZTSAVE("ABPA(""IO"")")=""
+4 DO ^%ZTLOAD
IF $DATA(ZTSK)=1
WRITE !!,"REQUEST QUEUED!! Task number: ",ZTSK
+5 DO PAUSE^ABPAMAIN
+6 QUIT
+7 ;--------------------------------------------------------------------
SETUP ;PROCEDURE TO SETUP FILEMAN PRINT REQUEST
+1 KILL ABPA("HD")
SET ABPA("HD",1)=ABPATLE
SET ABPA("HD",2)=$PIECE(XQO,"^",2)
+2 SET ABPAPG=0
DO ^ABPARPTH
DO SUBHD
KILL ^TMP("ABPAUPCK")
+3 SET R=0
FOR J=0:0
Begin DoDot:1
+4 SET R=$ORDER(^ABPACHKS("RB",1,R))
IF +R=0
QUIT
+5 SET INSPTR=^ABPACHKS(1,"I",R,0)
SET INSNAME=$PIECE(^AUTNINS(INSPTR,0),"^")
+6 SET RR=0
FOR K=0:0
Begin DoDot:2
+7 SET RR=$ORDER(^ABPACHKS("RB",1,R,RR))
IF +RR=0
QUIT
+8 SET DATA=^ABPACHKS(1,"I",R,"C",RR,0)
+9 SET RDT=$PIECE($PIECE(DATA,"^",2),".")
+10 SET RDT=$EXTRACT(RDT,4,5)_"/"_$EXTRACT(RDT,6,7)_"/"_$EXTRACT(RDT,2,3)
+11 SET CHKNO=$PIECE(DATA,"^",1)
+12 SET AMT=$PIECE(DATA,"^",4)
SET RAMT=$PIECE(DATA,"^",9)
+13 SET ^TMP("ABPAUPCK",RDT,INSNAME,CHKNO)=AMT_"^"_RAMT
End DoDot:2
IF +RR=0
QUIT
End DoDot:1
IF +R=0
QUIT
+14 SET (R,CNT,TAMT,TRAMT,MTH,MT1,MT2,MT3)=0
FOR J=0:0
Begin DoDot:1
+15 SET R=$ORDER(^TMP("ABPAUPCK",R))
IF R=""
QUIT
IF $EXTRACT(R,1,2)'=MTH&(MTH'=0)
Begin DoDot:2
+16 WRITE !?42,"---------------",?59,"---------",?70,"---------"
+17 WRITE !?23,"Monthly Sub-total"
+18 WRITE ?42,$JUSTIFY(MT1,15),?59,$JUSTIFY(MT2,9,2),?70,$JUSTIFY(MT3,9,2)
+19 SET (MT1,MT2,MT3)=0
IF $Y>(IOSL-4)
DO ^ABPARPTH
DO SUBHD
End DoDot:2
+20 WRITE !
SET (RR,RT1,RT2,RT3)=0
SET MTH=$EXTRACT(R,1,2)
FOR K=0:0
Begin DoDot:2
+21 SET RR=$ORDER(^TMP("ABPAUPCK",R,RR))
IF RR=""
Begin DoDot:3
+22 WRITE !?42,"---------------",?59,"---------",?70,"---------"
+23 WRITE !?25,"Daily Sub-total"
+24 WRITE ?42,$JUSTIFY(RT1,15),?59,$JUSTIFY(RT2,9,2),?70,$JUSTIFY(RT3,9,2)
+25 IF $Y>(IOSL-4)
DO ^ABPARPTH
DO SUBHD
End DoDot:3
QUIT
+26 WRITE !,RR
SET NEWINS=1
SET RRR=0
FOR L=0:0
Begin DoDot:3
+27 SET RRR=$ORDER(^TMP("ABPAUPCK",R,RR,RRR))
IF RRR=""
QUIT
+28 SET DATA=^(RRR)
SET AMT=+DATA
SET RAMT=$PIECE(DATA,"^",2)
+29 SET TAMT=TAMT+AMT
SET TRAMT=TRAMT+RAMT
SET CNT=CNT+1
SET RT1=RT1+1
+30 SET RT2=RT2+AMT
SET RT3=RT3+RAMT
SET MT1=MT1+1
SET MT2=MT2+AMT
SET MT3=MT3+RAMT
+31 IF 'NEWINS
WRITE !
+32 WRITE ?32,R,?42,$JUSTIFY(RRR,15),?59,$JUSTIFY(AMT,9,2),?70,$JUSTIFY(RAMT,9,2)
+33 SET NEWINS=0
IF $Y>(IOSL-4)
DO ^ABPARPTH
DO SUBHD
End DoDot:3
IF RRR=""
QUIT
End DoDot:2
IF RR=""
QUIT
End DoDot:1
IF R=""
QUIT
+34 WRITE !?42,"---------------",?59,"---------",?70,"---------"
+35 WRITE !?23,"Monthly Sub-total"
+36 WRITE ?42,$JUSTIFY(MT1,15),?59,$JUSTIFY(MT2,9,2),?70,$JUSTIFY(MT3,9,2)
+37 WRITE !?42,"---------------",?59,"---------",?70,"---------",!?35,"Total"
+38 WRITE ?42,$JUSTIFY(CNT,15),?59,$JUSTIFY(TAMT,9,2),?70,$JUSTIFY(TRAMT,9,2)
+39 DO ^%AUCLS
XECUTE ^%ZIS("C")
+40 QUIT
+41 ;--------------------------------------------------------------------
MAIN ;ENTRY POINT - OVERALL ROUTINE DRIVER
+1 DO CLEAR
DO HEAD
DO DEVICE
IF $DATA(ABPA("IO"))'=1
Begin DoDot:1
+2 DO CLEAR
SET IOP=$IO
DO ^%ZIS
KILL IOP
End DoDot:1
QUIT
+3 IF $DATA(IO("Q"))=1
DO ZTLOAD
DO CLEAR
SET IOP=$IO
DO ^%ZIS
KILL IOP
QUIT
+4 WRITE !!
DO WAIT^DICD
SET IOP=ABPA("IO")
DO ^%ZIS
KILL IOP
USE IO
DO SETUP
+5 DO CLEAR
SET IOP=$IO
DO ^%ZIS
KILL IOP
USE IO(0)
+6 QUIT
+7 ;--------------------------------------------------------------------
AUTO ;PROCEDURE TO AUTO PRINT THIS REPORT - CALLED BY TASKMAN
+1 SET IOP=+IO_";80;60"
SET ABPA("IO")=IOP
DO ^%ZIS
KILL IOP
+2 SET ABPATLE="AO PRIVATE INSURANCE SYSTEM "
+3 SET ABPAVER=$ORDER(^DIC(9.4,"C","ABPA",""))
+4 IF ABPAVER]""
IF $DATA(^DIC(9.4,ABPAVER,"VERSION"))
Begin DoDot:1
+5 SET ABPAVER="V."_^DIC(9.4,ABPAVER,"VERSION")
End DoDot:1
+6 SET ABPATLE=ABPATLE_ABPAVER
SET DUZ(2)=+^AUTTSITE(1,0)
+7 SET XQO="^UNPROCESSED CHECKS REPORT"
DO SETUP
+8 QUIT
