- ABPVEEC3 ;ENTER/EDIT PVT INS CLAIMS; [ 07/16/91 9:01 AM ]
- ;;2.0;FACILITY PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 1991
- W !!,"NOT AN ENTRY POINT!",!! Q
- ;---------------------------------------------------------------------
- DOS D REVON^ABPVEEC0 W "Enter/Select billing date"
- W:$D(ABPVRON)=1 @(ABPVROFF)
- S ABPVDOS=$O(^ABPVFAC("PC",ABPVPDFN,"")) I +ABPVDOS=0 G GETDOS
- S ABPVDOS=0,ABPVCNT=10000 F I=0:0 D Q:+ABPVDOS=0
- .S ABPVDOS=$O(^ABPVFAC("PC",ABPVPDFN,ABPVDOS)) Q:+ABPVDOS=0
- .S DA=0 F J=0:0 D Q:+DA=0
- ..S DA=$O(^ABPVFAC("PC",ABPVPDFN,ABPVDOS,DA)) Q:+DA=0
- ..Q:$D(^ABPVFAC(DA,0))'=1 S DATA=^(0),ABPVCNT=ABPVCNT-1
- ..S ABPVDT(ABPVCNT)=$J($P(DATA,"^"),7)_" "
- ..S ABPVDT(ABPVCNT)=ABPVDT(ABPVCNT)_$E(ABPVDOS,4,5)_"/"_$E(ABPVDOS,6,7)_"/"
- ..S ABPVDT(ABPVCNT)=ABPVDT(ABPVCNT)_$E(ABPVDOS,2,3)_$J($P(DATA,"^",6),5)
- ..S ABPVDT(ABPVCNT)=ABPVDT(ABPVCNT)_$J($P(DATA,"^",7),5)
- ..S ABPVDT(ABPVCNT)=ABPVDT(ABPVCNT)_$J($P(^AUTNINS($P(DATA,"^",8),0),"^"),33)
- ..S ABPVDT(ABPVCNT)=ABPVDT(ABPVCNT)_$J($P(DATA,"^",9),8,2)
- G:+ABPVCNT=10000 GETDOS S CT=0
- W !?6,"BILL ID DOS TYP D/V INSURER "
- W " AMT",!?6,"------- -------- --- --- "
- W "------------------------------ -----"
- F CNT=1:1 S CT=$O(ABPVDT(CT)) Q:+CT=0 S ABPVDATE(CNT)=ABPVDT(CT)
- S CNT=CNT-1 K ABPVDT S (CT,I,II)=0
- NXTCT S DN=I+1 F I=I+1:1:II+3 S CT=$O(ABPVDATE(CT)) Q:+CT=0 D
- .W ! W $J(CT,2),".",?6,ABPVDATE(CT)
- S:I=CNT CT="",I=I+1 S:+CT=0 I=I-1 S (D1,II)=I
- SELECT W !,"CHOOSE " S:+CT=0 DN=1 W DN,"-",D1 W:+CT'=0 " or '^' TO STOP"
- W ": " R X:DTIME
- I X["^" G GETDOS
- I X="" G:+CT=0 GETDOS G NXTCT
- I X<1 G:+CT=0 GETDOS G NXTCT
- I $D(ABPVDATE(X))=0 W *7," ??" G SELECT
- S ABPVDOS=$E(ABPVDATE(+X),10,17),ABPVCDFN=$E(ABPVDATE(+X),1,7)
- F ABPVI=0:0 Q:$E(ABPVCDFN,1)'=" " S ABPVCDFN=$E(ABPVCDFN,2,7)
- K DIC S DIC="^ABPVFAC(",DIC(0)="QM",X=ABPVCDFN D ^DIC S DA=+Y
- I +Y'>0 W *7," ??" K ABPVDOS G SELECT
- K ABPVDATE,CT,DN,D1,I,II S ABPVCDFN=DA,DATA=^ABPVFAC(ABPVCDFN,0)
- S ABPVTYPE=$P(DATA,"^",6),ABPVDV=$P(DATA,"^",7),ABPVINS=$P(DATA,"^",8)
- S:ABPVTYPE="O" ABPVTYPE="OUTPATIENT"
- S:ABPVTYPE="I" ABPVTYPE="INPATIENT (HOSPITAL ONLY)"
- S:ABPVTYPE="P" ABPVTYPE="INPATIENT (PHYSICIAN ONLY)"
- S:ABPVTYPE="D" ABPVTYPE="DENTAL"
- S ABPVINS=$P(^AUTNINS(ABPVINS,0),"^")
- S ABPVAMT=$P(DATA,"^",9),ABPVAMT="$"_$J(ABPVAMT,8,2)
- S ABPVTXFG=$P(DATA,"^",14),ABPVTXDT=$P(DATA,"^",15)
- S ABPVPHNM=$P(DATA,"^",16),ABPVPNUM=$P(DATA,"^",17) D SCREEN^ABPVEEC0
- Q
- GETDOS K DIR,ABPVDOS
- S DIR(0)="D",DIR("A")="Select DATE OF SERVICE" D ^DIR S ABPVDOS=+Y
- I +ABPVDOS'>0 K ABPVDOS Q
- I $D(^ABPVFAC("PC",ABPVPDFN,ABPVDOS))'=0 S NEW=0 D I 'NEW K ABPVDOS Q
- .K DIR S DIR(0)="Y",DIR("B")="N"
- .S DIR("A")="Claim already on file for this date - add another"
- .W *7 D ^DIR I Y S NEW=1
- S (DA,ABPVCDFN)=$P(^ABPVFAC(0),"^",3)
- F ABPVI=0:0 S DA=$O(^ABPVFAC(DA)) Q:+DA=0 S ABPVCDFN=DA
- S ABPVCDFN=ABPVCDFN+1 K DIC S DIC="^ABPVFAC(",DIC(0)="L"
- S X=ABPVCDFN_"A" D ^DIC K DIE,DA,DR I +Y<1 D K ABPVDOS Q
- .W *7,!?5,"<<< Sorry, file access denied >>>" H 3
- S DIE="^ABPVFAC(",DA=ABPVCDFN,DR="1////"_ABPVPDFN_";2////"_ABPVDOS
- S DR=DR_";3////"_DUZ(2)_";4////"_ABPVHRN_";4.03////"_ABPVPSSN
- S DR=DR_";11////"_DT_";16////N"
- D ^DIE S Y=ABPVDOS X ^DD("DD") S ABPVDOS=Y
- S ABPVTEXT=";;(4) ;Date of Service:;7;10;ABPVDOS"
- S X=$S($Y>23:"SCREEN",$Y'>23:"WRITE",1:"SCREEN")
- S X=X_"^ABPVEEC0" D @X
- Q
- ABPVEEC3 ;ENTER/EDIT PVT INS CLAIMS; [ 07/16/91 9:01 AM ]
- +1 ;;2.0;FACILITY PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 1991
- +2 WRITE !!,"NOT AN ENTRY POINT!",!!
- QUIT
- +3 ;---------------------------------------------------------------------
- DOS DO REVON^ABPVEEC0
- WRITE "Enter/Select billing date"
- +1 IF $DATA(ABPVRON)=1
- WRITE @(ABPVROFF)
- +2 SET ABPVDOS=$ORDER(^ABPVFAC("PC",ABPVPDFN,""))
- IF +ABPVDOS=0
- GOTO GETDOS
- +3 SET ABPVDOS=0
- SET ABPVCNT=10000
- FOR I=0:0
- Begin DoDot:1
- +4 SET ABPVDOS=$ORDER(^ABPVFAC("PC",ABPVPDFN,ABPVDOS))
- IF +ABPVDOS=0
- QUIT
- +5 SET DA=0
- FOR J=0:0
- Begin DoDot:2
- +6 SET DA=$ORDER(^ABPVFAC("PC",ABPVPDFN,ABPVDOS,DA))
- IF +DA=0
- QUIT
- +7 IF $DATA(^ABPVFAC(DA,0))'=1
- QUIT
- SET DATA=^(0)
- SET ABPVCNT=ABPVCNT-1
- +8 SET ABPVDT(ABPVCNT)=$JUSTIFY($PIECE(DATA,"^"),7)_" "
- +9 SET ABPVDT(ABPVCNT)=ABPVDT(ABPVCNT)_$EXTRACT(ABPVDOS,4,5)_"/"_$EXTRACT(ABPVDOS,6,7)_"/"
- +10 SET ABPVDT(ABPVCNT)=ABPVDT(ABPVCNT)_$EXTRACT(ABPVDOS,2,3)_$JUSTIFY($PIECE(DATA,"^",6),5)
- +11 SET ABPVDT(ABPVCNT)=ABPVDT(ABPVCNT)_$JUSTIFY($PIECE(DATA,"^",7),5)
- +12 SET ABPVDT(ABPVCNT)=ABPVDT(ABPVCNT)_$JUSTIFY($PIECE(^AUTNINS($PIECE(DATA,"^",8),0),"^"),33)
- +13 SET ABPVDT(ABPVCNT)=ABPVDT(ABPVCNT)_$JUSTIFY($PIECE(DATA,"^",9),8,2)
- End DoDot:2
- IF +DA=0
- QUIT
- End DoDot:1
- IF +ABPVDOS=0
- QUIT
- +14 IF +ABPVCNT=10000
- GOTO GETDOS
- SET CT=0
- +15 WRITE !?6,"BILL ID DOS TYP D/V INSURER "
- +16 WRITE " AMT",!?6,"------- -------- --- --- "
- +17 WRITE "------------------------------ -----"
- +18 FOR CNT=1:1
- SET CT=$ORDER(ABPVDT(CT))
- IF +CT=0
- QUIT
- SET ABPVDATE(CNT)=ABPVDT(CT)
- +19 SET CNT=CNT-1
- KILL ABPVDT
- SET (CT,I,II)=0
- NXTCT SET DN=I+1
- FOR I=I+1:1:II+3
- SET CT=$ORDER(ABPVDATE(CT))
- IF +CT=0
- QUIT
- Begin DoDot:1
- +1 WRITE !
- WRITE $JUSTIFY(CT,2),".",?6,ABPVDATE(CT)
- End DoDot:1
- +2 IF I=CNT
- SET CT=""
- SET I=I+1
- IF +CT=0
- SET I=I-1
- SET (D1,II)=I
- SELECT WRITE !,"CHOOSE "
- IF +CT=0
- SET DN=1
- WRITE DN,"-",D1
- IF +CT'=0
- WRITE " or '^' TO STOP"
- +1 WRITE ": "
- READ X:DTIME
- +2 IF X["^"
- GOTO GETDOS
- +3 IF X=""
- IF +CT=0
- GOTO GETDOS
- GOTO NXTCT
- +4 IF X<1
- IF +CT=0
- GOTO GETDOS
- GOTO NXTCT
- +5 IF $DATA(ABPVDATE(X))=0
- WRITE *7," ??"
- GOTO SELECT
- +6 SET ABPVDOS=$EXTRACT(ABPVDATE(+X),10,17)
- SET ABPVCDFN=$EXTRACT(ABPVDATE(+X),1,7)
- +7 FOR ABPVI=0:0
- IF $EXTRACT(ABPVCDFN,1)'=" "
- QUIT
- SET ABPVCDFN=$EXTRACT(ABPVCDFN,2,7)
- +8 KILL DIC
- SET DIC="^ABPVFAC("
- SET DIC(0)="QM"
- SET X=ABPVCDFN
- DO ^DIC
- SET DA=+Y
- +9 IF +Y'>0
- WRITE *7," ??"
- KILL ABPVDOS
- GOTO SELECT
- +10 KILL ABPVDATE,CT,DN,D1,I,II
- SET ABPVCDFN=DA
- SET DATA=^ABPVFAC(ABPVCDFN,0)
- +11 SET ABPVTYPE=$PIECE(DATA,"^",6)
- SET ABPVDV=$PIECE(DATA,"^",7)
- SET ABPVINS=$PIECE(DATA,"^",8)
- +12 IF ABPVTYPE="O"
- SET ABPVTYPE="OUTPATIENT"
- +13 IF ABPVTYPE="I"
- SET ABPVTYPE="INPATIENT (HOSPITAL ONLY)"
- +14 IF ABPVTYPE="P"
- SET ABPVTYPE="INPATIENT (PHYSICIAN ONLY)"
- +15 IF ABPVTYPE="D"
- SET ABPVTYPE="DENTAL"
- +16 SET ABPVINS=$PIECE(^AUTNINS(ABPVINS,0),"^")
- +17 SET ABPVAMT=$PIECE(DATA,"^",9)
- SET ABPVAMT="$"_$JUSTIFY(ABPVAMT,8,2)
- +18 SET ABPVTXFG=$PIECE(DATA,"^",14)
- SET ABPVTXDT=$PIECE(DATA,"^",15)
- +19 SET ABPVPHNM=$PIECE(DATA,"^",16)
- SET ABPVPNUM=$PIECE(DATA,"^",17)
- DO SCREEN^ABPVEEC0
- +20 QUIT
- GETDOS KILL DIR,ABPVDOS
- +1 SET DIR(0)="D"
- SET DIR("A")="Select DATE OF SERVICE"
- DO ^DIR
- SET ABPVDOS=+Y
- +2 IF +ABPVDOS'>0
- KILL ABPVDOS
- QUIT
- +3 IF $DATA(^ABPVFAC("PC",ABPVPDFN,ABPVDOS))'=0
- SET NEW=0
- Begin DoDot:1
- +4 KILL DIR
- SET DIR(0)="Y"
- SET DIR("B")="N"
- +5 SET DIR("A")="Claim already on file for this date - add another"
- +6 WRITE *7
- DO ^DIR
- IF Y
- SET NEW=1
- End DoDot:1
- IF 'NEW
- KILL ABPVDOS
- QUIT
- +7 SET (DA,ABPVCDFN)=$PIECE(^ABPVFAC(0),"^",3)
- +8 FOR ABPVI=0:0
- SET DA=$ORDER(^ABPVFAC(DA))
- IF +DA=0
- QUIT
- SET ABPVCDFN=DA
- +9 SET ABPVCDFN=ABPVCDFN+1
- KILL DIC
- SET DIC="^ABPVFAC("
- SET DIC(0)="L"
- +10 SET X=ABPVCDFN_"A"
- DO ^DIC
- KILL DIE,DA,DR
- IF +Y<1
- Begin DoDot:1
- +11 WRITE *7,!?5,"<<< Sorry, file access denied >>>"
- HANG 3
- End DoDot:1
- KILL ABPVDOS
- QUIT
- +12 SET DIE="^ABPVFAC("
- SET DA=ABPVCDFN
- SET DR="1////"_ABPVPDFN_";2////"_ABPVDOS
- +13 SET DR=DR_";3////"_DUZ(2)_";4////"_ABPVHRN_";4.03////"_ABPVPSSN
- +14 SET DR=DR_";11////"_DT_";16////N"
- +15 DO ^DIE
- SET Y=ABPVDOS
- XECUTE ^DD("DD")
- SET ABPVDOS=Y
- +16 SET ABPVTEXT=";;(4) ;Date of Service:;7;10;ABPVDOS"
- +17 SET X=$SELECT($Y>23:"SCREEN",$Y'>23:"WRITE",1:"SCREEN")
- +18 SET X=X_"^ABPVEEC0"
- DO @X
- +19 QUIT
