ABPAEEC0 ;ENTER/EDIT PVT INS CLAIMS; [ 07/09/91 11:19 AM ]
;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
Q ;;NOT AN ENTRY POINT
WRITE F ABPAJ=3:1 Q:$P(ABPATEXT,";",ABPAJ)="" D
.S @("P"_ABPAJ)=$P(ABPATEXT,";",ABPAJ)
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=19 W ! X XY D EOP^ABPAMAIN W:IOST["QUME" !
W:$D(ABPARON) @(ABPARON)
Q
;
START D XIT S $P(ABPAL,"-",79)="",$P(ABPALL,"=",79)="" D SCREEN
D PAT I $D(ABPATDFN)'=1 D XIT Q
D DOS G:$D(ABPADOS)'=1 START G:$D(ABPAAMT)=1 EDIT^ABPAEEC1
D THEREST
CONT G EDIT^ABPAEEC1
;
SCREEN S ABPA("HD",1)=ABPATLE
S ABPA("HD",2)="ENTER/EDIT CLAIM DATA" D ^ABPAHD
F ABPAI=1:1 S ABPATEXT=$T(PROMPT+ABPAI) Q:ABPATEXT="" D WRITE
W !,ABPALL
Q
;
PAT D REVON W "Enter the NAME of the patient (format = LNAME,FNAME MI.)"
W:$D(ABPARON)=1 @(ABPAROFF)
S ABPAPTN="" D ^ABPAPATL
Q:$D(ABPATDFN)'=1 I +ABPATDFN'>0 D SCREEN G PAT
S ABPAPNAM=ABPAPAT,ABPAHRN=$P(^ABPVAO(ABPATDFN,0),"^",3)
S ABPAFAC=$P(^DIC(4,$P(^ABPVAO(ABPATDFN,0),"^",2),0),"^")
L ^ABPVAO(ABPATDFN):3 I '$T D H 3 G PAT
.W *7,!!?5,"<<< PATIENT RECORD UNAVAILABLE AT THIS TIME -- "
.W "TRY AGAIN LATER >>>"
D:$Y>3 SCREEN F ABPAI=1:1:3 S ABPATEXT=$T(PROMPT+ABPAI) D WRITE
Q
;
DOS K DIC,DIE,DA,DR,X,Y
S DA(1)=+ABPATDFN,DIC="^ABPVAO("_DA(1)_",1,",DIC(0)="AELQZ"
I $D(^ABPVAO(DA(1),1,0))'=1 D
.S ^ABPVAO(DA(1),1,0)="^9002270.21ID^^0"
S DIC("A")="DATE: " D REVON W "Enter the DATE OF SERVICE being billed"
W:$D(ABPARON)=1 @(ABPAROFF) D ^DIC Q:+Y<1 S ABPACDFN=+Y,ABPADOS=Y(0,0)
I +$P(Y,"^",3)<1 D Q
.S ABPATYPE=$P(Y(0),"^",4) S:ABPATYPE="O" ABPATYPE="OUTPATIENT"
.S:ABPATYPE="I" ABPATYPE="INPATIENT (HOSPITAL ONLY)"
.S:ABPATYPE="P" ABPATYPE="INPATIENT (PHYSICIAN ONLY)"
.S:ABPATYPE="D" ABPATYPE="DENTAL" S ABPADV=$P(Y(0),"^",5)
.S ABPAINS=$P(Y(0),"^",6),ABPAINS=$P(^AUTNINS(ABPAINS,0),"^")
.S ABPAAMT="$"_$J($P(Y(0),"^",7),8,2),ABPAPHNM=$P(Y(0),"^",8)
.S ABPAPNUM=$P(Y(0),"^",9) D:$Y>3 SCREEN
.F ABPAI=4:1:8 S ABPATEXT=$T(PROMPT+ABPAI) D WRITE
D:$Y>3 SCREEN S ABPATEXT=$T(PROMPT+4) D WRITE
Q
;
THEREST F ABPAK=5:1:9 K DIC,DIE,DA,DR,X,Y D
.S LBL="FLD"_+ABPAK_"^ABPAEEC1" D @LBL
K DIC,DIE,DA,DR,X,Y
S DA(1)=+ABPATDFN,DA=+ABPACDFN,DIE="^ABPVAO("_DA(1)_",1,"
F ABPACN=DT_1:1 Q:$D(^ABPVAO("CN",ABPACN))=0
S DR=".02////"_ABPACN_";.18///OPEN" D ^DIE
Q
;
XIT L
K ABPA,ABPAI,ABPAJ,DIC,X,Y,ABPATDFN,ABPAPNAM,ABPAHRN,ABPAL,ABPALL
K ABPAFAC,ABPATYPE,ABPAINS,ABPADV,ABPAAMT,ABPADOS,ABPAK,ABPACN,DTOUT
K DFOUT,DUOUT,DQOUT,DLOUT,ABPAPHNM,ABPAPNUM
Q
;
PROMPT ;;FLD #;TITLE;X-POSITION;Y-POSITION;VARIABLE NAME
;;(1) ;Patient Name:;7;8;ABPAPNAM
;;(2) ;Facility:;7;9;ABPAFAC
;;(3) ;Health Record Number:;7;10;ABPAHRN
;;(4) ;Date of Service:;7;11;ABPADOS
;;(5) ;Visit Type:;7;12;ABPATYPE
;;(6) ;Days or Visits:;7;13;ABPADV
;;(7) ;Insurance Company:;7;14;ABPAINS
;; (a);Policy Holder Name:;7;15;ABPAPHNM
;; (b);Policy Number:;7;16;ABPAPNUM
;;(8) ;Claim Amount:;7;17;ABPAAMT
ABPAEEC0 ;ENTER/EDIT PVT INS CLAIMS; [ 07/09/91 11:19 AM ]
+1 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
+2 ;;NOT AN ENTRY POINT
QUIT
WRITE FOR ABPAJ=3:1
IF $PIECE(ABPATEXT,";",ABPAJ)=""
QUIT
Begin DoDot:1
+1 SET @("P"_ABPAJ)=$PIECE(ABPATEXT,";",ABPAJ)
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
+5 ;
REVON SET DX=0
SET DY=19
WRITE !
XECUTE XY
DO EOP^ABPAMAIN
IF IOST["QUME"
WRITE !
+1 IF $DATA(ABPARON)
WRITE @(ABPARON)
+2 QUIT
+3 ;
START DO XIT
SET $PIECE(ABPAL,"-",79)=""
SET $PIECE(ABPALL,"=",79)=""
DO SCREEN
+1 DO PAT
IF $DATA(ABPATDFN)'=1
DO XIT
QUIT
+2 DO DOS
IF $DATA(ABPADOS)'=1
GOTO START
IF $DATA(ABPAAMT)=1
GOTO EDIT^ABPAEEC1
+3 DO THEREST
CONT GOTO EDIT^ABPAEEC1
+1 ;
SCREEN SET ABPA("HD",1)=ABPATLE
+1 SET ABPA("HD",2)="ENTER/EDIT CLAIM DATA"
DO ^ABPAHD
+2 FOR ABPAI=1:1
SET ABPATEXT=$TEXT(PROMPT+ABPAI)
IF ABPATEXT=""
QUIT
DO WRITE
+3 WRITE !,ABPALL
+4 QUIT
+5 ;
PAT DO REVON
WRITE "Enter the NAME of the patient (format = LNAME,FNAME MI.)"
+1 IF $DATA(ABPARON)=1
WRITE @(ABPAROFF)
+2 SET ABPAPTN=""
DO ^ABPAPATL
+3 IF $DATA(ABPATDFN)'=1
QUIT
IF +ABPATDFN'>0
DO SCREEN
GOTO PAT
+4 SET ABPAPNAM=ABPAPAT
SET ABPAHRN=$PIECE(^ABPVAO(ABPATDFN,0),"^",3)
+5 SET ABPAFAC=$PIECE(^DIC(4,$PIECE(^ABPVAO(ABPATDFN,0),"^",2),0),"^")
+6 LOCK ^ABPVAO(ABPATDFN):3
IF '$TEST
Begin DoDot:1
+7 WRITE *7,!!?5,"<<< PATIENT RECORD UNAVAILABLE AT THIS TIME -- "
+8 WRITE "TRY AGAIN LATER >>>"
End DoDot:1
HANG 3
GOTO PAT
+9 IF $Y>3
DO SCREEN
FOR ABPAI=1:1:3
SET ABPATEXT=$TEXT(PROMPT+ABPAI)
DO WRITE
+10 QUIT
+11 ;
DOS KILL DIC,DIE,DA,DR,X,Y
+1 SET DA(1)=+ABPATDFN
SET DIC="^ABPVAO("_DA(1)_",1,"
SET DIC(0)="AELQZ"
+2 IF $DATA(^ABPVAO(DA(1),1,0))'=1
Begin DoDot:1
+3 SET ^ABPVAO(DA(1),1,0)="^9002270.21ID^^0"
End DoDot:1
+4 SET DIC("A")="DATE: "
DO REVON
WRITE "Enter the DATE OF SERVICE being billed"
+5 IF $DATA(ABPARON)=1
WRITE @(ABPAROFF)
DO ^DIC
IF +Y<1
QUIT
SET ABPACDFN=+Y
SET ABPADOS=Y(0,0)
+6 IF +$PIECE(Y,"^",3)<1
Begin DoDot:1
+7 SET ABPATYPE=$PIECE(Y(0),"^",4)
IF ABPATYPE="O"
SET ABPATYPE="OUTPATIENT"
+8 IF ABPATYPE="I"
SET ABPATYPE="INPATIENT (HOSPITAL ONLY)"
+9 IF ABPATYPE="P"
SET ABPATYPE="INPATIENT (PHYSICIAN ONLY)"
+10 IF ABPATYPE="D"
SET ABPATYPE="DENTAL"
SET ABPADV=$PIECE(Y(0),"^",5)
+11 SET ABPAINS=$PIECE(Y(0),"^",6)
SET ABPAINS=$PIECE(^AUTNINS(ABPAINS,0),"^")
+12 SET ABPAAMT="$"_$JUSTIFY($PIECE(Y(0),"^",7),8,2)
SET ABPAPHNM=$PIECE(Y(0),"^",8)
+13 SET ABPAPNUM=$PIECE(Y(0),"^",9)
IF $Y>3
DO SCREEN
+14 FOR ABPAI=4:1:8
SET ABPATEXT=$TEXT(PROMPT+ABPAI)
DO WRITE
End DoDot:1
QUIT
+15 IF $Y>3
DO SCREEN
SET ABPATEXT=$TEXT(PROMPT+4)
DO WRITE
+16 QUIT
+17 ;
THEREST FOR ABPAK=5:1:9
KILL DIC,DIE,DA,DR,X,Y
Begin DoDot:1
+1 SET LBL="FLD"_+ABPAK_"^ABPAEEC1"
DO @LBL
End DoDot:1
+2 KILL DIC,DIE,DA,DR,X,Y
+3 SET DA(1)=+ABPATDFN
SET DA=+ABPACDFN
SET DIE="^ABPVAO("_DA(1)_",1,"
+4 FOR ABPACN=DT_1:1
IF $DATA(^ABPVAO("CN",ABPACN))=0
QUIT
+5 SET DR=".02////"_ABPACN_";.18///OPEN"
DO ^DIE
+6 QUIT
+7 ;
XIT LOCK
+1 KILL ABPA,ABPAI,ABPAJ,DIC,X,Y,ABPATDFN,ABPAPNAM,ABPAHRN,ABPAL,ABPALL
+2 KILL ABPAFAC,ABPATYPE,ABPAINS,ABPADV,ABPAAMT,ABPADOS,ABPAK,ABPACN,DTOUT
+3 KILL DFOUT,DUOUT,DQOUT,DLOUT,ABPAPHNM,ABPAPNUM
+4 QUIT
+5 ;
PROMPT ;;FLD #;TITLE;X-POSITION;Y-POSITION;VARIABLE NAME
+1 ;;(1) ;Patient Name:;7;8;ABPAPNAM
+2 ;;(2) ;Facility:;7;9;ABPAFAC
+3 ;;(3) ;Health Record Number:;7;10;ABPAHRN
+4 ;;(4) ;Date of Service:;7;11;ABPADOS
+5 ;;(5) ;Visit Type:;7;12;ABPATYPE
+6 ;;(6) ;Days or Visits:;7;13;ABPADV
+7 ;;(7) ;Insurance Company:;7;14;ABPAINS
+8 ;; (a);Policy Holder Name:;7;15;ABPAPHNM
+9 ;; (b);Policy Number:;7;16;ABPAPNUM
+10 ;;(8) ;Claim Amount:;7;17;ABPAAMT
