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

ABMDECLN.m

Go to the documentation of this file. 
  1. ABMDECLN ; IHS/ASDST/DMJ - Clean line itms claim file ;
  1.  ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
  1.  ;
  1.  ;IHS/SD/SDR - v2.5 p8 - task 6
  1.  ;   Added code to rebuild new ambulance page 8K
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p10 - IM19901
  1.  ;   Modified to make it leave completed insurers
  1.  ;   instead of rebuilding them, making them active again
  1.  ;
  1.  ;Ask user for claim number
  1.  N ABMCLM,ABMVDFN
  1.  W !
  1.  W !,"WARNING this option deletes the data from selected pages (subfiles) of the"
  1.  W !,"claim file.  Then it looks to see if the data can be rebuilt from PCC."
  1.  W !,"For some pages there is no data in PCC.  For some the data may be missing."
  1.  W !,"The data will only be rebuilt if the information exists in PCC.",!
  1.  S DIC="^ABMDCLM(DUZ(2),"
  1.  S DIC(0)="AEMNQ"
  1.  D ^DIC
  1.  Q:Y=-1
  1.  S ABMCLM=+Y
  1.  K ABM,DTOUT,DUOUT,DIRUT,DIROUT
  1.  S Y=$P($G(^ABMDPARM(DUZ(2),1,0)),U,16)
  1.  I Y D  Q:'Y
  1.  .S X1=DT
  1.  .S X2=-Y*30.417
  1.  .D C^%DTC
  1.  .Q:X<$P(^ABMDCLM(DUZ(2),ABMCLM,0),U,2)
  1.  .W !,"The date of this claim is prior to the backbilling limit.  As a result items"
  1.  .W !,"will not be rebuilt from PCC.  If you continue, you can only delete items.",!
  1.  .S DIR(0)="Y"
  1.  .S DIR("A")="Do you wish to continue"
  1.  .S DIR("B")="No"
  1.  .D ^DIR
  1.  K ABM,DTOUT,DUOUT,DIRUT,DIROUT
  1.  I '$D(^ABMDCLM(DUZ(2),ABMCLM,11,+$O(^ABMDCLM(DUZ(2),ABMCLM,11,0)),0)) D  Q:'Y
  1.  .W !,"There are no PCC visits corresponding to this claim.  As a result there is no"
  1.  .W !,"PCC data to rebuild from.  If you continue, you can only delete items.",!
  1.  .S DIR(0)="Y"
  1.  .S DIR("A")="Do you wish to continue"
  1.  .S DIR("B")="No"
  1.  .D ^DIR
  1.  E  D  Q:$D(DIRUT)
  1.  .S DIR(0)="Y"
  1.  .S DIR("A")="Do you wish to view PCC visit information before continuing"
  1.  .S DIR("B")="No"
  1.  .D ^DIR
  1.  .Q:'Y
  1.  .S ABMI=0
  1.  .F  S ABMI=$O(^ABMDCLM(DUZ(2),ABMCLM,11,ABMI)) Q:'ABMI  D
  1.  ..S APCDVDSP=ABMI
  1.  ..D ^APCDVDSP
  1.  .K ABMI,DIR
  1.  ;Get list of subfiles and display to user.
  1.  S DIC="^DD(9002274.3,"
  1.  S DR=".01;.2;.4"
  1.  S DIQ="ABM"             ;DIQ1 puts value into ABM array
  1.  S DIQ(0)="I"
  1.  F DA=13:2:47 D EN^DIQ1
  1.  N PG
  1.  F I=0:1:14 D
  1.  .S Y=$T(PAGE+I)
  1.  .S PG($P(Y,U,2))=$P($P(Y,U),";",3)
  1.  W !!
  1.  S I=0
  1.  F  S I=$O(ABM(0,I)) Q:'I  D
  1.  .Q:ABM(0,I,.2,"I")'["P"
  1.  .I $X>35 W !
  1.  .E  W ?40
  1.  .W I,"  ",ABM(0,I,.01,"I") W:$D(PG(I)) "  (P-",PG(I),")"
  1.  ;Ask user for list of subfiles to clean out
  1.  W !
  1.  K DIR
  1.  S DIR("A")="Enter subfile number or list of subfiles to clean out"
  1.  S DIR(0)="LC^13:47:0^K:'$D(ABM(0,+X)) X"
  1.  S DIR("?")="Enter one number from the above list or a list or a range."
  1.  S DIR("??")="^D HELP^ABMDECLN"
  1.  D ^DIR
  1.  I $D(DIRUT) G Q
  1.  ;Clean out the list of selected subfiles
  1.  S ABMY=Y
  1.  S DA(1)=ABMCLM
  1.  F  D  Q:'ABMY
  1.  .S X=$P(ABMY,",",1)
  1.  .S ABMY=$P(ABMY,",",2,45)
  1.  .I X["-" D
  1.  ..S ABM1=+X
  1.  ..S ABM2=$P(X,"-",2)
  1.  ..F ABM=ABM1:2:ABM2 D:$D(ABM(0,ABM)) CLEANIT(ABM,1)
  1.  .E  D:$D(ABM(0,X)) CLEANIT(X,1)
  1.  S DA=0
  1.  F  S DA=$O(^ABMDCLM(DUZ(2),DA(1),11,DA)) Q:'DA  D
  1.  .S ABMVDFN=+^ABMDCLM(DUZ(2),DA(1),11,DA,0)
  1.  .S ^AUPNVSIT("ABILL",$P(^AUPNVSIT(ABMVDFN,0),U,2),ABMVDFN)=""
  1.  S Y=+^ABMDCLM(DUZ(2),DA(1),0)
  1.  I Y D QUEUE^ABMDVPAT
  1. Q ;KILL OFF VARS
  1.  K DIR,DIRUT,DTOUT,DUOUT,DIQ,DIC,DA,ABM,ABMY,ABM1,ABM2,DR
  1.  Q
  1.  ;
  1. CLEAN(CLM,SECT,DFN)    ;EP to allow cleaning all items from multiple
  1.  ;CLM  = Claim #
  1.  ;SECT = The multiple to clean out
  1.  ;Y    = Patient DFN
  1.  N DA
  1.  S DA(1)=CLM
  1.  D CLEANIT(SECT,1)
  1.  I $G(DFN)>0 S Y=DFN D QUEUE^ABMDVPAT
  1.  Q
  1.  ;
  1. HELP ;EP
  1.  W !,"Enter the subfile to clean out for claim # ",ABMCLM,"."
  1.  W !,"You may enter a list of subfiles like this: 17,19,23."
  1.  W !,"Or a range like this: 23-33, or a combination like this:"
  1.  W !,"13,19,23-33.  To delete all line items from all mutiples enter"
  1.  W !,"13-47"
  1.  Q
  1. CLEANIT(ABMSUB,ABMALL) ;EP - Clean out old values from ABMSUB node
  1.  N ABMJ,ABMFDA,FILE,IENS
  1.  S ABMALL=$G(ABMALL)
  1.  S:'$D(DA) DA(1)=ABMP("CDFN")
  1.  I $G(ABMCHV0)=$G(ABMP("V0")),$D(^ABMDCLM(DUZ(2),DA(1),ABMSUB))>1 D
  1.  .S ABMJ=0
  1.  .F  S ABMJ=$O(^ABMDCLM(DUZ(2),DA(1),ABMSUB,ABMJ)) Q:'ABMJ  D
  1.  ..Q:'$D(^ABMDCLM(DUZ(2),DA(1),ABMSUB,ABMJ,0))
  1.  ..S Y=^ABMDCLM(DUZ(2),DA(1),ABMSUB,ABMJ,0)
  1.  ..I 'ABMALL,($P(Y,U,17)="M") Q
  1.  ..I ABMSUB=13,$P(Y,U,3)="C" Q  ;quit if complete insurer
  1.  ..S IENS=ABMJ_","_DA(1)_","
  1.  ..S FILE=9002274.30+(ABMSUB/10000)
  1.  ..S ABMFDA(FILE,IENS,.01)="@"
  1.  ..D FILE^DIE("KE","ABMFDA")
  1.  ..K ABMFDA(FILE)
  1.  ..Q:'ABMALL
  1.  ..S ABMSRC=""
  1.  ..F  S ABMSRC=$O(^ABMDCLM(DUZ(2),DA(1),"ASRC",ABMSRC)) Q:ABMSRC=""  D
  1.  ...Q:'$D(^ABMDCLM(DUZ(2),DA(1),"ASRC",ABMSRC,ABMJ))
  1.  ...K ^ABMDCLM(DUZ(2),DA(1),"ASRC",ABMSRC,ABMJ,ABMSUB)
  1.  Q
  1.  ;
  1. PAGE ;;2^13
  1.  ;;4^41
  1.  ;;5A^17
  1.  ;;5B^19
  1.  ;;6^33
  1.  ;;8A^27
  1.  ;;8B^21
  1.  ;;8C^25
  1.  ;;8D^23
  1.  ;;8E^37
  1.  ;;8F^35
  1.  ;;8G^39
  1.  ;;8H^43
  1.  ;;8J^45
  1.  ;;8K^47