ABPVEEC2 ;DELETE PVT INS CLAIMS; [ 06/06/91 8:53 AM ]
;;2.0;FACILITY PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 1991
Q ;;NOT AN ENTRY POINT
WRITE F ABPVJ=3:1 Q:$P(ABPVTEXT,";",ABPVJ)="" D
.S @("P"_ABPVJ)=$P(ABPVTEXT,";",ABPVJ)
W ! S DX=P5,DY=P6 S:IOST["QUME" DY=DY+1 X XY W P3,$J(P4,22)
I $D(P7)=1 W " " W:$D(@P7)=1 @P7
Q
REVON S DX=0,DY=18 W ! X XY D EOP^ABPVZMM W:IOST["QUME" !
W:$D(ABPVRON) @(ABPVRON)
Q
INIT D XIT
S $P(ABPVL,"-",79)="",$P(ABPVLL,"=",79)=""
D SCREEN
Q
SCREEN S ABPV("HD",1)=ABPVTLE,ABPV("HD",2)="DELETE CLAIM"
I $D(ABPVCDFN)=1 D
.S ABPV("HD",2)=ABPV("HD",2)_" #"_$P(^ABPVFAC(ABPVCDFN,0),"^")
D ^ABPVHD
F ABPVI=1:1 S ABPVTEXT=$T(PROMPT+ABPVI) Q:ABPVTEXT="" D WRITE
W !,ABPVLL,!
Q
PAT D REVON W "Enter the NAME of the patient (format = LNAME,FNAME MI.)"
W:$D(ABPVRON)=1 @(ABPVROFF)
K DFN,DIC("S"),DIC("B")
S DIC="^AUPNPAT(",DIC(0)="AEQZ" D ^DIC
I +Y<1 Q
S Y(0,0)=^DPT(+Y,0),ABPVPDFN=+Y,ABPVPNAM=$P(Y(0,0),"^") K Y
S ABPVHRN="" I $D(^AUPNPAT(ABPVPDFN,41,DUZ(2),0))=1 D
.S ABPVHRN=$P(^AUPNPAT(ABPVPDFN,41,DUZ(2),0),"^",2)
S ABPVFAC=$P(^DIC(4,DUZ(2),0),"^") I $Y>23 D SCREEN Q
F ABPVI=1:1:3 S ABPVTEXT=$T(PROMPT+ABPVI) D WRITE
Q
DOS D REVON W "Enter/Select billing date"
W:$D(ABPVRON)=1 @(ABPVROFF)
S ABPVDOS=$O(^ABPVFAC("PC",ABPVPDFN,"")) I +ABPVDOS=0 K ABPVDOS Q
S ABPVDOS=0,ABPVCNT=10000 F I=0:0 D I +ABPVDOS=0 K ABPVDOS Q
.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)
Q:+ABPVCNT=10000 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["^" K ABPVDOS Q
I X="" Q:+CT=0 G NXTCT
I X<1 Q:+CT=0 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)
S DA=$O(^ABPVFAC("B",ABPVCDFN,"")) I $D(^ABPVFAC(DA,0))'=1 K ABPVDOS
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 ABPVTXFG=$P(DATA,"^",14),ABPVTXDT=$P(DATA,"^",15)
S ABPVPHNM=$P(DATA,"^",16),ABPVPNUM=$P(DATA,"^",17) D SCREEN
Q
DEL I ABPVTXDT D G XIT
.D REVON W *7,"Claim exported on "
.S Y=ABPVTXDT X ^DD("DD") W Y," - you cannot delete",@ABPVROFF
.D PAUSE^ABPVZMM
D REVON W "Delete claim #",$P(^ABPVFAC(ABPVCDFN,0),"^"),@ABPVROFF
K DIR S DIR("B")="NO",ABPVMESS=" ARE YOU SURE"
D YN^ABPVZMM K ABPVMESS S ABPVMESS="Nothing deleted!" I Y D
.W !,"...Deleting claim #",$P(^ABPVFAC(ABPVCDFN,0),"^"),"..."
.D WAIT^DICD K DIK,DA S DIK="^ABPVFAC(",DA=ABPVCDFN D ^DIK
.S ABPVMESS="Claim Deletion Completed!"
S ABPVMESS(2)="...Press any key to continue... " D PAUSE^ABPVZMM
;
XIT L
K ABPV,ABPVI,ABPVJ,DIC,X,Y,ABPVPDFN,ABPVPNAM,ABPVHRN,ABPVL,ABPVLL
K ABPVFAC,ABPVTYPE,ABPVINS,ABPVDV,ABPVAMT,ABPVDOS,ABPVK,ABPVCN,DTOUT
K DFOUT,DUOUT,DQOUT,DLOUT,P1,P2,P3,P4,P5,P6,P7,ABPVDATE,ABPVMESS,DIC
K DIE,DA,DR,DATA,DIR,YY,J,ABPVCDFN,ABPVTEXT,CNT,CT,II,LBL,ABPVTXFG
K ABPVTXDT,ABPVCNT,ABPVPHNM,ABPVPNUM
Q
;
MAIN D INIT,PAT I $D(ABPVPDFN)'=1 D XIT Q
D DOS G:$D(ABPVDOS)'=1 MAIN D DEL G MAIN
;
PROMPT ;;FLD #;TITLE;X-POSITION;Y-POSITION;VARIABLE NAME
;;(1) ;Patient Name:;7;7;ABPVPNAM
;;(2) ;Facility:;7;8;ABPVFAC
;;(3) ;Health Record Number:;7;9;ABPVHRN
;;(4) ;Date of Service:;7;10;ABPVDOS
;;(5) ;Visit Type:;7;11;ABPVTYPE
;;(6) ;Days or Visits:;7;12;ABPVDV
;;(7) ;Insurance Company:;7;13;ABPVINS
;; (a);Policy Holder Name:;7;14;ABPVPHNM
;; (b);Policy Number:;7;15;ABPVPNUM
;;(8) ;Claim Amount:;7;16;ABPVAMT
ABPVEEC2 ;DELETE PVT INS CLAIMS; [ 06/06/91 8:53 AM ]
+1 ;;2.0;FACILITY PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 1991
+2 ;;NOT AN ENTRY POINT
QUIT
WRITE FOR ABPVJ=3:1
IF $PIECE(ABPVTEXT,";",ABPVJ)=""
QUIT
Begin DoDot:1
+1 SET @("P"_ABPVJ)=$PIECE(ABPVTEXT,";",ABPVJ)
End DoDot:1
+2 WRITE !
SET DX=P5
SET DY=P6
IF IOST["QUME"
SET DY=DY+1
XECUTE XY
WRITE P3,$JUSTIFY(P4,22)
+3 IF $DATA(P7)=1
WRITE " "
IF $DATA(@P7)=1
WRITE @P7
+4 QUIT
REVON SET DX=0
SET DY=18
WRITE !
XECUTE XY
DO EOP^ABPVZMM
IF IOST["QUME"
WRITE !
+1 IF $DATA(ABPVRON)
WRITE @(ABPVRON)
+2 QUIT
INIT DO XIT
+1 SET $PIECE(ABPVL,"-",79)=""
SET $PIECE(ABPVLL,"=",79)=""
+2 DO SCREEN
+3 QUIT
SCREEN SET ABPV("HD",1)=ABPVTLE
SET ABPV("HD",2)="DELETE CLAIM"
+1 IF $DATA(ABPVCDFN)=1
Begin DoDot:1
+2 SET ABPV("HD",2)=ABPV("HD",2)_" #"_$PIECE(^ABPVFAC(ABPVCDFN,0),"^")
End DoDot:1
+3 DO ^ABPVHD
+4 FOR ABPVI=1:1
SET ABPVTEXT=$TEXT(PROMPT+ABPVI)
IF ABPVTEXT=""
QUIT
DO WRITE
+5 WRITE !,ABPVLL,!
+6 QUIT
PAT DO REVON
WRITE "Enter the NAME of the patient (format = LNAME,FNAME MI.)"
+1 IF $DATA(ABPVRON)=1
WRITE @(ABPVROFF)
+2 KILL DFN,DIC("S"),DIC("B")
+3 SET DIC="^AUPNPAT("
SET DIC(0)="AEQZ"
DO ^DIC
+4 IF +Y<1
QUIT
+5 SET Y(0,0)=^DPT(+Y,0)
SET ABPVPDFN=+Y
SET ABPVPNAM=$PIECE(Y(0,0),"^")
KILL Y
+6 SET ABPVHRN=""
IF $DATA(^AUPNPAT(ABPVPDFN,41,DUZ(2),0))=1
Begin DoDot:1
+7 SET ABPVHRN=$PIECE(^AUPNPAT(ABPVPDFN,41,DUZ(2),0),"^",2)
End DoDot:1
+8 SET ABPVFAC=$PIECE(^DIC(4,DUZ(2),0),"^")
IF $Y>23
DO SCREEN
QUIT
+9 FOR ABPVI=1:1:3
SET ABPVTEXT=$TEXT(PROMPT+ABPVI)
DO WRITE
+10 QUIT
DOS DO REVON
WRITE "Enter/Select billing date"
+1 IF $DATA(ABPVRON)=1
WRITE @(ABPVROFF)
+2 SET ABPVDOS=$ORDER(^ABPVFAC("PC",ABPVPDFN,""))
IF +ABPVDOS=0
KILL ABPVDOS
QUIT
+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
KILL ABPVDOS
QUIT
+14 IF +ABPVCNT=10000
QUIT
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["^"
KILL ABPVDOS
QUIT
+3 IF X=""
IF +CT=0
QUIT
GOTO NXTCT
+4 IF X<1
IF +CT=0
QUIT
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 SET DA=$ORDER(^ABPVFAC("B",ABPVCDFN,""))
IF $DATA(^ABPVFAC(DA,0))'=1
KILL ABPVDOS
+9 KILL ABPVDATE,CT,DN,D1,I,II
SET ABPVCDFN=DA
SET DATA=^ABPVFAC(ABPVCDFN,0)
+10 SET ABPVTYPE=$PIECE(DATA,"^",6)
SET ABPVDV=$PIECE(DATA,"^",7)
SET ABPVINS=$PIECE(DATA,"^",8)
+11 IF ABPVTYPE="O"
SET ABPVTYPE="OUTPATIENT"
+12 IF ABPVTYPE="I"
SET ABPVTYPE="INPATIENT (HOSPITAL ONLY)"
+13 IF ABPVTYPE="P"
SET ABPVTYPE="INPATIENT (PHYSICIAN ONLY)"
+14 IF ABPVTYPE="D"
SET ABPVTYPE="DENTAL"
+15 SET ABPVINS=$PIECE(^AUTNINS(ABPVINS,0),"^")
+16 SET ABPVAMT=$PIECE(DATA,"^",9)
SET ABPVAMT="$"_$JUSTIFY(ABPVAMT,8,2)
+17 SET ABPVTXFG=$PIECE(DATA,"^",14)
SET ABPVTXDT=$PIECE(DATA,"^",15)
+18 SET ABPVTXFG=$PIECE(DATA,"^",14)
SET ABPVTXDT=$PIECE(DATA,"^",15)
+19 SET ABPVPHNM=$PIECE(DATA,"^",16)
SET ABPVPNUM=$PIECE(DATA,"^",17)
DO SCREEN
+20 QUIT
DEL IF ABPVTXDT
Begin DoDot:1
+1 DO REVON
WRITE *7,"Claim exported on "
+2 SET Y=ABPVTXDT
XECUTE ^DD("DD")
WRITE Y," - you cannot delete",@ABPVROFF
+3 DO PAUSE^ABPVZMM
End DoDot:1
GOTO XIT
+4 DO REVON
WRITE "Delete claim #",$PIECE(^ABPVFAC(ABPVCDFN,0),"^"),@ABPVROFF
+5 KILL DIR
SET DIR("B")="NO"
SET ABPVMESS=" ARE YOU SURE"
+6 DO YN^ABPVZMM
KILL ABPVMESS
SET ABPVMESS="Nothing deleted!"
IF Y
Begin DoDot:1
+7 WRITE !,"...Deleting claim #",$PIECE(^ABPVFAC(ABPVCDFN,0),"^"),"..."
+8 DO WAIT^DICD
KILL DIK,DA
SET DIK="^ABPVFAC("
SET DA=ABPVCDFN
DO ^DIK
+9 SET ABPVMESS="Claim Deletion Completed!"
End DoDot:1
+10 SET ABPVMESS(2)="...Press any key to continue... "
DO PAUSE^ABPVZMM
+11 ;
XIT LOCK
+1 KILL ABPV,ABPVI,ABPVJ,DIC,X,Y,ABPVPDFN,ABPVPNAM,ABPVHRN,ABPVL,ABPVLL
+2 KILL ABPVFAC,ABPVTYPE,ABPVINS,ABPVDV,ABPVAMT,ABPVDOS,ABPVK,ABPVCN,DTOUT
+3 KILL DFOUT,DUOUT,DQOUT,DLOUT,P1,P2,P3,P4,P5,P6,P7,ABPVDATE,ABPVMESS,DIC
+4 KILL DIE,DA,DR,DATA,DIR,YY,J,ABPVCDFN,ABPVTEXT,CNT,CT,II,LBL,ABPVTXFG
+5 KILL ABPVTXDT,ABPVCNT,ABPVPHNM,ABPVPNUM
+6 QUIT
+7 ;
MAIN DO INIT
DO PAT
IF $DATA(ABPVPDFN)'=1
DO XIT
QUIT
+1 DO DOS
IF $DATA(ABPVDOS)'=1
GOTO MAIN
DO DEL
GOTO MAIN
+2 ;
PROMPT ;;FLD #;TITLE;X-POSITION;Y-POSITION;VARIABLE NAME
+1 ;;(1) ;Patient Name:;7;7;ABPVPNAM
+2 ;;(2) ;Facility:;7;8;ABPVFAC
+3 ;;(3) ;Health Record Number:;7;9;ABPVHRN
+4 ;;(4) ;Date of Service:;7;10;ABPVDOS
+5 ;;(5) ;Visit Type:;7;11;ABPVTYPE
+6 ;;(6) ;Days or Visits:;7;12;ABPVDV
+7 ;;(7) ;Insurance Company:;7;13;ABPVINS
+8 ;; (a);Policy Holder Name:;7;14;ABPVPHNM
+9 ;; (b);Policy Number:;7;15;ABPVPNUM
+10 ;;(8) ;Claim Amount:;7;16;ABPVAMT
