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

ABPVTX0.m

Go to the documentation of this file. 
  1. 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
  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.  D ^ABPVVAR W @IOF,! S PGNO=0 F I=1:1:79 W "*"
  1.  W !,"*",?17,"PRIVATE INSURANCE BILLING CLAIM EXPORT PROGRAM",?78,"*",!
  1.  S X="FOR "_$P(^DIC(4,DUZ(2),0),"^",1) W "*",?80-$L(X)/2,X,?78,"*",!
  1.  S Y=DT X ^DD("DD") W "*",?80-$L(Y)/2,Y,?78,"*",! 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.  W !! D A1 I +IO=0 D PAUSE^ABPVZMM G ZEND^ABPVTX2
  1.  G A2
  1.  ;--------------------------------------------------------------------
  1. A1 ;PROCEDURE TO GET PRINTER OUTPUT DEVICE
  1.  S %IS="P",%ZIS("A")="Print Export Report on Device: " D ^%ZIS Q:POP
  1.  I $E(IOST)'="P" W ?4,"<<< MUST BE A PRINTER TYPE DEVICE >>>",*7 G A1
  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  G ZENDA^ABPVTX2
  1.  .X ^%ZIS("C") S IOP=$I D ^%ZIS K IOP
  1.  .W !,*7,?10,"NO RECORDS AVAILABLE FOR EXPORT --  JOB CANCELLED" H 2
  1.  ;--------------------------------------------------------------------
  1. A2A ;PROCEDURE TO CONTROL REMAINING TASKS OF THIS ROUTINE
  1.  W ! D WAIT^DICD,A3,A4 G S3START^ABPVTX1
  1.  ;--------------------------------------------------------------------
  1. A3 ;PROCEDURE TO BUILD SORTED UTILITY GLOBAL INDEX
  1.  K ^UTILITY("ABPVTX") S Y=DT X ^DD("DD") S ^UTILITY("ABPVTX",0)=Y
  1.  S RR=+BRECNO F ABPVI=0:0 D  Q:+RR=0
  1.  .S RR=$O(^ABPVFAC(RR)) Q:+RR=0
  1.  .S ZX=^ABPVFAC(RR,0),PDFN=$P(ZX,"^",2),PNAME=$P(^DPT(PDFN,0),"^")
  1.  .S ^UTILITY("ABPVTX",PNAME,$P(ZX,"^",3),RR)=""
  1.  .K ZX,PDFN,PNAME
  1.  Q
  1.  ;--------------------------------------------------------------------
  1. A4 ;PROCEDURE TO PRINT SORTED EXPORT TRANSMITTAL LOG
  1.  K ^UTILITY("ABPVTXE") D ^ABPVPRT,HEADER^ABPVTX1
  1.  S R=0 F ABPVI=0:0 D  Q:R=""
  1.  .S R=$O(^UTILITY("ABPVTX",R)) Q:R=""
  1.  .S RR=0 F ABPVI=0:0 D  Q:+RR=0
  1.  ..S RR=$O(^UTILITY("ABPVTX",R,RR)) Q:+RR=0
  1.  ..S RRR=0 F ABPVI=0:0 D  Q:+RRR=0
  1.  ...S RRR=$O(^UTILITY("ABPVTX",R,RR,RRR)) Q:+RRR=0
  1.  ...S ZX=^ABPVFAC(RRR,0)
  1.  ...S X=$P(ZX,"^",11)
  1.  ...W ?1,$E(X,4,5),"/",$E(X,6,7),"/",$E(X,2,3)
  1.  ...W ?11,$J($P(ZX,"^",1),7)
  1.  ...S PDFN=$P(ZX,"^",2) W ?20,$E($P(^DPT(PDFN,0),"^",1),1,30)
  1.  ...W ?52,$J($P(ZX,"^",5),6)
  1.  ...S X=$P(ZX,"^",3)
  1.  ...W ?61,$E(X,4,5),"/",$E(X,6,7),"/",$E(X,2,3)
  1.  ...S ZINSCO=$P(ZX,"^",8) D INSCHK
  1.  ...W ?71,$P(^AUTNINS($P(ZX,"^",8),0),"^",1)
  1.  ...W ?103,$J($P(ZX,"^",9),8,2)
  1.  ...W ?113,$P(ZX,"^",6)
  1.  ...W ?117,$J($P(ZX,"^",7),2),!
  1.  ...S ZCLCT=ZCLCT+1,ZCLAMT=ZCLAMT+$P(ZX,"^",9)
  1.  ...I $Y>50 D HEADER^ABPVTX1
  1.  W ?5 F I=1:1:110 W "-"
  1.  W !,?5,"TOTAL CLAIMS = ",ZCLCT,?45,"TOTAL CLAIM AMT = ",?64
  1.  W $J(ZCLAMT,8,2),!! D PRESET H 5 
  1.  Q
  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. REPRT ;PROCEDURE TO RE-PRINT THE MOST RECENT EXPORT LOG
  1.  K ABPV("HD") S ABPV("HD",1)=ABPVTLE
  1.  S ABPV("HD",2)="Re-print the MOST RECENT EXPORT LOG" D ^ABPVHD
  1.  I $D(^UTILITY("ABPVTX",0))'=1 D  Q
  1.  . K ABPVMESS S ABPVMESS="PREVIOUS EXPORT NOT FOUND"
  1.  . S ABPVMESS(2)="...Press any key to continue..." D PAUSE^ABPVZMM
  1.  W ! S ABPVMESS="Re-print the export log for "_^UTILITY("ABPVTX",0)
  1.  S ABPVMESS=ABPVMESS_" (Y/N)" K DIR D YN^ABPVZMM K ABPVMESS
  1.  I 'Y D PAUSE^ABPVZMM G ZENDA^ABPVTX2
  1.  S PGNO=0,ZCLCT=0,ZCLAMT=0 
  1.  W ! D A1 I +IO=0 D PAUSE^ABPVZMM G ZENDA^ABPVTX2
  1.  W ! D WAIT^DICD,A4,PRESET U IO W @IOF X ^%ZIS("C") D PAUSE^ABPVZMM
  1.  Q