ABPVEEC3 ;ENTER/EDIT PVT INS CLAIMS; [ 07/16/91 9:01 AM ]
;;2.0;FACILITY PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 1991
W !!,"NOT AN ENTRY POINT!",!! Q
;---------------------------------------------------------------------
DOS D REVON^ABPVEEC0 W "Enter/Select billing date"
W:$D(ABPVRON)=1 @(ABPVROFF)
S ABPVDOS=$O(^ABPVFAC("PC",ABPVPDFN,"")) I +ABPVDOS=0 G GETDOS
S ABPVDOS=0,ABPVCNT=10000 F I=0:0 D Q:+ABPVDOS=0
.S ABPVDOS=$O(^ABPVFAC("PC",ABPVPDFN,ABPVDOS)) Q:+ABPVDOS=0
.S DA=0 F J=0:0 D Q:+DA=0
..S DA=$O(^ABPVFAC("PC",ABPVPDFN,ABPVDOS,DA)) Q:+DA=0
..Q:$D(^ABPVFAC(DA,0))'=1 S DATA=^(0),ABPVCNT=ABPVCNT-1
..S ABPVDT(ABPVCNT)=$J($P(DATA,"^"),7)_" "
..S ABPVDT(ABPVCNT)=ABPVDT(ABPVCNT)_$E(ABPVDOS,4,5)_"/"_$E(ABPVDOS,6,7)_"/"
..S ABPVDT(ABPVCNT)=ABPVDT(ABPVCNT)_$E(ABPVDOS,2,3)_$J($P(DATA,"^",6),5)
..S ABPVDT(ABPVCNT)=ABPVDT(ABPVCNT)_$J($P(DATA,"^",7),5)
..S ABPVDT(ABPVCNT)=ABPVDT(ABPVCNT)_$J($P(^AUTNINS($P(DATA,"^",8),0),"^"),33)
..S ABPVDT(ABPVCNT)=ABPVDT(ABPVCNT)_$J($P(DATA,"^",9),8,2)
G:+ABPVCNT=10000 GETDOS S CT=0
W !?6,"BILL ID DOS TYP D/V INSURER "
W " AMT",!?6,"------- -------- --- --- "
W "------------------------------ -----"
F CNT=1:1 S CT=$O(ABPVDT(CT)) Q:+CT=0 S ABPVDATE(CNT)=ABPVDT(CT)
S CNT=CNT-1 K ABPVDT S (CT,I,II)=0
NXTCT S DN=I+1 F I=I+1:1:II+3 S CT=$O(ABPVDATE(CT)) Q:+CT=0 D
.W ! W $J(CT,2),".",?6,ABPVDATE(CT)
S:I=CNT CT="",I=I+1 S:+CT=0 I=I-1 S (D1,II)=I
SELECT W !,"CHOOSE " S:+CT=0 DN=1 W DN,"-",D1 W:+CT'=0 " or '^' TO STOP"
W ": " R X:DTIME
I X["^" G GETDOS
I X="" G:+CT=0 GETDOS G NXTCT
I X<1 G:+CT=0 GETDOS G NXTCT
I $D(ABPVDATE(X))=0 W *7," ??" G SELECT
S ABPVDOS=$E(ABPVDATE(+X),10,17),ABPVCDFN=$E(ABPVDATE(+X),1,7)
F ABPVI=0:0 Q:$E(ABPVCDFN,1)'=" " S ABPVCDFN=$E(ABPVCDFN,2,7)
K DIC S DIC="^ABPVFAC(",DIC(0)="QM",X=ABPVCDFN D ^DIC S DA=+Y
I +Y'>0 W *7," ??" K ABPVDOS G SELECT
K ABPVDATE,CT,DN,D1,I,II S ABPVCDFN=DA,DATA=^ABPVFAC(ABPVCDFN,0)
S ABPVTYPE=$P(DATA,"^",6),ABPVDV=$P(DATA,"^",7),ABPVINS=$P(DATA,"^",8)
S:ABPVTYPE="O" ABPVTYPE="OUTPATIENT"
S:ABPVTYPE="I" ABPVTYPE="INPATIENT (HOSPITAL ONLY)"
S:ABPVTYPE="P" ABPVTYPE="INPATIENT (PHYSICIAN ONLY)"
S:ABPVTYPE="D" ABPVTYPE="DENTAL"
S ABPVINS=$P(^AUTNINS(ABPVINS,0),"^")
S ABPVAMT=$P(DATA,"^",9),ABPVAMT="$"_$J(ABPVAMT,8,2)
S ABPVTXFG=$P(DATA,"^",14),ABPVTXDT=$P(DATA,"^",15)
S ABPVPHNM=$P(DATA,"^",16),ABPVPNUM=$P(DATA,"^",17) D SCREEN^ABPVEEC0
Q
GETDOS K DIR,ABPVDOS
S DIR(0)="D",DIR("A")="Select DATE OF SERVICE" D ^DIR S ABPVDOS=+Y
I +ABPVDOS'>0 K ABPVDOS Q
I $D(^ABPVFAC("PC",ABPVPDFN,ABPVDOS))'=0 S NEW=0 D I 'NEW K ABPVDOS Q
.K DIR S DIR(0)="Y",DIR("B")="N"
.S DIR("A")="Claim already on file for this date - add another"
.W *7 D ^DIR I Y S NEW=1
S (DA,ABPVCDFN)=$P(^ABPVFAC(0),"^",3)
F ABPVI=0:0 S DA=$O(^ABPVFAC(DA)) Q:+DA=0 S ABPVCDFN=DA
S ABPVCDFN=ABPVCDFN+1 K DIC S DIC="^ABPVFAC(",DIC(0)="L"
S X=ABPVCDFN_"A" D ^DIC K DIE,DA,DR I +Y<1 D K ABPVDOS Q
.W *7,!?5,"<<< Sorry, file access denied >>>" H 3
S DIE="^ABPVFAC(",DA=ABPVCDFN,DR="1////"_ABPVPDFN_";2////"_ABPVDOS
S DR=DR_";3////"_DUZ(2)_";4////"_ABPVHRN_";4.03////"_ABPVPSSN
S DR=DR_";11////"_DT_";16////N"
D ^DIE S Y=ABPVDOS X ^DD("DD") S ABPVDOS=Y
S ABPVTEXT=";;(4) ;Date of Service:;7;10;ABPVDOS"
S X=$S($Y>23:"SCREEN",$Y'>23:"WRITE",1:"SCREEN")
S X=X_"^ABPVEEC0" D @X
Q
ABPVEEC3 ;ENTER/EDIT PVT INS CLAIMS; [ 07/16/91 9:01 AM ]
+1 ;;2.0;FACILITY PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 1991
+2 WRITE !!,"NOT AN ENTRY POINT!",!!
QUIT
+3 ;---------------------------------------------------------------------
DOS DO REVON^ABPVEEC0
WRITE "Enter/Select billing date"
+1 IF $DATA(ABPVRON)=1
WRITE @(ABPVROFF)
+2 SET ABPVDOS=$ORDER(^ABPVFAC("PC",ABPVPDFN,""))
IF +ABPVDOS=0
GOTO GETDOS
+3 SET ABPVDOS=0
SET ABPVCNT=10000
FOR I=0:0
Begin DoDot:1
+4 SET ABPVDOS=$ORDER(^ABPVFAC("PC",ABPVPDFN,ABPVDOS))
IF +ABPVDOS=0
QUIT
+5 SET DA=0
FOR J=0:0
Begin DoDot:2
+6 SET DA=$ORDER(^ABPVFAC("PC",ABPVPDFN,ABPVDOS,DA))
IF +DA=0
QUIT
+7 IF $DATA(^ABPVFAC(DA,0))'=1
QUIT
SET DATA=^(0)
SET ABPVCNT=ABPVCNT-1
+8 SET ABPVDT(ABPVCNT)=$JUSTIFY($PIECE(DATA,"^"),7)_" "
+9 SET ABPVDT(ABPVCNT)=ABPVDT(ABPVCNT)_$EXTRACT(ABPVDOS,4,5)_"/"_$EXTRACT(ABPVDOS,6,7)_"/"
+10 SET ABPVDT(ABPVCNT)=ABPVDT(ABPVCNT)_$EXTRACT(ABPVDOS,2,3)_$JUSTIFY($PIECE(DATA,"^",6),5)
+11 SET ABPVDT(ABPVCNT)=ABPVDT(ABPVCNT)_$JUSTIFY($PIECE(DATA,"^",7),5)
+12 SET ABPVDT(ABPVCNT)=ABPVDT(ABPVCNT)_$JUSTIFY($PIECE(^AUTNINS($PIECE(DATA,"^",8),0),"^"),33)
+13 SET ABPVDT(ABPVCNT)=ABPVDT(ABPVCNT)_$JUSTIFY($PIECE(DATA,"^",9),8,2)
End DoDot:2
IF +DA=0
QUIT
End DoDot:1
IF +ABPVDOS=0
QUIT
+14 IF +ABPVCNT=10000
GOTO GETDOS
SET CT=0
+15 WRITE !?6,"BILL ID DOS TYP D/V INSURER "
+16 WRITE " AMT",!?6,"------- -------- --- --- "
+17 WRITE "------------------------------ -----"
+18 FOR CNT=1:1
SET CT=$ORDER(ABPVDT(CT))
IF +CT=0
QUIT
SET ABPVDATE(CNT)=ABPVDT(CT)
+19 SET CNT=CNT-1
KILL ABPVDT
SET (CT,I,II)=0
NXTCT SET DN=I+1
FOR I=I+1:1:II+3
SET CT=$ORDER(ABPVDATE(CT))
IF +CT=0
QUIT
Begin DoDot:1
+1 WRITE !
WRITE $JUSTIFY(CT,2),".",?6,ABPVDATE(CT)
End DoDot:1
+2 IF I=CNT
SET CT=""
SET I=I+1
IF +CT=0
SET I=I-1
SET (D1,II)=I
SELECT WRITE !,"CHOOSE "
IF +CT=0
SET DN=1
WRITE DN,"-",D1
IF +CT'=0
WRITE " or '^' TO STOP"
+1 WRITE ": "
READ X:DTIME
+2 IF X["^"
GOTO GETDOS
+3 IF X=""
IF +CT=0
GOTO GETDOS
GOTO NXTCT
+4 IF X<1
IF +CT=0
GOTO GETDOS
GOTO NXTCT
+5 IF $DATA(ABPVDATE(X))=0
WRITE *7," ??"
GOTO SELECT
+6 SET ABPVDOS=$EXTRACT(ABPVDATE(+X),10,17)
SET ABPVCDFN=$EXTRACT(ABPVDATE(+X),1,7)
+7 FOR ABPVI=0:0
IF $EXTRACT(ABPVCDFN,1)'=" "
QUIT
SET ABPVCDFN=$EXTRACT(ABPVCDFN,2,7)
+8 KILL DIC
SET DIC="^ABPVFAC("
SET DIC(0)="QM"
SET X=ABPVCDFN
DO ^DIC
SET DA=+Y
+9 IF +Y'>0
WRITE *7," ??"
KILL ABPVDOS
GOTO SELECT
+10 KILL ABPVDATE,CT,DN,D1,I,II
SET ABPVCDFN=DA
SET DATA=^ABPVFAC(ABPVCDFN,0)
+11 SET ABPVTYPE=$PIECE(DATA,"^",6)
SET ABPVDV=$PIECE(DATA,"^",7)
SET ABPVINS=$PIECE(DATA,"^",8)
+12 IF ABPVTYPE="O"
SET ABPVTYPE="OUTPATIENT"
+13 IF ABPVTYPE="I"
SET ABPVTYPE="INPATIENT (HOSPITAL ONLY)"
+14 IF ABPVTYPE="P"
SET ABPVTYPE="INPATIENT (PHYSICIAN ONLY)"
+15 IF ABPVTYPE="D"
SET ABPVTYPE="DENTAL"
+16 SET ABPVINS=$PIECE(^AUTNINS(ABPVINS,0),"^")
+17 SET ABPVAMT=$PIECE(DATA,"^",9)
SET ABPVAMT="$"_$JUSTIFY(ABPVAMT,8,2)
+18 SET ABPVTXFG=$PIECE(DATA,"^",14)
SET ABPVTXDT=$PIECE(DATA,"^",15)
+19 SET ABPVPHNM=$PIECE(DATA,"^",16)
SET ABPVPNUM=$PIECE(DATA,"^",17)
DO SCREEN^ABPVEEC0
+20 QUIT
GETDOS KILL DIR,ABPVDOS
+1 SET DIR(0)="D"
SET DIR("A")="Select DATE OF SERVICE"
DO ^DIR
SET ABPVDOS=+Y
+2 IF +ABPVDOS'>0
KILL ABPVDOS
QUIT
+3 IF $DATA(^ABPVFAC("PC",ABPVPDFN,ABPVDOS))'=0
SET NEW=0
Begin DoDot:1
+4 KILL DIR
SET DIR(0)="Y"
SET DIR("B")="N"
+5 SET DIR("A")="Claim already on file for this date - add another"
+6 WRITE *7
DO ^DIR
IF Y
SET NEW=1
End DoDot:1
IF 'NEW
KILL ABPVDOS
QUIT
+7 SET (DA,ABPVCDFN)=$PIECE(^ABPVFAC(0),"^",3)
+8 FOR ABPVI=0:0
SET DA=$ORDER(^ABPVFAC(DA))
IF +DA=0
QUIT
SET ABPVCDFN=DA
+9 SET ABPVCDFN=ABPVCDFN+1
KILL DIC
SET DIC="^ABPVFAC("
SET DIC(0)="L"
+10 SET X=ABPVCDFN_"A"
DO ^DIC
KILL DIE,DA,DR
IF +Y<1
Begin DoDot:1
+11 WRITE *7,!?5,"<<< Sorry, file access denied >>>"
HANG 3
End DoDot:1
KILL ABPVDOS
QUIT
+12 SET DIE="^ABPVFAC("
SET DA=ABPVCDFN
SET DR="1////"_ABPVPDFN_";2////"_ABPVDOS
+13 SET DR=DR_";3////"_DUZ(2)_";4////"_ABPVHRN_";4.03////"_ABPVPSSN
+14 SET DR=DR_";11////"_DT_";16////N"
+15 DO ^DIE
SET Y=ABPVDOS
XECUTE ^DD("DD")
SET ABPVDOS=Y
+16 SET ABPVTEXT=";;(4) ;Date of Service:;7;10;ABPVDOS"
+17 SET X=$SELECT($Y>23:"SCREEN",$Y'>23:"WRITE",1:"SCREEN")
+18 SET X=X_"^ABPVEEC0"
DO @X
+19 QUIT
