ABPAOCS0 ;PRIV-INS OPEN CLAIMS SUMMARY;[ 05/23/91 4:44 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)="OPEN 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)=""
;---------------------------------------------------------------------
DEVICE ;PROCEDURE TO PROCESS OUTPUT DEVICE SELECTION
K %IS S %IS="H",%IS("A")="Use which device: " W ! D ^%ZIS U IO
;--------------------------------------------------------------------
;PROCEDURE TO PROCESS OPEN CLAIMS
D ^ABPAOCS1
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))
I IO=IO(0) D:+ABPAI>1 CONT
W:IO'=IO(0) @IOF X ^%ZIS("C")
S ABPAMESS="End of display...press any key to continue" W !
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&(IO=IO(0)) D CONT Q:$D(QFLG)=1 D ^ABPAOCS1
W:$Y>55 @IOF Q
;---------------------------------------------------------------------
CONT ;PROCEDURE TO PAUSE DISPLAY AND PROCESS ACTION REQUEST
W !,"Press 'RETURN' to Cont., Enter 'List Number' for Claim "
R "Detail 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 D ^ABPADETC
.S $P(ABPAX,"=",80)="" D ^ABPAOCS1
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
ABPAOCS0 ;PRIV-INS OPEN CLAIMS SUMMARY;[ 05/23/91 4:44 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)="OPEN 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)=""
+8 ;---------------------------------------------------------------------
DEVICE ;PROCEDURE TO PROCESS OUTPUT DEVICE SELECTION
+1 KILL %IS
SET %IS="H"
SET %IS("A")="Use which device: "
WRITE !
DO ^%ZIS
USE IO
+2 ;--------------------------------------------------------------------
+3 ;PROCEDURE TO PROCESS OPEN CLAIMS
+4 DO ^ABPAOCS1
+5 SET ABPAC=0
FOR ABPAI=1:1
Begin DoDot:1
+6 SET ABPAC=$ORDER(^ABPVAO("CS","O",ABPATDFN,ABPAC))
End DoDot:1
IF +ABPAC=0
QUIT
KILL QFLG
DO DT3
IF $DATA(QFLG)=1
QUIT
+7 IF IO=IO(0)
IF +ABPAI>1
DO CONT
+8 IF IO'=IO(0)
WRITE @IOF
XECUTE ^%ZIS("C")
+9 SET ABPAMESS="End of display...press any key to continue"
WRITE !
+10 DO PAUSE^ABPAMAIN
GOTO PAT
+11 ;--------------------------------------------------------------------
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&(IO=IO(0))
DO CONT
IF $DATA(QFLG)=1
QUIT
DO ^ABPAOCS1
+20 IF $Y>55
WRITE @IOF
QUIT
+21 ;---------------------------------------------------------------------
CONT ;PROCEDURE TO PAUSE DISPLAY AND PROCESS ACTION REQUEST
+1 WRITE !,"Press 'RETURN' to Cont., Enter 'List Number' for Claim "
+2 READ "Detail 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
DO ^ABPADETC
+8 SET $PIECE(ABPAX,"=",80)=""
DO ^ABPAOCS1
End DoDot:1
+9 QUIT
+10 ;---------------------------------------------------------------------
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
