- 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
