Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABPVCK0

ABPVCK0.m

Go to the documentation of this file. 
  1. ABPVCK0 ;3P BILL TRANSMISSION EDIT REPORT;[ 08/07/91  3:51 PM ]
  1.  ;;2.0;FACILITY PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 1991
  1.  G A0
  1.  ;--------------------------------------------------------------------
  1. INSCHK ;PROCEDURE TO INSPECT FOR COMPLETE INSURANCE RECORD
  1.  S ZINSERR=0,ZNODE=""
  1. NXTNODE S ZNODE=$O(^AUTNINS(ZINSCO,ZNODE)) G:(ZNODE="")!(+ZNODE>1) INSCHKC
  1.  S ZY=^AUTNINS(ZINSCO,ZNODE)
  1.  I ZNODE=1 I $P(ZY,"^")']"" I $P(ZY,"^",5)']"" G NXTNODE
  1.  I $L($P(ZY,"^",2))<2 S ZINSERR=ZINSERR_1 G NXTNODE
  1.  I $L($P(ZY,"^",3))<2 S ZINSERR=ZINSERR_1 G NXTNODE
  1.  I +$P(ZY,"^",4)<1!('$D(^DIC(5,+$P(ZY,"^",4),0))) D  G NXTNODE
  1.  .S ZINSERR=ZINSERR_1
  1.  I $L($P(ZY,"^",5))<5!($P(ZY,"^",5)'?5N.E) D  G NXTNODE
  1.  .S ZINSERR=ZINSERR_1
  1.  S ZINSERR=ZINSERR_0 G NXTNODE
  1. INSCHKC I ZINSERR="01"!(ZINSERR="010") D
  1.  .S ^UTILITY("ABPVTXE","INS-ERR",ZINSCO)=""
  1.  I ZINSERR="001"!(ZINSERR="011") D
  1.  .S ^UTILITY("ABPVTXE","INS-ERR",ZINSCO)="*"
  1.  Q
  1.  ;--------------------------------------------------------------------
  1. A0 ;PROCEDURE TO DRAW SCREEN HEADING
  1.  W @IOF,! S PGNO=0 F I=1:1:79 W "*"
  1.  W !,"*",?13,"PRIVATE INSURANCE BILLING CLAIM TRANSMISSION EDIT REPORT"
  1.  W ?78,"*",! S X="FOR "_$P(^DIC(4,DUZ(2),0),"^",1) W "*",?80-$L(X)/2
  1.  W X,?78,"*",! S Y=DT X ^DD("DD") W "*",?80-$L(Y)/2,Y,?78,"*",!
  1.  F I=1:1:79 W "*"
  1.  ;--------------------------------------------------------------------
  1. A0A ;PROCEDURE TO GET THE LAST DATE DATA WAS EXPORTED
  1.  S LEXDATE=9999999-($O(^ABPVTXST("AC",DUZ(2),"")))
  1.  L (^ABPVFAC,^AUTNINS):1
  1.  I '$T D  H 4 G JOBEND^ABPVTX1
  1.  .W *7,!!,?18,"PRIVATE INSURANCE AUDIT or INSURER File in Use.",!,?22
  1.  .W "Cannot Do Export at this time.",!!,?25
  1.  .W "THIS JOB HAS BEEN CANCELLED"
  1.  D A1 G:+IO=0 S3ENDA G A2
  1.  ;--------------------------------------------------------------------
  1. A1 ;PROCEDURE TO GET PRINTER OUTPUT DEVICE
  1.  W !! S %IS="P",%ZIS("A")="Print Edit List on Device: " D ^%ZIS
  1.  Q
  1.  ;--------------------------------------------------------------------
  1. A2 ;PROCEDURE TO DETERMINE THE BEGINNING RECORD NUMBER FOR THIS RUN
  1.  S ABPV("SITE")=DUZ(2),BRECNO=0,R=0,ZCLCT=0,ZCLAMT=0
  1.  I '$D(^ABPVTXST(ABPV("SITE"))) G A2A
  1.  S X=+$P(^ABPVTXST(ABPV("SITE"),1,0),"^",4) I X<1 G A2A
  1.  S BRECNO=+$P(^ABPVTXST(ABPV("SITE"),1,X,0),"^",4)
  1.  I BRECNO'<+$P(^ABPVFAC(0),"^",3) D  D PRESET G S3ENDA
  1.  .U IO(0) W !!,*7,?10,"NO RECORDS AVAILABLE FOR EXPORT --  "
  1.  .U IO(0) W "JOB CANCELLED"
  1.  ;--------------------------------------------------------------------
  1. A2A ;PROCEDURE TO CONTROL REMAINING TASKS OF THIS ROUTINE
  1.  W ! D WAIT^DICD,A3^ABPVCK1,A4^ABPVCK1 G S3START
  1.  ;--------------------------------------------------------------------
  1. PRESET ;PROCEDURE TO RESET THE PRINTER TO 10 CPI
  1.  I $D(IO),$D(A("PRINT",10)) U IO W @A("PRINT",10)
  1.  Q
  1.  ;--------------------------------------------------------------------
  1. S3START ;PRINT INS CO ADD ERRORS REPORT OF INSURANCE CO ADDRESS ERRORS
  1.  S (R,RR)=0
  1.  I '$D(^UTILITY("ABPVTXE","INS-ERR")) G S3END
  1.  S X="You have INCOMPLETE ADDRESS INFORMATION in your INSURER FILE."
  1.  S Y="An ERROR REPORT will now be PRINTED."
  1.  U IO(0) W *7,*7,!!,?10,X,!!,?20,Y H 5
  1.  U IO W !!,?30,X,!,?40,Y
  1.  D HEADER2
  1. S3A S R=$O(^UTILITY("ABPVTXE","INS-ERR",R)) G S3END:R=""
  1.  S ZY=^AUTNINS(R,0)
  1.  W ?2,$E($P(ZY,"^",1),1,30)
  1.  W ?34,$E($P(ZY,"^",2),1,30)
  1.  W ?66,$E($P(ZY,"^",3),1,15) S X=+$P(ZY,"^",4) G S3C:+X<1
  1.  G S3C:'$D(^DIC(5,X,0))
  1.  W ?83,$P(^DIC(5,X,0),"^",2)
  1. S3C W ?87,$E($P(ZY,"^",5),1,10)
  1.  I ^UTILITY("ABPVTXE","INS-ERR",R)="*" W ?105,"YES"
  1.  W ! I $Y>50 D HEADER2
  1.  S RR=RR+1 G S3A
  1. S3END W !!,?30,"NUMBER OF RECORDS WITH INCOMPLETE DATA = ",RR,!! H 3
  1.  I $D(A("PRINT",10)) U IO W @A("PRINT",10)
  1. S3ENDA K %DT,A,BDATE,BDATED,EDATE,EDATED,I,PDFN,PGNO,R,RDATES,RR,X,XXX,Y,ZCLAMT,ZCLCT,ZINSCO,ZINSERR,ZX,ZY,^UTILITY("ABPVTXE"),ZNODE
  1.  X ^%ZIS("C") D PAUSE^ABPVZMM
  1.  Q
  1.  F I=1:1:122 W "*"
  1.  S X1="Device # "_+IO,X2="FOR "_$P(^DIC(4,DUZ(2),0),"^",1)
  1.  W !,"* ",X1,?32,"PRIVATE INSURANCE BILLING CLAIM TRANSMISSION EDIT REPORT",?111,"Page ",PGNO,?121,"*",!
  1.  S X="FOR "_$P(^DIC(4,DUZ(2),0),"^",1) W "*",?121-$L(X)/2,X,?121,"*",!
  1.  S Y=DT X ^DD("DD") W "*",?121-$L(Y)/2,Y,?121,"*",!,"*"
  1.  F I=1:1:120 W "-"
  1.  W "*",!,"*  ENTRY",?12,"CONTROL",?62,"DATE OF",?105,"CLAIM",?113,"T",?118,"D",?121,"*",!
  1.  W "*",?3,"DATE",?12,"NUMBER",?20,"***  PATIENT'S NAME   ***",?53,"H R N",?62,"SERVICE",?71,"INSURANCE COMPANY NAME",?105,"AMOUNT",?113,"P",?118,"V",?121,"*",!
  1.  F I=1:1:122 W "*"
  1.  W !!
  1.  Q
  1. HEADER2 U IO W @IOF
  1.  F I=1:1:117 W "*"
  1.  W !,"*",?47,"INSURANCE COMPANY ADDRESS ERRORS",?116,"*",!,"*"
  1.  W ?32,"THESE ERRORS MUST BE CORRECTED IN ORDER TO EXPORT CLAIM DATA",?116,"*",!,"*"
  1.  F I=1:1:115 W "-"
  1.  W "*",!,"*",?2,"INSURANCE COMPANY NAME",?34,"***   STREET ADDRESS   ***",?66,"CITY",?83,"ST",?87,"ZIP CODE",?100,"B-ADDRESS ERROR",?116,"*",!,"*"
  1.  F I=1:1:115 W "-"
  1.  W "*",!! Q
  1. ERR U IO W @A("PRINT",10) X ^%ZIS("C") G ERR^ZU