Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABPVEEC2

ABPVEEC2.m

Go to the documentation of this file. 
  1. ABPVEEC2 ;DELETE PVT INS CLAIMS; [ 06/06/91  8:53 AM ]
  1.  ;;2.0;FACILITY PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 1991
  1.  Q  ;;NOT AN ENTRY POINT
  1. WRITE F ABPVJ=3:1 Q:$P(ABPVTEXT,";",ABPVJ)=""  D
  1.  .S @("P"_ABPVJ)=$P(ABPVTEXT,";",ABPVJ)
  1.  W ! S DX=P5,DY=P6 S:IOST["QUME" DY=DY+1 X XY W P3,$J(P4,22)
  1.  I $D(P7)=1 W " " W:$D(@P7)=1 @P7
  1.  Q
  1. REVON S DX=0,DY=18 W ! X XY D EOP^ABPVZMM W:IOST["QUME" !
  1.  W:$D(ABPVRON) @(ABPVRON)
  1.  Q
  1. INIT D XIT
  1.  S $P(ABPVL,"-",79)="",$P(ABPVLL,"=",79)=""
  1.  D SCREEN
  1.  Q
  1. SCREEN S ABPV("HD",1)=ABPVTLE,ABPV("HD",2)="DELETE CLAIM"
  1.  I $D(ABPVCDFN)=1 D
  1.  .S ABPV("HD",2)=ABPV("HD",2)_" #"_$P(^ABPVFAC(ABPVCDFN,0),"^")
  1.  D ^ABPVHD
  1.  F ABPVI=1:1 S ABPVTEXT=$T(PROMPT+ABPVI) Q:ABPVTEXT=""  D WRITE
  1.  W !,ABPVLL,!
  1.  Q
  1. PAT D REVON W "Enter the NAME of the patient (format = LNAME,FNAME MI.)"
  1.  W:$D(ABPVRON)=1 @(ABPVROFF)
  1.  K DFN,DIC("S"),DIC("B")
  1.  S DIC="^AUPNPAT(",DIC(0)="AEQZ" D ^DIC
  1.  I +Y<1 Q
  1.  S Y(0,0)=^DPT(+Y,0),ABPVPDFN=+Y,ABPVPNAM=$P(Y(0,0),"^") K Y
  1.  S ABPVHRN="" I $D(^AUPNPAT(ABPVPDFN,41,DUZ(2),0))=1 D
  1.  .S ABPVHRN=$P(^AUPNPAT(ABPVPDFN,41,DUZ(2),0),"^",2)
  1.  S ABPVFAC=$P(^DIC(4,DUZ(2),0),"^") I $Y>23 D SCREEN Q
  1.  F ABPVI=1:1:3 S ABPVTEXT=$T(PROMPT+ABPVI) D WRITE
  1.  Q
  1. DOS D REVON W "Enter/Select billing date"
  1.  W:$D(ABPVRON)=1 @(ABPVROFF)
  1.  S ABPVDOS=$O(^ABPVFAC("PC",ABPVPDFN,"")) I +ABPVDOS=0 K ABPVDOS Q
  1.  S ABPVDOS=0,ABPVCNT=10000 F I=0:0 D  I +ABPVDOS=0 K ABPVDOS Q
  1.  .S ABPVDOS=$O(^ABPVFAC("PC",ABPVPDFN,ABPVDOS)) Q:+ABPVDOS=0
  1.  .S DA=0 F J=0:0 D  Q:+DA=0
  1.  ..S DA=$O(^ABPVFAC("PC",ABPVPDFN,ABPVDOS,DA)) Q:+DA=0
  1.  ..Q:$D(^ABPVFAC(DA,0))'=1  S DATA=^(0),ABPVCNT=ABPVCNT-1
  1.  ..S ABPVDT(ABPVCNT)=$J($P(DATA,"^"),7)_"  "
  1.  ..S ABPVDT(ABPVCNT)=ABPVDT(ABPVCNT)_$E(ABPVDOS,4,5)_"/"_$E(ABPVDOS,6,7)_"/"
  1.  ..S ABPVDT(ABPVCNT)=ABPVDT(ABPVCNT)_$E(ABPVDOS,2,3)_$J($P(DATA,"^",6),5)
  1.  ..S ABPVDT(ABPVCNT)=ABPVDT(ABPVCNT)_$J($P(DATA,"^",7),5)
  1.  ..S ABPVDT(ABPVCNT)=ABPVDT(ABPVCNT)_$J($P(^AUTNINS($P(DATA,"^",8),0),"^"),33)
  1.  ..S ABPVDT(ABPVCNT)=ABPVDT(ABPVCNT)_$J($P(DATA,"^",9),8,2)
  1.  Q:+ABPVCNT=10000  S CT=0
  1.  W !?6,"BILL ID     DOS     TYP  D/V              INSURER    "
  1.  W "            AMT",!?6,"-------  --------   ---  ---  "
  1.  W "------------------------------   -----"
  1.  F CNT=1:1 S CT=$O(ABPVDT(CT)) Q:+CT=0  S ABPVDATE(CNT)=ABPVDT(CT)
  1.  S CNT=CNT-1 K ABPVDT S (CT,I,II)=0
  1. NXTCT S DN=I+1 F I=I+1:1:II+3 S CT=$O(ABPVDATE(CT)) Q:+CT=0  D
  1.  .W ! W $J(CT,2),".",?6,ABPVDATE(CT)
  1.  S:I=CNT CT="",I=I+1 S:+CT=0 I=I-1 S (D1,II)=I
  1. SELECT W !,"CHOOSE " S:+CT=0 DN=1 W DN,"-",D1 W:+CT'=0 " or '^' TO STOP"
  1.  W ": " R X:DTIME
  1.  I X["^" K ABPVDOS Q
  1.  I X="" Q:+CT=0  G NXTCT
  1.  I X<1 Q:+CT=0  G NXTCT
  1.  I $D(ABPVDATE(X))=0 W *7,"   ??" G SELECT
  1.  S ABPVDOS=$E(ABPVDATE(+X),10,17),ABPVCDFN=$E(ABPVDATE(+X),1,7)
  1.  F ABPVI=0:0 Q:$E(ABPVCDFN,1)'=" "  S ABPVCDFN=$E(ABPVCDFN,2,7)
  1.  S DA=$O(^ABPVFAC("B",ABPVCDFN,"")) I $D(^ABPVFAC(DA,0))'=1 K ABPVDOS
  1.  K ABPVDATE,CT,DN,D1,I,II S ABPVCDFN=DA,DATA=^ABPVFAC(ABPVCDFN,0)
  1.  S ABPVTYPE=$P(DATA,"^",6),ABPVDV=$P(DATA,"^",7),ABPVINS=$P(DATA,"^",8)
  1.  S:ABPVTYPE="O" ABPVTYPE="OUTPATIENT"
  1.  S:ABPVTYPE="I" ABPVTYPE="INPATIENT (HOSPITAL ONLY)"
  1.  S:ABPVTYPE="P" ABPVTYPE="INPATIENT (PHYSICIAN ONLY)"
  1.  S:ABPVTYPE="D" ABPVTYPE="DENTAL"
  1.  S ABPVINS=$P(^AUTNINS(ABPVINS,0),"^")
  1.  S ABPVAMT=$P(DATA,"^",9),ABPVAMT="$"_$J(ABPVAMT,8,2)
  1.  S ABPVTXFG=$P(DATA,"^",14),ABPVTXDT=$P(DATA,"^",15)
  1.  S ABPVTXFG=$P(DATA,"^",14),ABPVTXDT=$P(DATA,"^",15)
  1.  S ABPVPHNM=$P(DATA,"^",16),ABPVPNUM=$P(DATA,"^",17) D SCREEN
  1.  Q
  1. DEL I ABPVTXDT D  G XIT
  1.  .D REVON W *7,"Claim exported on "
  1.  .S Y=ABPVTXDT X ^DD("DD") W Y," - you cannot delete",@ABPVROFF
  1.  .D PAUSE^ABPVZMM
  1.  D REVON W "Delete claim #",$P(^ABPVFAC(ABPVCDFN,0),"^"),@ABPVROFF
  1.  K DIR S DIR("B")="NO",ABPVMESS="       ARE YOU SURE"
  1.  D YN^ABPVZMM K ABPVMESS S ABPVMESS="Nothing deleted!" I Y D
  1.  .W !,"...Deleting claim #",$P(^ABPVFAC(ABPVCDFN,0),"^"),"..."
  1.  .D WAIT^DICD K DIK,DA S DIK="^ABPVFAC(",DA=ABPVCDFN D ^DIK
  1.  .S ABPVMESS="Claim Deletion Completed!"
  1.  S ABPVMESS(2)="...Press any key to continue... " D PAUSE^ABPVZMM
  1.  ;
  1. XIT L
  1.  K ABPV,ABPVI,ABPVJ,DIC,X,Y,ABPVPDFN,ABPVPNAM,ABPVHRN,ABPVL,ABPVLL
  1.  K ABPVFAC,ABPVTYPE,ABPVINS,ABPVDV,ABPVAMT,ABPVDOS,ABPVK,ABPVCN,DTOUT
  1.  K DFOUT,DUOUT,DQOUT,DLOUT,P1,P2,P3,P4,P5,P6,P7,ABPVDATE,ABPVMESS,DIC
  1.  K DIE,DA,DR,DATA,DIR,YY,J,ABPVCDFN,ABPVTEXT,CNT,CT,II,LBL,ABPVTXFG
  1.  K ABPVTXDT,ABPVCNT,ABPVPHNM,ABPVPNUM
  1.  Q
  1.  ;
  1. MAIN D INIT,PAT I $D(ABPVPDFN)'=1 D XIT Q
  1.  D DOS G:$D(ABPVDOS)'=1 MAIN D DEL G MAIN
  1.  ;
  1. PROMPT ;;FLD #;TITLE;X-POSITION;Y-POSITION;VARIABLE NAME
  1.  ;;(1)   ;Patient Name:;7;7;ABPVPNAM
  1.  ;;(2)   ;Facility:;7;8;ABPVFAC
  1.  ;;(3)   ;Health Record Number:;7;9;ABPVHRN
  1.  ;;(4)   ;Date of Service:;7;10;ABPVDOS
  1.  ;;(5)   ;Visit Type:;7;11;ABPVTYPE
  1.  ;;(6)   ;Days or Visits:;7;12;ABPVDV
  1.  ;;(7)   ;Insurance Company:;7;13;ABPVINS
  1.  ;;   (a);Policy Holder Name:;7;14;ABPVPHNM
  1.  ;;   (b);Policy Number:;7;15;ABPVPNUM
  1.  ;;(8)   ;Claim Amount:;7;16;ABPVAMT