ABPVTX0 ;EXPORT FACILITY PVT-INS CLAIM DATA;[ 08/07/91 3:50 PM ]
;;2.0;FACILITY PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 1991
G A0
;--------------------------------------------------------------------
INSCHK ;PROCEDURE TO INSPECT FOR COMPLETE INSURANCE RECORD
S ZINSERR=0,ZNODE=""
NXTNODE S ZNODE=$O(^AUTNINS(ZINSCO,ZNODE)) G:(ZNODE="")!(+ZNODE>1) INSCHKC
S ZY=^AUTNINS(ZINSCO,ZNODE)
I ZNODE=1 I $P(ZY,"^")']"" I $P(ZY,"^",5)']"" G NXTNODE
I $L($P(ZY,"^",2))<2 S ZINSERR=ZINSERR_1 G NXTNODE
I $L($P(ZY,"^",3))<2 S ZINSERR=ZINSERR_1 G NXTNODE
I +$P(ZY,"^",4)<1!('$D(^DIC(5,+$P(ZY,"^",4),0))) D G NXTNODE
.S ZINSERR=ZINSERR_1
I $L($P(ZY,"^",5))<5!($P(ZY,"^",5)'?5N.E) D G NXTNODE
.S ZINSERR=ZINSERR_1
S ZINSERR=ZINSERR_0 G NXTNODE
INSCHKC I ZINSERR="01"!(ZINSERR="010") D
.S ^UTILITY("ABPVTXE","INS-ERR",ZINSCO)=""
I ZINSERR="001"!(ZINSERR="011") D
.S ^UTILITY("ABPVTXE","INS-ERR",ZINSCO)="*"
Q
;--------------------------------------------------------------------
A0 ;PROCEDURE TO DRAW SCREEN HEADING
D ^ABPVVAR W @IOF,! S PGNO=0 F I=1:1:79 W "*"
W !,"*",?17,"PRIVATE INSURANCE BILLING CLAIM EXPORT PROGRAM",?78,"*",!
S X="FOR "_$P(^DIC(4,DUZ(2),0),"^",1) W "*",?80-$L(X)/2,X,?78,"*",!
S Y=DT X ^DD("DD") W "*",?80-$L(Y)/2,Y,?78,"*",! F I=1:1:79 W "*"
;--------------------------------------------------------------------
A0A ;PROCEDURE TO GET THE LAST DATE DATA WAS EXPORTED
S LEXDATE=9999999-($O(^ABPVTXST("AC",DUZ(2),"")))
L (^ABPVFAC,^AUTNINS):1
I '$T D H 4 G JOBEND^ABPVTX1
.W *7,!!,?18,"PRIVATE INSURANCE AUDIT or INSURER File in Use.",!,?22
.W "Cannot Do Export at this time.",!!,?25
.W "THIS JOB HAS BEEN CANCELLED"
W !! D A1 I +IO=0 D PAUSE^ABPVZMM G ZEND^ABPVTX2
G A2
;--------------------------------------------------------------------
A1 ;PROCEDURE TO GET PRINTER OUTPUT DEVICE
S %IS="P",%ZIS("A")="Print Export Report on Device: " D ^%ZIS Q:POP
I $E(IOST)'="P" W ?4,"<<< MUST BE A PRINTER TYPE DEVICE >>>",*7 G A1
Q
;--------------------------------------------------------------------
A2 ;PROCEDURE TO DETERMINE THE BEGINNING RECORD NUMBER FOR THIS RUN
S ABPV("SITE")=DUZ(2),BRECNO=0,R=0,ZCLCT=0,ZCLAMT=0
I '$D(^ABPVTXST(ABPV("SITE"))) G A2A
S X=+$P(^ABPVTXST(ABPV("SITE"),1,0),"^",4) I X<1 G A2A
S BRECNO=+$P(^ABPVTXST(ABPV("SITE"),1,X,0),"^",4)
I BRECNO'<+$P(^ABPVFAC(0),"^",3) D G ZENDA^ABPVTX2
.X ^%ZIS("C") S IOP=$I D ^%ZIS K IOP
.W !,*7,?10,"NO RECORDS AVAILABLE FOR EXPORT -- JOB CANCELLED" H 2
;--------------------------------------------------------------------
A2A ;PROCEDURE TO CONTROL REMAINING TASKS OF THIS ROUTINE
W ! D WAIT^DICD,A3,A4 G S3START^ABPVTX1
;--------------------------------------------------------------------
A3 ;PROCEDURE TO BUILD SORTED UTILITY GLOBAL INDEX
K ^UTILITY("ABPVTX") S Y=DT X ^DD("DD") S ^UTILITY("ABPVTX",0)=Y
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("ABPVTX",PNAME,$P(ZX,"^",3),RR)=""
.K ZX,PDFN,PNAME
Q
;--------------------------------------------------------------------
A4 ;PROCEDURE TO PRINT SORTED EXPORT TRANSMITTAL LOG
K ^UTILITY("ABPVTXE") D ^ABPVPRT,HEADER^ABPVTX1
S R=0 F ABPVI=0:0 D Q:R=""
.S R=$O(^UTILITY("ABPVTX",R)) Q:R=""
.S RR=0 F ABPVI=0:0 D Q:+RR=0
..S RR=$O(^UTILITY("ABPVTX",R,RR)) Q:+RR=0
..S RRR=0 F ABPVI=0:0 D Q:+RRR=0
...S RRR=$O(^UTILITY("ABPVTX",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
...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^ABPVTX1
W ?5 F I=1:1:110 W "-"
W !,?5,"TOTAL CLAIMS = ",ZCLCT,?45,"TOTAL CLAIM AMT = ",?64
W $J(ZCLAMT,8,2),!! D PRESET H 5
Q
;--------------------------------------------------------------------
PRESET ;PROCEDURE TO RESET THE PRINTER TO 10 CPI
I $D(IO),$D(A("PRINT",10)) U IO W @A("PRINT",10)
Q
;--------------------------------------------------------------------
REPRT ;PROCEDURE TO RE-PRINT THE MOST RECENT EXPORT LOG
K ABPV("HD") S ABPV("HD",1)=ABPVTLE
S ABPV("HD",2)="Re-print the MOST RECENT EXPORT LOG" D ^ABPVHD
I $D(^UTILITY("ABPVTX",0))'=1 D Q
. K ABPVMESS S ABPVMESS="PREVIOUS EXPORT NOT FOUND"
. S ABPVMESS(2)="...Press any key to continue..." D PAUSE^ABPVZMM
W ! S ABPVMESS="Re-print the export log for "_^UTILITY("ABPVTX",0)
S ABPVMESS=ABPVMESS_" (Y/N)" K DIR D YN^ABPVZMM K ABPVMESS
I 'Y D PAUSE^ABPVZMM G ZENDA^ABPVTX2
S PGNO=0,ZCLCT=0,ZCLAMT=0
W ! D A1 I +IO=0 D PAUSE^ABPVZMM G ZENDA^ABPVTX2
W ! D WAIT^DICD,A4,PRESET U IO W @IOF X ^%ZIS("C") D PAUSE^ABPVZMM
Q
ABPVTX0 ;EXPORT FACILITY PVT-INS CLAIM DATA;[ 08/07/91 3:50 PM ]
+1 ;;2.0;FACILITY PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 1991
+2 GOTO A0
+3 ;--------------------------------------------------------------------
INSCHK ;PROCEDURE TO INSPECT FOR COMPLETE INSURANCE RECORD
+1 SET ZINSERR=0
SET ZNODE=""
NXTNODE SET ZNODE=$ORDER(^AUTNINS(ZINSCO,ZNODE))
IF (ZNODE="")!(+ZNODE>1)
GOTO INSCHKC
+1 SET ZY=^AUTNINS(ZINSCO,ZNODE)
+2 IF ZNODE=1
IF $PIECE(ZY,"^")']""
IF $PIECE(ZY,"^",5)']""
GOTO NXTNODE
+3 IF $LENGTH($PIECE(ZY,"^",2))<2
SET ZINSERR=ZINSERR_1
GOTO NXTNODE
+4 IF $LENGTH($PIECE(ZY,"^",3))<2
SET ZINSERR=ZINSERR_1
GOTO NXTNODE
+5 IF +$PIECE(ZY,"^",4)<1!('$DATA(^DIC(5,+$PIECE(ZY,"^",4),0)))
Begin DoDot:1
+6 SET ZINSERR=ZINSERR_1
End DoDot:1
GOTO NXTNODE
+7 IF $LENGTH($PIECE(ZY,"^",5))<5!($PIECE(ZY,"^",5)'?5N.E)
Begin DoDot:1
+8 SET ZINSERR=ZINSERR_1
End DoDot:1
GOTO NXTNODE
+9 SET ZINSERR=ZINSERR_0
GOTO NXTNODE
INSCHKC IF ZINSERR="01"!(ZINSERR="010")
Begin DoDot:1
+1 SET ^UTILITY("ABPVTXE","INS-ERR",ZINSCO)=""
End DoDot:1
+2 IF ZINSERR="001"!(ZINSERR="011")
Begin DoDot:1
+3 SET ^UTILITY("ABPVTXE","INS-ERR",ZINSCO)="*"
End DoDot:1
+4 QUIT
+5 ;--------------------------------------------------------------------
A0 ;PROCEDURE TO DRAW SCREEN HEADING
+1 DO ^ABPVVAR
WRITE @IOF,!
SET PGNO=0
FOR I=1:1:79
WRITE "*"
+2 WRITE !,"*",?17,"PRIVATE INSURANCE BILLING CLAIM EXPORT PROGRAM",?78,"*",!
+3 SET X="FOR "_$PIECE(^DIC(4,DUZ(2),0),"^",1)
WRITE "*",?80-$LENGTH(X)/2,X,?78,"*",!
+4 SET Y=DT
XECUTE ^DD("DD")
WRITE "*",?80-$LENGTH(Y)/2,Y,?78,"*",!
FOR I=1:1:79
WRITE "*"
+5 ;--------------------------------------------------------------------
A0A ;PROCEDURE TO GET THE LAST DATE DATA WAS EXPORTED
+1 SET LEXDATE=9999999-($ORDER(^ABPVTXST("AC",DUZ(2),"")))
+2 LOCK (^ABPVFAC,^AUTNINS):1
+3 IF '$TEST
Begin DoDot:1
+4 WRITE *7,!!,?18,"PRIVATE INSURANCE AUDIT or INSURER File in Use.",!,?22
+5 WRITE "Cannot Do Export at this time.",!!,?25
+6 WRITE "THIS JOB HAS BEEN CANCELLED"
End DoDot:1
HANG 4
GOTO JOBEND^ABPVTX1
+7 WRITE !!
DO A1
IF +IO=0
DO PAUSE^ABPVZMM
GOTO ZEND^ABPVTX2
+8 GOTO A2
+9 ;--------------------------------------------------------------------
A1 ;PROCEDURE TO GET PRINTER OUTPUT DEVICE
+1 SET %IS="P"
SET %ZIS("A")="Print Export Report on Device: "
DO ^%ZIS
IF POP
QUIT
+2 IF $EXTRACT(IOST)'="P"
WRITE ?4,"<<< MUST BE A PRINTER TYPE DEVICE >>>",*7
GOTO A1
+3 QUIT
+4 ;--------------------------------------------------------------------
A2 ;PROCEDURE TO DETERMINE THE BEGINNING RECORD NUMBER FOR THIS RUN
+1 SET ABPV("SITE")=DUZ(2)
SET BRECNO=0
SET R=0
SET ZCLCT=0
SET ZCLAMT=0
+2 IF '$DATA(^ABPVTXST(ABPV("SITE")))
GOTO A2A
+3 SET X=+$PIECE(^ABPVTXST(ABPV("SITE"),1,0),"^",4)
IF X<1
GOTO A2A
+4 SET BRECNO=+$PIECE(^ABPVTXST(ABPV("SITE"),1,X,0),"^",4)
+5 IF BRECNO'<+$PIECE(^ABPVFAC(0),"^",3)
Begin DoDot:1
+6 XECUTE ^%ZIS("C")
SET IOP=$IO
DO ^%ZIS
KILL IOP
+7 WRITE !,*7,?10,"NO RECORDS AVAILABLE FOR EXPORT -- JOB CANCELLED"
HANG 2
End DoDot:1
GOTO ZENDA^ABPVTX2
+8 ;--------------------------------------------------------------------
A2A ;PROCEDURE TO CONTROL REMAINING TASKS OF THIS ROUTINE
+1 WRITE !
DO WAIT^DICD
DO A3
DO A4
GOTO S3START^ABPVTX1
+2 ;--------------------------------------------------------------------
A3 ;PROCEDURE TO BUILD SORTED UTILITY GLOBAL INDEX
+1 KILL ^UTILITY("ABPVTX")
SET Y=DT
XECUTE ^DD("DD")
SET ^UTILITY("ABPVTX",0)=Y
+2 SET RR=+BRECNO
FOR ABPVI=0:0
Begin DoDot:1
+3 SET RR=$ORDER(^ABPVFAC(RR))
IF +RR=0
QUIT
+4 SET ZX=^ABPVFAC(RR,0)
SET PDFN=$PIECE(ZX,"^",2)
SET PNAME=$PIECE(^DPT(PDFN,0),"^")
+5 SET ^UTILITY("ABPVTX",PNAME,$PIECE(ZX,"^",3),RR)=""
+6 KILL ZX,PDFN,PNAME
End DoDot:1
IF +RR=0
QUIT
+7 QUIT
+8 ;--------------------------------------------------------------------
A4 ;PROCEDURE TO PRINT SORTED EXPORT TRANSMITTAL LOG
+1 KILL ^UTILITY("ABPVTXE")
DO ^ABPVPRT
DO HEADER^ABPVTX1
+2 SET R=0
FOR ABPVI=0:0
Begin DoDot:1
+3 SET R=$ORDER(^UTILITY("ABPVTX",R))
IF R=""
QUIT
+4 SET RR=0
FOR ABPVI=0:0
Begin DoDot:2
+5 SET RR=$ORDER(^UTILITY("ABPVTX",R,RR))
IF +RR=0
QUIT
+6 SET RRR=0
FOR ABPVI=0:0
Begin DoDot:3
+7 SET RRR=$ORDER(^UTILITY("ABPVTX",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
+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^ABPVTX1
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),!!
DO PRESET
HANG 5
+26 QUIT
+27 ;--------------------------------------------------------------------
PRESET ;PROCEDURE TO RESET THE PRINTER TO 10 CPI
+1 IF $DATA(IO)
IF $DATA(A("PRINT",10))
USE IO
WRITE @A("PRINT",10)
+2 QUIT
+3 ;--------------------------------------------------------------------
REPRT ;PROCEDURE TO RE-PRINT THE MOST RECENT EXPORT LOG
+1 KILL ABPV("HD")
SET ABPV("HD",1)=ABPVTLE
+2 SET ABPV("HD",2)="Re-print the MOST RECENT EXPORT LOG"
DO ^ABPVHD
+3 IF $DATA(^UTILITY("ABPVTX",0))'=1
Begin DoDot:1
+4 KILL ABPVMESS
SET ABPVMESS="PREVIOUS EXPORT NOT FOUND"
+5 SET ABPVMESS(2)="...Press any key to continue..."
DO PAUSE^ABPVZMM
End DoDot:1
QUIT
+6 WRITE !
SET ABPVMESS="Re-print the export log for "_^UTILITY("ABPVTX",0)
+7 SET ABPVMESS=ABPVMESS_" (Y/N)"
KILL DIR
DO YN^ABPVZMM
KILL ABPVMESS
+8 IF 'Y
DO PAUSE^ABPVZMM
GOTO ZENDA^ABPVTX2
+9 SET PGNO=0
SET ZCLCT=0
SET ZCLAMT=0
+10 WRITE !
DO A1
IF +IO=0
DO PAUSE^ABPVZMM
GOTO ZENDA^ABPVTX2
+11 WRITE !
DO WAIT^DICD
DO A4
DO PRESET
USE IO
WRITE @IOF
XECUTE ^%ZIS("C")
DO PAUSE^ABPVZMM
+12 QUIT
