- ABPVTX2 ;PT 3 OF PVT INS CLAIM EXPORT PROGRAM [ 08/07/91 3:44 PM ]
- ;;2.0;FACILITY PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 1991
- A0 W !,"NOT AN ENTRY POINT" Q
- S4C S ZY=^AUTNINS(X,1) F I=1:1:5 S $P(EX2,"^",I+1)=$P(ZY,"^",I)
- Q
- S4START S (R,RR,RRR,RCT)=0 K ^ABPVDATA
- U IO(0) W !!,"Generating Private Insurance Claim Export Records: ",!
- S R=BRECNO
- S4A S R=$O(^ABPVFAC(R)) G S4END:+R=0 S ZX=^ABPVFAC(R,0)
- S $P(EX1,"^",1)="ABP1",$P(EX1,"^",2)=$P(^DPT(+$P(ZX,"^",2),0),"^",1)
- S $P(EX1,"^",3)=$P(^AUTTLOC($P(^ABPVFAC(R,0),"^",4),0),"^",10)
- S $P(EX1,"^",4)=$P(ZX,"^",5),$P(EX1,"^",5)=$P(ZX,"^",3)
- S $P(EX1,"^",6)=$P(ZX,"^",6),$P(EX1,"^",7)=$P(ZX,"^",7)
- S $P(EX1,"^",8)=$P(ZX,"^",9),$P(EX1,"^",9)=$P(ZX,"^",10)
- S $P(EX1,"^",10)=$P(ZX,"^",11),$P(EX1,"^",11)=$P(ZX,"^",16)
- S $P(EX1,"^",12)=$P(ZX,"^",17)
- S X=$P(ZX,"^",8) F I=1:1:6 S $P(EX1,"^",I+12)=$P(^AUTNINS(X,0),"^",I)
- S $P(EX1,"^",19)=$P(^AUTNINS(X,0),"^",9)
- S4B S ZY="",EX2="ABP2" I $D(^AUTNINS(X,1))=1 D S4C
- S $P(EX1,"^",20)=$P(ZX,"^",1),$P(EX1,"^",21)=DT,$P(EX1,"^",22)="P"
- S $P(EX1,"^",23)=$P(^DPT(+$P(ZX,"^",2),0),"^",9)
- S $P(^ABPVFAC(R,0),"^",14)="Y",$P(^ABPVFAC(R,0),"^",15)=DT
- K ^ABPVFAC("E","N",R)
- S ^ABPVFAC("E","Y",R)="",^ABPVFAC("F",DT,R)=""
- S RCT=RCT+1,^ABPVDATA(RCT)=EX1 S:RCT=1 (FDATE,EDATE)=$P(ZX,"^",11)
- S RCT=RCT+1,^ABPVDATA(RCT)=EX2
- S DA=$O(^ABMDBILL("B",$P(ZX,"^"),"")) I DA>0 S DIE="^ABMDBILL(",DR=".18////1" D ^DIE I $D(^ABMDBILL(DA,1)),$P(^(1),"^",7)>0 S DA=$P(^(1),"^",7),DIE="^ABMDTXST(",DR=".06////1" D ^DIE
- I RCT#4=0 U IO(0) W $J((RCT/2),8)
- I $P(ZX,"^",11)<FDATE S FDATE=$P(ZX,"^",11)
- I $P(ZX,"^",11)>EDATE S EDATE=$P(ZX,"^",11)
- S LRECNO=R G S4A
- S4END D ^ABPVVAR I RCT=0 D G ZEND
- .U IO(0) W !!,*7,?10,"NO RECORDS AVAILABLE FOR EXPORT -- "
- .W "JOB CANCELLED"
- S ^ABPVDATA(0)=$P(^AUTTLOC(ABPV("SITE"),0),"^",10)_"^"_$P(^DIC(4,ABPV("SITE"),0),"^",1)_"^"_DT_"^"_FDATE_"^"_EDATE_"^"_LRECNO_"^"_(RCT/2)
- U IO(0) W ! I $D(A("PRINT",10)) U IO W @A("PRINT",10)
- S XX=^ABPVDATA(0)
- S5START U IO W @IOF D HEADER W @IOF X ^%ZIS("C") D ^%AUCLS,HEADER
- WRITETP S AUGL="ABPVDATA",AUTLE="3P CLAIM EXPORT -"
- D ^AUGSAVE I AUFLG G JOBABEND
- K ABPVMESS S ABPVMESS="NORMAL END OF JOB"
- S ABPVMESS(2)="... Press any key to continue ..." D PAUSE^ABPVZMM
- S DIE="^ABPVTXST(",XN=$P(^ABPVTXST(0),"^",4)+1
- I $D(^ABPVTXST("B",DUZ(2))) G SETZERA
- S $P(^ABPVTXST(0),"^",3)=DUZ(2),^ABPVTXST(DUZ(2),0)=DUZ(2)
- S $P(^ABPVTXST(0),"^",4)=XN,^ABPVTXST("B",DUZ(2),DUZ(2))=""
- SETZERA S DA=DUZ(2),DR="1///"_DT,DR(2,9002271.01)=".01///"_DT D ^DIE
- S NI=$P(^ABPVTXST(DUZ(2),1,0),"^",3)
- S ^ABPVTXST(DUZ(2),1,NI,0)=DT_"^"_FDATE_"^"_EDATE_"^"_LRECNO_"^"_(RCT/2)_"^^^^^Y"
- G ZEND
- JOBABEND W *7,!!,?25,"ABNORMAL END OF PVT INS EXPORT"
- I $D(AUFLG(1)) W !!?(40-($L(AUFLG(1))/2)),AUFLG(1),!! K AUFLG
- W !,"ENTER <RETURN> TO CONTINUE" R X:DTIME
- ZEND I $D(IO(0))=1 I $D(IO)=1 I IO'=IO(0) U IO W @IOF X ^%ZIS("C")
- ZENDA K BRECNO,EDATE,EX1,FDATE,I,PGNO,R,RCT,RR,RRR,RSAVE,X,Y,ZCLAMT,ZCLCT
- K ZINSCO,ZINSERR,ZX,ZY,ABPV,LEXDATE,ZNODE,ABPV("HD")
- L
- Q
- W !,"*",?12,"PRIVATE INSURANCE BILLING CLAIM EXPORT REPORT",?69,"*",!
- S X="FOR "_$P(^DIC(4,DUZ(2),0),"^",1) W "*",?70-$L(X)/2,X,?69,"*",!
- S Y=DT X ^DD("DD") W "*",?70-$L(Y)/2,Y,?69,"*",! F I=1:1:70 W "*"
- W !!?10,"FACILITY CODE = ",?40,$P(XX,"^",1)
- W !,?10,"DATE EXPORT CREATED = " S Y=$P(XX,"^",3) X ^DD("DD") W ?40,Y
- W !,?10,"BEGINNING CLAIM DATE = " S Y=$P(XX,"^",4) X ^DD("DD") W ?40,Y
- W !,?10,"ENDING CLAIM DATE = " S Y=$P(XX,"^",5) X ^DD("DD") W ?40,Y
- W !,?10,"NUMBER OF CLAIM RECORDS = ",?40,$P(XX,"^",7),!!
- F I=1:1:70 W "*"
- Q
- ABPVTX2 ;PT 3 OF PVT INS CLAIM EXPORT PROGRAM [ 08/07/91 3:44 PM ]
- +1 ;;2.0;FACILITY PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 1991
- A0 WRITE !,"NOT AN ENTRY POINT"
- QUIT
- S4C SET ZY=^AUTNINS(X,1)
- FOR I=1:1:5
- SET $PIECE(EX2,"^",I+1)=$PIECE(ZY,"^",I)
- +1 QUIT
- S4START SET (R,RR,RRR,RCT)=0
- KILL ^ABPVDATA
- +1 USE IO(0)
- WRITE !!,"Generating Private Insurance Claim Export Records: ",!
- +2 SET R=BRECNO
- S4A SET R=$ORDER(^ABPVFAC(R))
- IF +R=0
- GOTO S4END
- SET ZX=^ABPVFAC(R,0)
- +1 SET $PIECE(EX1,"^",1)="ABP1"
- SET $PIECE(EX1,"^",2)=$PIECE(^DPT(+$PIECE(ZX,"^",2),0),"^",1)
- +2 SET $PIECE(EX1,"^",3)=$PIECE(^AUTTLOC($PIECE(^ABPVFAC(R,0),"^",4),0),"^",10)
- +3 SET $PIECE(EX1,"^",4)=$PIECE(ZX,"^",5)
- SET $PIECE(EX1,"^",5)=$PIECE(ZX,"^",3)
- +4 SET $PIECE(EX1,"^",6)=$PIECE(ZX,"^",6)
- SET $PIECE(EX1,"^",7)=$PIECE(ZX,"^",7)
- +5 SET $PIECE(EX1,"^",8)=$PIECE(ZX,"^",9)
- SET $PIECE(EX1,"^",9)=$PIECE(ZX,"^",10)
- +6 SET $PIECE(EX1,"^",10)=$PIECE(ZX,"^",11)
- SET $PIECE(EX1,"^",11)=$PIECE(ZX,"^",16)
- +7 SET $PIECE(EX1,"^",12)=$PIECE(ZX,"^",17)
- +8 SET X=$PIECE(ZX,"^",8)
- FOR I=1:1:6
- SET $PIECE(EX1,"^",I+12)=$PIECE(^AUTNINS(X,0),"^",I)
- +9 SET $PIECE(EX1,"^",19)=$PIECE(^AUTNINS(X,0),"^",9)
- S4B SET ZY=""
- SET EX2="ABP2"
- IF $DATA(^AUTNINS(X,1))=1
- DO S4C
- +1 SET $PIECE(EX1,"^",20)=$PIECE(ZX,"^",1)
- SET $PIECE(EX1,"^",21)=DT
- SET $PIECE(EX1,"^",22)="P"
- +2 SET $PIECE(EX1,"^",23)=$PIECE(^DPT(+$PIECE(ZX,"^",2),0),"^",9)
- +3 SET $PIECE(^ABPVFAC(R,0),"^",14)="Y"
- SET $PIECE(^ABPVFAC(R,0),"^",15)=DT
- +4 KILL ^ABPVFAC("E","N",R)
- +5 SET ^ABPVFAC("E","Y",R)=""
- SET ^ABPVFAC("F",DT,R)=""
- +6 SET RCT=RCT+1
- SET ^ABPVDATA(RCT)=EX1
- IF RCT=1
- SET (FDATE,EDATE)=$PIECE(ZX,"^",11)
- +7 SET RCT=RCT+1
- SET ^ABPVDATA(RCT)=EX2
- +8 SET DA=$ORDER(^ABMDBILL("B",$PIECE(ZX,"^"),""))
- IF DA>0
- SET DIE="^ABMDBILL("
- SET DR=".18////1"
- DO ^DIE
- IF $DATA(^ABMDBILL(DA,1))
- IF $PIECE(^(1),"^",7)>0
- SET DA=$PIECE(^(1),"^",7)
- SET DIE="^ABMDTXST("
- SET DR=".06////1"
- DO ^DIE
- +9 IF RCT#4=0
- USE IO(0)
- WRITE $JUSTIFY((RCT/2),8)
- +10 IF $PIECE(ZX,"^",11)<FDATE
- SET FDATE=$PIECE(ZX,"^",11)
- +11 IF $PIECE(ZX,"^",11)>EDATE
- SET EDATE=$PIECE(ZX,"^",11)
- +12 SET LRECNO=R
- GOTO S4A
- S4END DO ^ABPVVAR
- IF RCT=0
- Begin DoDot:1
- +1 USE IO(0)
- WRITE !!,*7,?10,"NO RECORDS AVAILABLE FOR EXPORT -- "
- +2 WRITE "JOB CANCELLED"
- End DoDot:1
- GOTO ZEND
- +3 SET ^ABPVDATA(0)=$PIECE(^AUTTLOC(ABPV("SITE"),0),"^",10)_"^"_$PIECE(^DIC(4,ABPV("SITE"),0),"^",1)_"^"_DT_"^"_FDATE_"^"_EDATE_"^"_LRECNO_"^"_(RCT/2)
- +4 USE IO(0)
- WRITE !
- IF $DATA(A("PRINT",10))
- USE IO
- WRITE @A("PRINT",10)
- +5 SET XX=^ABPVDATA(0)
- S5START USE IO
- WRITE @IOF
- DO HEADER
- WRITE @IOF
- XECUTE ^%ZIS("C")
- DO ^%AUCLS
- DO HEADER
- WRITETP SET AUGL="ABPVDATA"
- SET AUTLE="3P CLAIM EXPORT -"
- +1 DO ^AUGSAVE
- IF AUFLG
- GOTO JOBABEND
- +2 KILL ABPVMESS
- SET ABPVMESS="NORMAL END OF JOB"
- +3 SET ABPVMESS(2)="... Press any key to continue ..."
- DO PAUSE^ABPVZMM
- +4 SET DIE="^ABPVTXST("
- SET XN=$PIECE(^ABPVTXST(0),"^",4)+1
- +5 IF $DATA(^ABPVTXST("B",DUZ(2)))
- GOTO SETZERA
- +6 SET $PIECE(^ABPVTXST(0),"^",3)=DUZ(2)
- SET ^ABPVTXST(DUZ(2),0)=DUZ(2)
- +7 SET $PIECE(^ABPVTXST(0),"^",4)=XN
- SET ^ABPVTXST("B",DUZ(2),DUZ(2))=""
- SETZERA SET DA=DUZ(2)
- SET DR="1///"_DT
- SET DR(2,9002271.01)=".01///"_DT
- DO ^DIE
- +1 SET NI=$PIECE(^ABPVTXST(DUZ(2),1,0),"^",3)
- +2 SET ^ABPVTXST(DUZ(2),1,NI,0)=DT_"^"_FDATE_"^"_EDATE_"^"_LRECNO_"^"_(RCT/2)_"^^^^^Y"
- +3 GOTO ZEND
- JOBABEND WRITE *7,!!,?25,"ABNORMAL END OF PVT INS EXPORT"
- +1 IF $DATA(AUFLG(1))
- WRITE !!?(40-($LENGTH(AUFLG(1))/2)),AUFLG(1),!!
- KILL AUFLG
- +2 WRITE !,"ENTER <RETURN> TO CONTINUE"
- READ X:DTIME
- ZEND IF $DATA(IO(0))=1
- IF $DATA(IO)=1
- IF IO'=IO(0)
- USE IO
- WRITE @IOF
- XECUTE ^%ZIS("C")
- ZENDA KILL BRECNO,EDATE,EX1,FDATE,I,PGNO,R,RCT,RR,RRR,RSAVE,X,Y,ZCLAMT,ZCLCT
- +1 KILL ZINSCO,ZINSERR,ZX,ZY,ABPV,LEXDATE,ZNODE,ABPV("HD")
- +2 LOCK
- +3 QUIT
- WRITE "*"
- +1 WRITE !,"*",?12,"PRIVATE INSURANCE BILLING CLAIM EXPORT REPORT",?69,"*",!
- +2 SET X="FOR "_$PIECE(^DIC(4,DUZ(2),0),"^",1)
- WRITE "*",?70-$LENGTH(X)/2,X,?69,"*",!
- +3 SET Y=DT
- XECUTE ^DD("DD")
- WRITE "*",?70-$LENGTH(Y)/2,Y,?69,"*",!
- FOR I=1:1:70
- WRITE "*"
- +4 WRITE !!?10,"FACILITY CODE = ",?40,$PIECE(XX,"^",1)
- +5 WRITE !,?10,"DATE EXPORT CREATED = "
- SET Y=$PIECE(XX,"^",3)
- XECUTE ^DD("DD")
- WRITE ?40,Y
- +6 WRITE !,?10,"BEGINNING CLAIM DATE = "
- SET Y=$PIECE(XX,"^",4)
- XECUTE ^DD("DD")
- WRITE ?40,Y
- +7 WRITE !,?10,"ENDING CLAIM DATE = "
- SET Y=$PIECE(XX,"^",5)
- XECUTE ^DD("DD")
- WRITE ?40,Y
- +8 WRITE !,?10,"NUMBER OF CLAIM RECORDS = ",?40,$PIECE(XX,"^",7),!!
- +9 FOR I=1:1:70
- WRITE "*"
- +10 QUIT
