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