- 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
