ABPVCK1 ;3P BILL TRANSMISSION EDIT REPORT;[ 06/03/91 1:49 PM ]
;;2.0;FACILITY PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 1991
W !!,"NOT AN ENTRY POINT!",!! Q
;--------------------------------------------------------------------
A3 ;PROCEDURE TO BUILD SORTED UTILITY GLOBAL INDEX
K ^UTILITY("ABPVCK") S RR=+BRECNO F ABPVI=0:0 D Q:+RR=0
.S RR=$O(^ABPVFAC(RR)) Q:+RR=0
.S ZX=^ABPVFAC(RR,0),PDFN=$P(ZX,"^",2),PNAME=$P(^DPT(PDFN,0),"^")
.S ^UTILITY("ABPVCK",PNAME,$P(ZX,"^",3),RR)=""
.K ZX,PDFN,PNAME
Q
;--------------------------------------------------------------------
A4 ;PROCEDURE TO PRINT SORTED EXPORT TRANSMITTAL LOG
K ^UTILITY("ABPVTXE") D ^ABPVPRT,HEADER^ABPVCK0
S R=0 F ABPVI=0:0 D Q:R=""
.S R=$O(^UTILITY("ABPVCK",R)) Q:R=""
.S RR=0 F ABPVI=0:0 D Q:+RR=0
..S RR=$O(^UTILITY("ABPVCK",R,RR)) Q:+RR=0
..S RRR=0 F ABPVI=0:0 D Q:+RRR=0
...S RRR=$O(^UTILITY("ABPVCK",R,RR,RRR)) Q:+RRR=0
...S ZX=^ABPVFAC(RRR,0)
...S X=$P(ZX,"^",11)
...W ?1,$E(X,4,5),"/",$E(X,6,7),"/",$E(X,2,3)
...W ?11,$J($P(ZX,"^",1),7)
...S PDFN=$P(ZX,"^",2) W ?20,$E($P(^DPT(PDFN,0),"^",1),1,30)
...W ?52,$J($P(ZX,"^",5),6)
...S X=$P(ZX,"^",3)
...W ?61,$E(X,4,5),"/",$E(X,6,7),"/",$E(X,2,3)
...S ZINSCO=$P(ZX,"^",8) D INSCHK^ABPVCK0
...W ?71,$P(^AUTNINS($P(ZX,"^",8),0),"^",1)
...W ?103,$J($P(ZX,"^",9),8,2)
...W ?113,$P(ZX,"^",6)
...W ?117,$J($P(ZX,"^",7),2),!
...S ZCLCT=ZCLCT+1,ZCLAMT=ZCLAMT+$P(ZX,"^",9)
...I $Y>50 D HEADER^ABPVCK0
W ?5 F I=1:1:110 W "-"
W !,?5,"TOTAL CLAIMS = ",ZCLCT,?45,"TOTAL CLAIM AMT = ",?64
W $J(ZCLAMT,8,2),!! H 3
Q
ABPVCK1 ;3P BILL TRANSMISSION EDIT REPORT;[ 06/03/91 1:49 PM ]
+1 ;;2.0;FACILITY PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 1991
+2 WRITE !!,"NOT AN ENTRY POINT!",!!
QUIT
+3 ;--------------------------------------------------------------------
A3 ;PROCEDURE TO BUILD SORTED UTILITY GLOBAL INDEX
+1 KILL ^UTILITY("ABPVCK")
SET RR=+BRECNO
FOR ABPVI=0:0
Begin DoDot:1
+2 SET RR=$ORDER(^ABPVFAC(RR))
IF +RR=0
QUIT
+3 SET ZX=^ABPVFAC(RR,0)
SET PDFN=$PIECE(ZX,"^",2)
SET PNAME=$PIECE(^DPT(PDFN,0),"^")
+4 SET ^UTILITY("ABPVCK",PNAME,$PIECE(ZX,"^",3),RR)=""
+5 KILL ZX,PDFN,PNAME
End DoDot:1
IF +RR=0
QUIT
+6 QUIT
+7 ;--------------------------------------------------------------------
A4 ;PROCEDURE TO PRINT SORTED EXPORT TRANSMITTAL LOG
+1 KILL ^UTILITY("ABPVTXE")
DO ^ABPVPRT
DO HEADER^ABPVCK0
+2 SET R=0
FOR ABPVI=0:0
Begin DoDot:1
+3 SET R=$ORDER(^UTILITY("ABPVCK",R))
IF R=""
QUIT
+4 SET RR=0
FOR ABPVI=0:0
Begin DoDot:2
+5 SET RR=$ORDER(^UTILITY("ABPVCK",R,RR))
IF +RR=0
QUIT
+6 SET RRR=0
FOR ABPVI=0:0
Begin DoDot:3
+7 SET RRR=$ORDER(^UTILITY("ABPVCK",R,RR,RRR))
IF +RRR=0
QUIT
+8 SET ZX=^ABPVFAC(RRR,0)
+9 SET X=$PIECE(ZX,"^",11)
+10 WRITE ?1,$EXTRACT(X,4,5),"/",$EXTRACT(X,6,7),"/",$EXTRACT(X,2,3)
+11 WRITE ?11,$JUSTIFY($PIECE(ZX,"^",1),7)
+12 SET PDFN=$PIECE(ZX,"^",2)
WRITE ?20,$EXTRACT($PIECE(^DPT(PDFN,0),"^",1),1,30)
+13 WRITE ?52,$JUSTIFY($PIECE(ZX,"^",5),6)
+14 SET X=$PIECE(ZX,"^",3)
+15 WRITE ?61,$EXTRACT(X,4,5),"/",$EXTRACT(X,6,7),"/",$EXTRACT(X,2,3)
+16 SET ZINSCO=$PIECE(ZX,"^",8)
DO INSCHK^ABPVCK0
+17 WRITE ?71,$PIECE(^AUTNINS($PIECE(ZX,"^",8),0),"^",1)
+18 WRITE ?103,$JUSTIFY($PIECE(ZX,"^",9),8,2)
+19 WRITE ?113,$PIECE(ZX,"^",6)
+20 WRITE ?117,$JUSTIFY($PIECE(ZX,"^",7),2),!
+21 SET ZCLCT=ZCLCT+1
SET ZCLAMT=ZCLAMT+$PIECE(ZX,"^",9)
+22 IF $Y>50
DO HEADER^ABPVCK0
End DoDot:3
IF +RRR=0
QUIT
End DoDot:2
IF +RR=0
QUIT
End DoDot:1
IF R=""
QUIT
+23 WRITE ?5
FOR I=1:1:110
WRITE "-"
+24 WRITE !,?5,"TOTAL CLAIMS = ",ZCLCT,?45,"TOTAL CLAIM AMT = ",?64
+25 WRITE $JUSTIFY(ZCLAMT,8,2),!!
HANG 3
+26 QUIT
