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

BDPLDEL.m

Go to the documentation of this file. 
  1. BDPLDEL ; IHS/CMI/TMJ - LOOP DELETE EXISTING PROVIDER TO NEW PROVIDER ; 
  1.  ;;2.0;IHS PCC SUITE;**10,21**;MAY 14, 2009;Build 34
  1.  ;
  1.  ; Subscripted BDPREC is EXTERNAL form.
  1.  ;   BDPREC("PAT NAME")=patient name
  1.  ;   BDPREC("PROV TYPE")=Provider Category Type
  1.  ;   BDPDFN=patient ien
  1.  ;   BDPRDATE=date in internal FileMan form
  1.  ;   BDPRIEN=Designated Provider ien
  1.  ;
  1. START ;
  1.  ;
  1.  D INFORM ;Data Entry Explanation
  1.  ;
  1.  D MAIN Q:BDPQ  D HDR^BDP
  1.  D EOJ
  1.  Q
  1.  ;
  1. MAIN ;
  1.  S BDPQ=0,BDPYI=0
  1.  D OLDPROV ;              get Old Existing Provider
  1.  Q:BDPQ
  1.  D COUNT
  1.  Q:BDPQ  ;Quit No Records for this Provider
  1.  D ASK
  1.  Q:BDPQ
  1.  I BDPQ=1 G MAIN
  1.  ;
  1.  ;D ASK
  1.  ;
  1. GETTYPE ;Do Get Date if no existing Designated Providers
  1.  D TYPE ;                 get Provider Category Type
  1.  Q:BDPQ
  1.  D ASKGO ;                  add new Designated Provider record
  1.  S BDPQ=0
  1.  Q
  1.  ;
  1. OLDPROV ; GET OLD EXISTING PROVIDER
  1.  ;
  1.  S BDPOPROV="",BDPQ=0
  1.  S DIC("A")="Select EXISTING Designated Provider: ",DIC="^VA(200,",DIC(0)="AEMQ" D ^DIC K DIC,DA
  1.  Q:$D(DIRUT)
  1.  I +Y<1 S BDPQ=1 Q
  1.  S BDPOPROV=+Y,BDPOPRVP=$P(Y,U,2)
  1.  S BDPOPRVP=$P(^VA(200,BDPOPROV,0),U,1) ;Provider Print Name
  1.  S BDPQ=0
  1.  Q
  1.  ;
  1. COUNT ;Count of # Patients for this Old Provider
  1.  S BDPI="",BDPQ=0
  1.  F BDPYI=1:1 S BDPI=$O(^BDPRECN("AC",BDPOPROV,BDPI)) Q:BDPI=""
  1.  W !!?10,"There are ",BDPYI-1," patients currently assigned to this Provider."
  1.  I BDPYI=1 S BDPQ=1 ;More than one patient exists for Provider
  1.  K BDPI,BDPYI
  1.  W !
  1.  W !
  1.  Q
  1.  ;
  1.  ;
  1. ASK ;Ask to Continue
  1.  S BDPQ=0
  1.  W !! S DIR(0)="Y",DIR("A")="Do you want to continue DELETING the Designated Provider for each Patient",DIR("B")="Y" K DA D ^DIR K DIR
  1.  I $D(DIRUT) S BDPQ=1 Q
  1.  I 'Y S BDPQ=1 Q
  1.  Q
  1.  ;
  1.  ;
  1. TYPE ; GET CATEGORY TYPE FOR DESIGNATED PROVIDER
  1.  W !
  1.  S BDPQ=1
  1.  S DIR(0)="90360.1,.01",DIR("B")="DPCP" K DA D ^DIR K DIR
  1.  Q:$D(DIRUT)
  1.  S BDPTYPE=+Y,BDPREC("PROV TYPE")=Y(0)
  1.  S BDPQ=0
  1.  Q
  1.  ;
  1. ASKGO ;Ask to continue
  1.  ;
  1.  W !!!,?8,"**********************************************",!
  1.  W !!,?8,"Okay, you have selected OLD Provider : ",BDPOPRVP,!
  1.  W ?8,"For Designated Provider Category/Type: "_$P($G(^BDPTCAT(BDPTYPE,0)),U,1) W !!
  1.  W !,?8,"**********************************************",!
  1.  ;
  1.  ;
  1.  S DIR(0)="Y",DIR("A")="Do you wish to Continue DELETING the CURRENT Designated Provider",DIR("?")="Enter Y for Yes or N for NO",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I $D(DIRUT) S BDPQ=1 Q
  1.  I Y=0 S BDPQ=1 Q
  1.  ;
  1.  ;
  1. UPDATE ;Update Records
  1.  ;
  1.  S BDPIEN="" F  S BDPIEN=$O(^BDPRECN("AC",BDPOPROV,BDPIEN)) Q:BDPIEN'=+BDPIEN  D
  1.  . Q:BDPIEN=""
  1.  . S BDPTYPEM=$P($G(^BDPRECN(BDPIEN,0)),U) ;Type to Match On
  1.  . Q:BDPTYPEM=""
  1.  . Q:BDPTYPE=""
  1.  . I BDPTYPE'=BDPTYPEM Q  ;Quit if No Match
  1.  . S BDPPAT=$P($G(^BDPRECN(BDPIEN,0)),U,2) ;Patient
  1.  . Q:BDPPAT=""
  1.  . S BDPLPROV=$P(^BDPRECN(BDPIEN,0),U,3)  ;PROVIDER
  1.  . ;Q:BDPPROV=""  ;Quit if No New Provider
  1.  . S BDPLINKI=1
  1.  . S DIE="^BDPRECN(",DA=BDPIEN,DR=".03///"_"@"_";.04////"_DUZ_";.05////"_DT D ^DIE K DIE,DR,DA,DINUM
  1.  . ;SET DATE INACTIVE/STOP DATE IN .05 OF MULTIPLE
  1.  . S X=0 F  S X=$O(^BDPRECN(BDPIEN,1,X)) Q:X'=+X  I $P(^BDPRECN(BDPIEN,1,X,0),U,1)=BDPLPROV S Y=X
  1.  . I Y,$P(^BDPRECN(BDPIEN,1,Y,0),U,5)="" S DIE="^BDPRECN("_BDPIEN_",1,",DA(1)=BDPIEN,DA=Y,DR=".02////"_DUZ_";.03////"_DT_";.05////"_DT D ^DIE K DIE,DR,DA,DINUM
  1.  . ;I $T(KILL^BDPLINKI)]"" D KILL^BDPLINKI($P($G(^BDPTCAT($P(^BDPRECN(DA,0),U),0)),U,4),$P($G(^BDPTCAT($P(^BDPRECN(DA,0),U),0)),U,5),DA,X,$P(^BDPRECN(DA,0),U,2),$G(BDPLINKI))
  1.  ;
  1.  ;
  1. MSGEND ;End of Add Message
  1.  W !!!!,"Okay - I have DELETED all Patient Records - as follows: ",! D  Q
  1.  .W !,"OLD Designated Provider : ",BDPOPRVP,!
  1.  . W "For Designated Provider Category/Type: "_$P($G(^BDPTCAT(BDPTYPE,0)),U,1) W !!
  1.  . D PAUSE^BDP
  1.  S BDPQ=0
  1.  Q
  1.  ;
  1.  ;
  1. EOJ ; END OF JOB
  1.  D ^BDPKILL
  1.  Q
  1.  ;
  1.  ;
  1. INFORM ;Data Entry Explanation
  1.  ;
  1.  W !,?3,"This Option allows the automatic DELETING of all Records......",!,?10,"for the CURRENT existing Designated Provider -",!
  1.  W ?3,"The User is prompted for the EXISTING Provider Name.",!
  1.  W ?3,"Once the desired Provider Category Type is selected by the User,",!
  1.  W ?3,"the Program will automatically LOOP through all Records and",!,?3,"DELETE this Current Provider for this Category Type.",!!
  1.  Q