ABPAALK1 ;PRIV-INS ACCOUNT DISPLAY UTILITY; [ 05/22/91 12:37 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)="Display ALL Patient TRANSACTIONS" D ^ABPAHD
W !! D ^ABPAPATL I $D(ABPATDFN)'=1 D XIT Q
I +ABPATDFN<1 G PAT
;---------------------------------------------------------------------
DEVICE ;PROCEDURE TO PROCESS OUTPUT DEVICE SELECTION
K %IS S %IS="H",%IS("A")="Use which device: " W ! D ^%ZIS U IO
;---------------------------------------------------------------------
I IO'=IO(0) U IO(0) W ! D WAIT^DICD U IO
DT0 S $P(ABPAX,"=",80)="",ABPAHRN=$P(^ABPVAO(ABPATDFN,0),"^",3)
S ABPAL=$E($P(^DIC(4,$P(^ABPVAO(DA,0),U,2),0),U),1,25)
S $P(ABPAXX,"-",80)="" D ^ABPAALK3 S ABPAC=0
OPEN F ABPAI=1:1 D Q:+ABPAC=0 K QFLG D DT3 G:$D(QFLG)=1 ENDLST
.S ABPAC=$O(^ABPVAO("CS","O",ABPATDFN,ABPAC)) Q:+ABPAC=0
S ABPAC=0
PENDING F ABPAI=ABPAI:1 D Q:+ABPAC=0 K QFLG D DT3 G:$D(QFLG)=1 ENDLST
.S ABPAC=$O(^ABPVAO("CS","PE",ABPATDFN,ABPAC)) Q:+ABPAC=0
S ABPAC=0
PAID D ^ABPAALK2
G ENDLST
;
DT3 S Y=^ABPVAO(DA,1,ABPAC,0),ABPA(ABPAI)=+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:"??????")
LOOP 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
CONT I $Y>21&(IO=IO(0)) D Q:$D(QFLG)=1 D ^ABPAALK3
.R !,?20,"< Press 'RETURN' to Continue, or '^' to Exit >",X:300
.S:'$T!(X="^") QFLG=""
I $Y>55 W @IOF
Q
;
ENDLST W:IO'=IO(0) @IOF X ^%ZIS("C")
W ! S ABPAMESS="End of display...press any key to continue"
D PAUSE^ABPAMAIN G PAT
;
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
END K ABPAC,ABPAI,ABPAXX,ABPAINS,DIE,DR,%DT,ABPAX,ABPAZ,ABPAPDT,QFLG Q
ABPAALK1 ;PRIV-INS ACCOUNT DISPLAY UTILITY; [ 05/22/91 12:37 PM ]
+1 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
PAT DO XIT
+1 SET ABPA("HD",1)=ABPATLE
+2 SET ABPA("HD",2)="Display ALL Patient TRANSACTIONS"
DO ^ABPAHD
+3 WRITE !!
DO ^ABPAPATL
IF $DATA(ABPATDFN)'=1
DO XIT
QUIT
+4 IF +ABPATDFN<1
GOTO PAT
+5 ;---------------------------------------------------------------------
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 IF IO'=IO(0)
USE IO(0)
WRITE !
DO WAIT^DICD
USE IO
DT0 SET $PIECE(ABPAX,"=",80)=""
SET ABPAHRN=$PIECE(^ABPVAO(ABPATDFN,0),"^",3)
+1 SET ABPAL=$EXTRACT($PIECE(^DIC(4,$PIECE(^ABPVAO(DA,0),U,2),0),U),1,25)
+2 SET $PIECE(ABPAXX,"-",80)=""
DO ^ABPAALK3
SET ABPAC=0
OPEN FOR ABPAI=1:1
Begin DoDot:1
+1 SET ABPAC=$ORDER(^ABPVAO("CS","O",ABPATDFN,ABPAC))
IF +ABPAC=0
QUIT
End DoDot:1
IF +ABPAC=0
QUIT
KILL QFLG
DO DT3
IF $DATA(QFLG)=1
GOTO ENDLST
+2 SET ABPAC=0
PENDING FOR ABPAI=ABPAI:1
Begin DoDot:1
+1 SET ABPAC=$ORDER(^ABPVAO("CS","PE",ABPATDFN,ABPAC))
IF +ABPAC=0
QUIT
End DoDot:1
IF +ABPAC=0
QUIT
KILL QFLG
DO DT3
IF $DATA(QFLG)=1
GOTO ENDLST
+2 SET ABPAC=0
PAID DO ^ABPAALK2
+1 GOTO ENDLST
+2 ;
DT3 SET Y=^ABPVAO(DA,1,ABPAC,0)
SET ABPA(ABPAI)=+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:"??????")
LOOP IF ABPASTAT="PA"!(ABPASTAT="C")
SET R=0
SET CNT=0
FOR I=1:1
Begin DoDot:1
+1 SET R=$ORDER(^ABPVAO(DA,"P",R))
IF +R=0
QUIT
SET RR=0
FOR I=1:1
Begin DoDot:2
+2 SET RR=$ORDER(^ABPVAO(DA,"P",R,"D",RR))
IF +RR=0
QUIT
+3 IF $DATA(^ABPVAO(DA,"P",R,"D",RR,0))'=1
QUIT
+4 IF +$PIECE(^ABPVAO(DA,"P",R,"D",RR,0),"^",2)'=+ABPAC
QUIT
+5 SET ABPAPDT=+^ABPVAO(DA,"P",R,0)
+6 SET ABPAPDT=$JUSTIFY((+$EXTRACT(ABPAPDT,4,5)_"/"_+$EXTRACT(ABPAPDT,6,7)_"/"_+$EXTRACT(ABPAPDT,2,3)),10)
+7 SET CNT=CNT+1
IF +CNT>1
WRITE !
WRITE ?50,ABPAPDT
SET RR=0
+8 SET RRR=0
FOR J=1:1
Begin DoDot:3
+9 SET RRR=$ORDER(^ABPVAO(DA,"P",R,"A",RRR))
IF +RRR=0
QUIT
+10 IF $DATA(^ABPVAO(DA,"P",R,"A",RRR,0))'=1
QUIT
+11 IF +J>1
WRITE !
WRITE ?62,$JUSTIFY(+^ABPVAO(DA,"P",R,"A",RRR,0),10,2)
+12 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
+13 KILL ABPA("STAT"),R,RR,CNT,I
CONT IF $Y>21&(IO=IO(0))
Begin DoDot:1
+1 READ !,?20,"< Press 'RETURN' to Continue, or '^' to Exit >",X:300
+2 IF '$TEST!(X="^")
SET QFLG=""
End DoDot:1
IF $DATA(QFLG)=1
QUIT
DO ^ABPAALK3
+3 IF $Y>55
WRITE @IOF
+4 QUIT
+5 ;
ENDLST IF IO'=IO(0)
WRITE @IOF
XECUTE ^%ZIS("C")
+1 WRITE !
SET ABPAMESS="End of display...press any key to continue"
+2 DO PAUSE^ABPAMAIN
GOTO PAT
+3 ;
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
END KILL ABPAC,ABPAI,ABPAXX,ABPAINS,DIE,DR,%DT,ABPAX,ABPAZ,ABPAPDT,QFLG
QUIT
