- 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
