- ABPVEEC0 ;ENTER/EDIT PVT INS CLAIMS; [ 06/06/91 8:33 AM ]
- ;;2.0;FACILITY PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 1991
- Q ;;NOT AN ENTRY POINT
- WRITE F ABPVJ=3:1 Q:$P(ABPVTEXT,";",ABPVJ)="" D
- .S @("P"_ABPVJ)=$P(ABPVTEXT,";",ABPVJ)
- 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=18 W ! X XY D EOP^ABPVZMM W:IOST["QUME" !
- W:$D(ABPVRON) @(ABPVRON)
- Q
- ;
- INIT D XIT
- S $P(ABPVL,"-",79)="",$P(ABPVLL,"=",79)=""
- D SCREEN
- Q
- ;
- SCREEN S ABPV("HD",1)=ABPVTLE,ABPV("HD",2)="Enter/Edit Claim"
- I $D(ABPVCDFN)=1 D
- .S ABPV("HD",2)=ABPV("HD",2)_" #"_$P(^ABPVFAC(ABPVCDFN,0),"^")
- D ^ABPVHD
- F ABPVI=1:1 S ABPVTEXT=$T(PROMPT+ABPVI) Q:ABPVTEXT="" D WRITE
- W !,ABPVLL,!
- Q
- ;
- PAT D REVON W "Enter the NAME of the patient (format = LNAME,FNAME MI.)"
- W:$D(ABPVRON)=1 @(ABPVROFF)
- K DFN,DIC("S"),DIC("B")
- S DIC="^AUPNPAT(",DIC(0)="AEQZ" D ^DIC I +Y<1 Q
- S Y(0,0)=^DPT(+Y,0),ABPVPDFN=+Y,ABPVPNAM=$P(Y(0,0),"^")
- S ABPVPSSN=$P(Y(0,0),"^",9) K Y
- S ABPVHRN="" I $D(^AUPNPAT(ABPVPDFN,41,DUZ(2),0))=1 D
- .S ABPVHRN=$P(^AUPNPAT(ABPVPDFN,41,DUZ(2),0),"^",2)
- S ABPVFAC=$P(^DIC(4,DUZ(2),0),"^") I $Y>23 D SCREEN Q
- F ABPVI=1:1:3 S ABPVTEXT=$T(PROMPT+ABPVI) D WRITE
- Q
- ;
- THEREST F ABPVK=5,7,8 D
- .K DIC,DIE,DA,DR,X,Y
- .S LBL="FLD"_+ABPVK_"^ABPVEEC1" D @LBL
- Q
- ;
- XIT L
- K ABPV,ABPVI,ABPVJ,DIC,X,Y,ABPVPDFN,ABPVPNAM,ABPVHRN,ABPVL,ABPVLL
- K ABPVFAC,ABPVTYPE,ABPVINS,ABPVDV,ABPVAMT,ABPVDOS,ABPVK,ABPVCN,DTOUT
- K DFOUT,DUOUT,DQOUT,DLOUT,P1,P2,P3,P4,P5,P6,P7,ABPVDATE,ABPVMESS,DIC
- K DIE,DA,DR,DATA,DIR,YY,J,ABPVCDFN,ABPVTEXT,CNT,CT,II,LBL,ABPVTXFG
- K ABPVTXDT,ABPVCNT,ABPVPHNM,ABPVPNUM,ABPVPSSN
- Q
- ;
- MAIN D INIT,PAT I $D(ABPVPDFN)'=1 D XIT Q
- D DOS^ABPVEEC3 G:$D(ABPVDOS)'=1 MAIN G:$D(ABPVAMT)=1 EDIT^ABPVEEC1
- D THEREST S ABPVTXFG="N",ABPVTXDT=""
- G EDIT^ABPVEEC1
- ;
- PROMPT ;;FLD #;TITLE;X-POSITION;Y-POSITION;VARIABLE NAME
- ;;(1) ;Patient Name:;7;7;ABPVPNAM
- ;;(2) ;Facility:;7;8;ABPVFAC
- ;;(3) ;Health Record Number:;7;9;ABPVHRN
- ;;(4) ;Date of Service:;7;10;ABPVDOS
- ;;(5) ;Visit Type:;7;11;ABPVTYPE
- ;;(6) ;Days or Visits:;7;12;ABPVDV
- ;;(7) ;Insurance Company:;7;13;ABPVINS
- ;; (a);Policy Holder Name:;7;14;ABPVPHNM
- ;; (b);Policy Number:;7;15;ABPVPNUM
- ;;(8) ;Claim Amount:;7;16;ABPVAMT
- ABPVEEC0 ;ENTER/EDIT PVT INS CLAIMS; [ 06/06/91 8:33 AM ]
- +1 ;;2.0;FACILITY PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 1991
- +2 ;;NOT AN ENTRY POINT
- QUIT
- WRITE FOR ABPVJ=3:1
- IF $PIECE(ABPVTEXT,";",ABPVJ)=""
- QUIT
- Begin DoDot:1
- +1 SET @("P"_ABPVJ)=$PIECE(ABPVTEXT,";",ABPVJ)
- 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=18
- WRITE !
- XECUTE XY
- DO EOP^ABPVZMM
- IF IOST["QUME"
- WRITE !
- +1 IF $DATA(ABPVRON)
- WRITE @(ABPVRON)
- +2 QUIT
- +3 ;
- INIT DO XIT
- +1 SET $PIECE(ABPVL,"-",79)=""
- SET $PIECE(ABPVLL,"=",79)=""
- +2 DO SCREEN
- +3 QUIT
- +4 ;
- SCREEN SET ABPV("HD",1)=ABPVTLE
- SET ABPV("HD",2)="Enter/Edit Claim"
- +1 IF $DATA(ABPVCDFN)=1
- Begin DoDot:1
- +2 SET ABPV("HD",2)=ABPV("HD",2)_" #"_$PIECE(^ABPVFAC(ABPVCDFN,0),"^")
- End DoDot:1
- +3 DO ^ABPVHD
- +4 FOR ABPVI=1:1
- SET ABPVTEXT=$TEXT(PROMPT+ABPVI)
- IF ABPVTEXT=""
- QUIT
- DO WRITE
- +5 WRITE !,ABPVLL,!
- +6 QUIT
- +7 ;
- PAT DO REVON
- WRITE "Enter the NAME of the patient (format = LNAME,FNAME MI.)"
- +1 IF $DATA(ABPVRON)=1
- WRITE @(ABPVROFF)
- +2 KILL DFN,DIC("S"),DIC("B")
- +3 SET DIC="^AUPNPAT("
- SET DIC(0)="AEQZ"
- DO ^DIC
- IF +Y<1
- QUIT
- +4 SET Y(0,0)=^DPT(+Y,0)
- SET ABPVPDFN=+Y
- SET ABPVPNAM=$PIECE(Y(0,0),"^")
- +5 SET ABPVPSSN=$PIECE(Y(0,0),"^",9)
- KILL Y
- +6 SET ABPVHRN=""
- IF $DATA(^AUPNPAT(ABPVPDFN,41,DUZ(2),0))=1
- Begin DoDot:1
- +7 SET ABPVHRN=$PIECE(^AUPNPAT(ABPVPDFN,41,DUZ(2),0),"^",2)
- End DoDot:1
- +8 SET ABPVFAC=$PIECE(^DIC(4,DUZ(2),0),"^")
- IF $Y>23
- DO SCREEN
- QUIT
- +9 FOR ABPVI=1:1:3
- SET ABPVTEXT=$TEXT(PROMPT+ABPVI)
- DO WRITE
- +10 QUIT
- +11 ;
- THEREST FOR ABPVK=5,7,8
- Begin DoDot:1
- +1 KILL DIC,DIE,DA,DR,X,Y
- +2 SET LBL="FLD"_+ABPVK_"^ABPVEEC1"
- DO @LBL
- End DoDot:1
- +3 QUIT
- +4 ;
- XIT LOCK
- +1 KILL ABPV,ABPVI,ABPVJ,DIC,X,Y,ABPVPDFN,ABPVPNAM,ABPVHRN,ABPVL,ABPVLL
- +2 KILL ABPVFAC,ABPVTYPE,ABPVINS,ABPVDV,ABPVAMT,ABPVDOS,ABPVK,ABPVCN,DTOUT
- +3 KILL DFOUT,DUOUT,DQOUT,DLOUT,P1,P2,P3,P4,P5,P6,P7,ABPVDATE,ABPVMESS,DIC
- +4 KILL DIE,DA,DR,DATA,DIR,YY,J,ABPVCDFN,ABPVTEXT,CNT,CT,II,LBL,ABPVTXFG
- +5 KILL ABPVTXDT,ABPVCNT,ABPVPHNM,ABPVPNUM,ABPVPSSN
- +6 QUIT
- +7 ;
- MAIN DO INIT
- DO PAT
- IF $DATA(ABPVPDFN)'=1
- DO XIT
- QUIT
- +1 DO DOS^ABPVEEC3
- IF $DATA(ABPVDOS)'=1
- GOTO MAIN
- IF $DATA(ABPVAMT)=1
- GOTO EDIT^ABPVEEC1
- +2 DO THEREST
- SET ABPVTXFG="N"
- SET ABPVTXDT=""
- +3 GOTO EDIT^ABPVEEC1
- +4 ;
- PROMPT ;;FLD #;TITLE;X-POSITION;Y-POSITION;VARIABLE NAME
- +1 ;;(1) ;Patient Name:;7;7;ABPVPNAM
- +2 ;;(2) ;Facility:;7;8;ABPVFAC
- +3 ;;(3) ;Health Record Number:;7;9;ABPVHRN
- +4 ;;(4) ;Date of Service:;7;10;ABPVDOS
- +5 ;;(5) ;Visit Type:;7;11;ABPVTYPE
- +6 ;;(6) ;Days or Visits:;7;12;ABPVDV
- +7 ;;(7) ;Insurance Company:;7;13;ABPVINS
- +8 ;; (a);Policy Holder Name:;7;14;ABPVPHNM
- +9 ;; (b);Policy Number:;7;15;ABPVPNUM
- +10 ;;(8) ;Claim Amount:;7;16;ABPVAMT
