ABPACDF1 ;PRIV-INS DELETE OPEN CLAIM;[ 05/24/91 1:12 PM ]
;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
PAT D XIT S ABPA("HD",1)=ABPATLE
S ABPA("HD",2)="DELETE CLAIMS for a patient" D ^ABPAHD
W !! D ^ABPAPATL I $D(ABPATDFN)'=1 D XIT Q
I +ABPATDFN<1 G PAT
S $P(ABPAX,"=",80)="",ABPAHRN=$P(^ABPVAO(ABPATDFN,0),"^",3)
S ABPAFAC=$P(^ABPVAO(ABPATDFN,0),"^",2)
S ABPAL=$E($P(^DIC(4,$P(^ABPVAO(DA,0),U,2),0),U),1,25)
S $P(ABPAXX,"-",80)="" D ^ABPACDF2
;--------------------------------------------------------------------
;PROCEDURE TO PROCESS OPEN CLAIMS
S ABPAC=0 F ABPAI=1:1 D Q:+ABPAC=0 K QFLG D DT3 Q:$D(QFLG)=1
.S ABPAC=$O(^ABPVAO("CS","O",ABPATDFN,ABPAC))
S ABPAMESS="End of display...press any key to continue" W !
D:+ABPAI>1 CONT D PAUSE^ABPAMAIN G PAT
;--------------------------------------------------------------------
DT3 S Y=^ABPVAO(DA,1,ABPAC,0),ABPA(ABPAI,ABPAC)=+Y
S ABPAINS=$E($P(^AUTNINS($P(Y,U,6),0),U),1,15)
W !,$J(ABPAI,2),?5,$J("",14-$L(ABPAINS)\2)_ABPAINS,?22,$J((+$E(Y,4,5)_"/"_+$E(Y,6,7)_"/"_+$E(Y,2,3)),8),?33,$J($P(Y,U,7),8,2)
S ABPASTAT=$P(Y,"^",17)
W ?43,ABPASTAT,$S(ABPASTAT="C":"LOSED",ABPASTAT="D":"ENIED",ABPASTAT="PA":"ID",ABPASTAT="PE":"NDING",ABPASTAT="O":"PEN",1:"??????")
I ABPASTAT="PA"!(ABPASTAT="C") S R=0,CNT=0 F I=1:1 D Q:+R=0
.S R=$O(^ABPVAO(DA,"P",R)) Q:+R=0 S RR=0 F I=1:1 D Q:+RR=0
..S RR=$O(^ABPVAO(DA,"P",R,"D",RR)) Q:+RR=0
..Q:$D(^ABPVAO(DA,"P",R,"D",RR,0))'=1
..Q:+$P(^ABPVAO(DA,"P",R,"D",RR,0),"^",2)'=+ABPAC
..S ABPAPDT=+^ABPVAO(DA,"P",R,0)
..S ABPAPDT=$J((+$E(ABPAPDT,4,5)_"/"_+$E(ABPAPDT,6,7)_"/"_+$E(ABPAPDT,2,3)),10)
..S CNT=CNT+1 W:+CNT>1 ! W ?50,ABPAPDT S RR=0
..S RRR=0 F J=1:1 D Q:+RRR=0
...S RRR=$O(^ABPVAO(DA,"P",R,"A",RRR)) Q:+RRR=0
...Q:$D(^ABPVAO(DA,"P",R,"A",RRR,0))'=1
...W:+J>1 ! W ?62,$J(+^ABPVAO(DA,"P",R,"A",RRR,0),10,2)
...W " (",$P(^ABPVAO(DA,"P",R,"A",RRR,0),"^",2),")"
K ABPA("STAT"),R,RR,CNT,I
I $Y>21 D CONT Q:$D(QFLG)=1 D ^ABPAOCS1
Q
;---------------------------------------------------------------------
CONT ;PROCEDURE TO PAUSE DISPLAY AND PROCESS ACTION REQUEST
W !,"Press 'RETURN' to Cont., Select 'List Number' to Delete "
R "or '^' to Exit ",X:DTIME
I '$T!(X["^") S QFLG="" Q
I +X>0 D
.Q:$D(ABPA(+X))'=10 S ABPAC1=$O(ABPA(X,"")) Q:+ABPAC1=0
.Q:$D(^ABPVAO(ABPATDFN,1,+ABPAC1,0))'=1
.S D0=+ABPATDFN,ABPA("CDEL")="" D ^ABPADETC S QFLG=""
.K DIR S DIR(0)="Y",DIR("A")="Delete this claim - are you sure"
.K ABPA("CDEL") S DIR("B")="NO" W *7 D ^DIR I Y D
..K DIK,DA S DIK="^ABPVAO("_ABPATDFN_",1,",DA(1)=ABPATDFN,DA=ABPAC1
..D WAIT^DICD,^DIK K ABPAMESS S ABPAMESS="Claim Deletion Completed!"
..S ABPAMESS(2)="...Press any key to continue... " D PAUSE^ABPAMAIN
Q
;---------------------------------------------------------------------
XIT K ABPARECV,ABPAPD,ABPAENT,ABPADDFN,ABPATDFN,ABPADT,ABPADTD,ABPAPAT,D
K ABPA,ABPAL,DIC,C,ABPADT,ABPAQKS,ABPAQK,ABPAHRN,ABPARECV,DA,J,K,Z,XQH
K ABPAC,ABPAI,ABPAXX,ABPAINS,DIE,DR,%DT,ABPAX,ABPAZ,ABPAPDT,QFLG,YY,ZR
K ABPASTAT
Q
ABPACDF1 ;PRIV-INS DELETE OPEN CLAIM;[ 05/24/91 1:12 PM ]
+1 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
PAT DO XIT
SET ABPA("HD",1)=ABPATLE
+1 SET ABPA("HD",2)="DELETE CLAIMS for a patient"
DO ^ABPAHD
+2 WRITE !!
DO ^ABPAPATL
IF $DATA(ABPATDFN)'=1
DO XIT
QUIT
+3 IF +ABPATDFN<1
GOTO PAT
+4 SET $PIECE(ABPAX,"=",80)=""
SET ABPAHRN=$PIECE(^ABPVAO(ABPATDFN,0),"^",3)
+5 SET ABPAFAC=$PIECE(^ABPVAO(ABPATDFN,0),"^",2)
+6 SET ABPAL=$EXTRACT($PIECE(^DIC(4,$PIECE(^ABPVAO(DA,0),U,2),0),U),1,25)
+7 SET $PIECE(ABPAXX,"-",80)=""
DO ^ABPACDF2
+8 ;--------------------------------------------------------------------
+9 ;PROCEDURE TO PROCESS OPEN CLAIMS
+10 SET ABPAC=0
FOR ABPAI=1:1
Begin DoDot:1
+11 SET ABPAC=$ORDER(^ABPVAO("CS","O",ABPATDFN,ABPAC))
End DoDot:1
IF +ABPAC=0
QUIT
KILL QFLG
DO DT3
IF $DATA(QFLG)=1
QUIT
+12 SET ABPAMESS="End of display...press any key to continue"
WRITE !
+13 IF +ABPAI>1
DO CONT
DO PAUSE^ABPAMAIN
GOTO PAT
+14 ;--------------------------------------------------------------------
DT3 SET Y=^ABPVAO(DA,1,ABPAC,0)
SET ABPA(ABPAI,ABPAC)=+Y
+1 SET ABPAINS=$EXTRACT($PIECE(^AUTNINS($PIECE(Y,U,6),0),U),1,15)
+2 WRITE !,$JUSTIFY(ABPAI,2),?5,$JUSTIFY("",14-$LENGTH(ABPAINS)\2)_ABPAINS,?22,$JUSTIFY((+$EXTRACT(Y,4,5)_"/"_+$EXTRACT(Y,6,7)_"/"_+$EXTRACT(Y,2,3)),8),?33,$JUSTIFY($PIECE(Y,U,7),8,2)
+3 SET ABPASTAT=$PIECE(Y,"^",17)
+4 WRITE ?43,ABPASTAT,$SELECT(ABPASTAT="C":"LOSED",ABPASTAT="D":"ENIED",ABPASTAT="PA":"ID",ABPASTAT="PE":"NDING",ABPASTAT="O":"PEN",1:"??????")
+5 IF ABPASTAT="PA"!(ABPASTAT="C")
SET R=0
SET CNT=0
FOR I=1:1
Begin DoDot:1
+6 SET R=$ORDER(^ABPVAO(DA,"P",R))
IF +R=0
QUIT
SET RR=0
FOR I=1:1
Begin DoDot:2
+7 SET RR=$ORDER(^ABPVAO(DA,"P",R,"D",RR))
IF +RR=0
QUIT
+8 IF $DATA(^ABPVAO(DA,"P",R,"D",RR,0))'=1
QUIT
+9 IF +$PIECE(^ABPVAO(DA,"P",R,"D",RR,0),"^",2)'=+ABPAC
QUIT
+10 SET ABPAPDT=+^ABPVAO(DA,"P",R,0)
+11 SET ABPAPDT=$JUSTIFY((+$EXTRACT(ABPAPDT,4,5)_"/"_+$EXTRACT(ABPAPDT,6,7)_"/"_+$EXTRACT(ABPAPDT,2,3)),10)
+12 SET CNT=CNT+1
IF +CNT>1
WRITE !
WRITE ?50,ABPAPDT
SET RR=0
+13 SET RRR=0
FOR J=1:1
Begin DoDot:3
+14 SET RRR=$ORDER(^ABPVAO(DA,"P",R,"A",RRR))
IF +RRR=0
QUIT
+15 IF $DATA(^ABPVAO(DA,"P",R,"A",RRR,0))'=1
QUIT
+16 IF +J>1
WRITE !
WRITE ?62,$JUSTIFY(+^ABPVAO(DA,"P",R,"A",RRR,0),10,2)
+17 WRITE " (",$PIECE(^ABPVAO(DA,"P",R,"A",RRR,0),"^",2),")"
End DoDot:3
IF +RRR=0
QUIT
End DoDot:2
IF +RR=0
QUIT
End DoDot:1
IF +R=0
QUIT
+18 KILL ABPA("STAT"),R,RR,CNT,I
+19 IF $Y>21
DO CONT
IF $DATA(QFLG)=1
QUIT
DO ^ABPAOCS1
+20 QUIT
+21 ;---------------------------------------------------------------------
CONT ;PROCEDURE TO PAUSE DISPLAY AND PROCESS ACTION REQUEST
+1 WRITE !,"Press 'RETURN' to Cont., Select 'List Number' to Delete "
+2 READ "or '^' to Exit ",X:DTIME
+3 IF '$TEST!(X["^")
SET QFLG=""
QUIT
+4 IF +X>0
Begin DoDot:1
+5 IF $DATA(ABPA(+X))'=10
QUIT
SET ABPAC1=$ORDER(ABPA(X,""))
IF +ABPAC1=0
QUIT
+6 IF $DATA(^ABPVAO(ABPATDFN,1,+ABPAC1,0))'=1
QUIT
+7 SET D0=+ABPATDFN
SET ABPA("CDEL")=""
DO ^ABPADETC
SET QFLG=""
+8 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Delete this claim - are you sure"
+9 KILL ABPA("CDEL")
SET DIR("B")="NO"
WRITE *7
DO ^DIR
IF Y
Begin DoDot:2
+10 KILL DIK,DA
SET DIK="^ABPVAO("_ABPATDFN_",1,"
SET DA(1)=ABPATDFN
SET DA=ABPAC1
+11 DO WAIT^DICD
DO ^DIK
KILL ABPAMESS
SET ABPAMESS="Claim Deletion Completed!"
+12 SET ABPAMESS(2)="...Press any key to continue... "
DO PAUSE^ABPAMAIN
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;---------------------------------------------------------------------
XIT KILL ABPARECV,ABPAPD,ABPAENT,ABPADDFN,ABPATDFN,ABPADT,ABPADTD,ABPAPAT,D
+1 KILL ABPA,ABPAL,DIC,C,ABPADT,ABPAQKS,ABPAQK,ABPAHRN,ABPARECV,DA,J,K,Z,XQH
+2 KILL ABPAC,ABPAI,ABPAXX,ABPAINS,DIE,DR,%DT,ABPAX,ABPAZ,ABPAPDT,QFLG,YY,ZR
+3 KILL ABPASTAT
+4 QUIT
