BDPMOD ; IHS/CMI/TMJ - EDIT AN EXISTING DESIGNATED 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
;
F D MAIN Q:BDPQ D HDR^BDP
D EOJ
Q
;
MAIN ;
S BDPQ=0
;S BDPMODE="A",BDPLOOK=""
D PATIENT ; get patient Name
Q:BDPQ
D PROVDISP
I BDPQ=1 G GETTYPE
;
D ASK
Q:BDPQ
;
GETTYPE ;Do Get Date if no existing Designated Providers
D TYPE ; get Provider Category Type
Q:BDPQ
D ADD ; add new Designated Provider record
;Q:BDPQ
Q
;
PATIENT ; GET PATIENT
F D PATIENT2 I BDPQ!($G(BDPDFN)) Q
Q
;
PATIENT2 ; ASK FOR PATIENT UNTIL USER SELECTS OR QUITS
S BDPQ=1
S DIC="^AUPNPAT(",DIC(0)="AEMQ" D DIC^BDPFMC
Q:Y<1
S BDPDFN=+Y,BDPREC("PAT NAME")=$P(^DPT(+Y,0),U)
S BDPQ=0
I $$DOD^AUPNPAT(BDPDFN) D I 'Y K BDPDFN,BDPREC("PAT NAME") Q
. W !!,"This patient is deceased."
. S DIR(0)="YO",DIR("A")="Are you sure you want this patient",DIR("B")="NO" K DA D ^DIR K DIR
. W !
. Q
Q
;
;
ASK ;Ask to Continue
S BDPQ=0
W !! S DIR(0)="Y",DIR("A")="Do you want to continue changing one of the above Designated Providers",DIR("B")="Y" K DA D ^DIR K DIR
I $D(DIRUT) S BDPQ=1 Q
I 'Y S BDPQ=1 Q
Q
;
PROVDISP ;Display if Patient has existing Designated Providers
W !!,?25,"********************",!
W ?10,"**CURRENT DESIGNATED PROVIDERS - BY PROVIDER CATEGORY TYPE**",!
W !,?15,"Assigned to Patient: "
W ?35,$P($G(^DPT(BDPDFN,0)),U)
W !,?25,"********************"
W !,?10,"**CATEGORY TYPE**",?46,"**CURRENT PROVIDER ASSIGNED**",!
I '$D(^BDPRECN("AA",BDPDFN)) W !,?20,"**--NO EXISTING DESIGNATED PROVIDERS--**",! S BDPQ=1 Q
S BDPQ=0
S BDPTYPE=""
S BDPCOUNT=0
F I=1:1:100 S BDPTYPE=$O(^BDPRECN("AA",BDPDFN,BDPTYPE)) Q:BDPTYPE="" S BDPCOUNT=BDPCOUNT+1 D NEXT
Q
NEXT ;2ND $O
S BDPRIEN=""
F S BDPRIEN=$O(^BDPRECN("AA",BDPDFN,BDPTYPE,BDPRIEN)) Q:BDPRIEN'=+BDPRIEN D
. Q:BDPTYPE=""
. Q:BDPRIEN=""
. S BDPPTNAM=$P(^DPT(BDPDFN,0),U,1) ;Patient Print Name
. S BDPTYPNM=$P(^BDPTCAT(BDPTYPE,0),U,1) ;Type Print
. S BDPCPRV=$P($G(^BDPRECN(BDPRIEN,0)),U,3) ;Current Provider IEN
. I BDPCPRV="" S BDPCPRVP="<None Currently Assigned>" ;If no current Provider
. E S BDPCPRVP=$P(^VA(200,BDPCPRV,0),U,1) ;Provider Print Name
. W !,?5,BDPCOUNT,?10,$E(BDPTYPNM,1,30),?50,$E(BDPCPRVP,1,35)
. S I=I+1 ; increment outer loop counter to limit display to 10 Designated Providers
. 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
PROV ; GET NEW DESIGNATED PROVIDER
S BDPPROV="",BDPQ=1
S DIC("A")="Select New Designated Provider: ",DIC="^VA(200,",DIC(0)="AEMQ"
I $$GET1^DIQ(90360.3,BDPTYPE,.01)="MESSAGE AGENT" S DIC("S")="I $D(^BDPMSGA(+Y,0)),'$P(^BDPMSGA(+Y,0),U,3)" K DIC("B")
D ^DIC K DIC,DA S:$D(DUOUT) DIRUT=1
Q:$D(DIRUT)
I +Y<1 S BDPQ=1 Q
S BDPPROV=+Y,BDPRPROV=$P(Y,U,2) ;Provider IEN
S BDPRPRVP=$P(^VA(200,BDPPROV,0),U,1) ;Provider Print Name
S BDPQ=0
Q
;
ADD ; ADD NEW DESIGNATED PROVIDER RECORD
S BDPQ=1
S BDPRR=$O(^BDPRECN("AA",BDPDFN,BDPTYPE,"")) ;Check to see if this Patient already has this Type
I BDPRR'="" S BDPLPROV=$P($G(^BDPRECN(BDPRR,0)),U,3) ;Current Provider
I BDPRR="" W !!,?10,"This patient does NOT have a Designated Provider",!,"for the Category you selected. See the Listing above."
I BDPRR="" W !!,"-Use the ADD menu option to Add a CURRENT Provider for this Category Type-",!! D PAUSE^BDP Q
;
S BDPRIEN=BDPRR ;Assign Record IEN to populate Multiple
;
D PROV
Q:BDPQ
Q:BDPRPROV=""
I BDPLPROV=BDPPROV W !!,"This is the existing Current Provider for this Category",!! D PAUSE^BDP Q ;Quit if the same Provider
ASKGO ;Ask to continue
;
W !!!,?8,"**********************************************",!
W !!,?8,"Okay, you have selected DESIGNATED PROVIDER : ",BDPRPRVP,!
W ?8,"To be assigned to Patient Name: "_$P($G(^DPT(BDPDFN,0)),U,1) W !
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 Changing to a new 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
W !!,"Okay - I have changed this Patient Record - as follows: ",! D Q
.W !!,"DESIGNATED PROVIDER : ",BDPRPRVP,!
.W "Has been assigned to Patient Name: "_$P($G(^DPT(BDPDFN,0)),U,1) W !
.W "For Designated Provider Category/Type: "_$P($G(^BDPTCAT(BDPTYPE,0)),U,1) W !!
.S BDPLINKI=1
.S:'$D(^BDPRECN(BDPRIEN,1,0)) $P(^(0),U,2)="90360.11P"
.S (X,BDPLIEN,BDPLNUM)=0
.F S X=$O(^BDPRECN(BDPRIEN,1,X)) Q:X'=+X S BDPLIEN=X,BDPLNUM=BDPLNUM+1 ;get last ien in multiple
.S BDPNIEN=BDPLIEN+1
.S BDPLNUM=BDPLNUM+1
.S $P(^BDPRECN(BDPRIEN,1,0),U,3)=BDPNIEN
.S $P(^BDPRECN(BDPRIEN,1,0),U,4)=BDPLNUM
.;INACTIVE PREVIOUS ONE
.I BDPNIEN'=1,$P(^BDPRECN(BDPRIEN,1,BDPLIEN,0),U,5)="" S DIE="^BDPRECN("_BDPRIEN_",1,",DA(1)=BDPRIEN,DA=BDPLIEN,DR=".02////"_DUZ_";.03////"_DT_";.05////"_DT D ^DIE K DIE,DR,DA,DINUM
.S BDPLINKI=1 ;tell fileman you are coming from BDP
.;S DR=".01///"_"`"_BDPPROV
.S ^BDPRECN(BDPRIEN,1,BDPNIEN,0)=BDPPROV_U_DUZ_U_DT_U_DT
.;L +^BDPRECN(BDPRIEN):10 I '$T Q "0^UNABLE TO LOCK GLOBAL"
.;S DIE="^BDPRECN("_BDPRIEN_",1,",DA(1)=BDPRIEN,DA=BDPLIEN D ^DIE K DIE,DR,DA,DINUM
.;L -^BDPRECN(BDPRIEN)
.;REINDEX MULTIPLE ENTRY
.NEW DIK
.S DA(1)=BDPRIEN,DA=BDPNIEN,DIK="^BDPRECN("_BDPRIEN_",1," D IX^DIK K DIC,DA
.;I $D(Y) Q "0^ADDING PROVIDER TO LOG FAILED"
.D PAUSE^BDP
.S BDPQ=0
.Q
EOJ ; END OF JOB
D ^BDPKILL
Q
;
;
INFORM ;Data Entry Explanation
;
W !,?20,"******************************"
W !,?2,"Utilize this Option to MODIFY Existing Designated Specialty Provider Records.",!
W ?3,"If the Patient has already been assigned the same Provider for the",!,?3,"Category and Provider selected - the record will not be Updated.",!
W ?20,"******************************",!
Q
IMA ;EP - called from option to inactivate a message agent so they can no longer be selected
;select provider to inactive
W !!
S DIC="^BDPMSGA(",DIC(0)="AEMQ",DIC("A")="Select Message Agent: " D ^DIC K DIC,DA
I Y=-1 W !!,"No message agent selected." D PAUSE^BDP Q
S BDPMA=+Y
I $P(^BDPMSGA(BDPMA,0),U,3) G REACT
S DIR(0)="Y",DIR("A")="Are you sure you want to inactivate "_$$GET1^DIQ(90360.5,BDPMA,.01)_" as a message agent",DIR("B")="Y"
KILL DA D ^DIR KILL DIR
I $D(DIRUT) W !,"No action taken." D PAUSE^BDP K Y,BDPMA Q
I 'Y W !,"No action taken." D PAUSE^BDP K Y,BDPMA Q
S DA=BDPMA,DIE="^BDPMSGA(",DR=".03///1" D ^DIE K DIE,DA,R,Y
W !,$$GET1^DIQ(90360.5,BDPMA,.01)," has been inactivated."
D COUNT
D PAUSE^BDP
K BDPMA
Q
REACT ;
W !!,$$GET1^DIQ(90360.5,BDPMA,.01)," is currently inactive.",!
S DIR(0)="Y",DIR("A")="Are you sure you want to reactivate "_$$GET1^DIQ(90360.5,BDPMA,.01)_" as a message agent",DIR("B")="Y"
KILL DA D ^DIR KILL DIR
I $D(DIRUT) W !,"No action taken." D PAUSE^BDP K Y,BDPMA Q
I 'Y W !,"No action taken." D PAUSE^BDP K Y,BDPMA Q
S DA=BDPMA,DIE="^BDPMSGA(",DR=".03///@" D ^DIE K DIE,DA,R,Y
W !,$$GET1^DIQ(90360.5,BDPMA,.01)," has been reactivated." D PAUSE^BDP K Y,BDPMA
Q
COUNT ;Count of # Patients for this Old Provider
S BDPI="",BDPQ=0,BDPC=0
S BDPTYPE=$O(^BDPTCAT("B","MESSAGE AGENT",0))
F S BDPI=$O(^BDPRECN("AC",BDPMA,BDPI)) Q:BDPI="" D
.Q:$P(^BDPRECN(BDPI,0),U,1)'=BDPTYPE
.S BDPC=BDPC+1
I BDPC>0 D
.W !!,"There are ",BDPC," patients currently assigned ",$$GET1^DIQ(90360.5,BDPMA,.01)," as their Message"
.W !,"Agent. Use option CLOP-Change all of one Provider's Patients to Another"
.W !,"to change them to another Message Agent.",!
K BDPI,BDPYI,BDPC,BDPQ
W !
W !
Q
BDPMOD ; IHS/CMI/TMJ - EDIT AN EXISTING DESIGNATED 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 FOR
DO MAIN
IF BDPQ
QUIT
DO HDR^BDP
+5 DO EOJ
+6 QUIT
+7 ;
MAIN ;
+1 SET BDPQ=0
+2 ;S BDPMODE="A",BDPLOOK=""
+3 ; get patient Name
DO PATIENT
+4 IF BDPQ
QUIT
+5 DO PROVDISP
+6 IF BDPQ=1
GOTO GETTYPE
+7 ;
+8 DO ASK
+9 IF BDPQ
QUIT
+10 ;
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 ADD
+4 ;Q:BDPQ
+5 QUIT
+6 ;
PATIENT ; GET PATIENT
+1 FOR
DO PATIENT2
IF BDPQ!($GET(BDPDFN))
QUIT
+2 QUIT
+3 ;
PATIENT2 ; ASK FOR PATIENT UNTIL USER SELECTS OR QUITS
+1 SET BDPQ=1
+2 SET DIC="^AUPNPAT("
SET DIC(0)="AEMQ"
DO DIC^BDPFMC
+3 IF Y<1
QUIT
+4 SET BDPDFN=+Y
SET BDPREC("PAT NAME")=$PIECE(^DPT(+Y,0),U)
+5 SET BDPQ=0
+6 IF $$DOD^AUPNPAT(BDPDFN)
Begin DoDot:1
+7 WRITE !!,"This patient is deceased."
+8 SET DIR(0)="YO"
SET DIR("A")="Are you sure you want this patient"
SET DIR("B")="NO"
KILL DA
DO ^DIR
KILL DIR
+9 WRITE !
+10 QUIT
End DoDot:1
IF 'Y
KILL BDPDFN,BDPREC("PAT NAME")
QUIT
+11 QUIT
+12 ;
+13 ;
ASK ;Ask to Continue
+1 SET BDPQ=0
+2 WRITE !!
SET DIR(0)="Y"
SET DIR("A")="Do you want to continue changing one of the above Designated Providers"
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 ;
PROVDISP ;Display if Patient has existing Designated Providers
+1 WRITE !!,?25,"********************",!
+2 WRITE ?10,"**CURRENT DESIGNATED PROVIDERS - BY PROVIDER CATEGORY TYPE**",!
+3 WRITE !,?15,"Assigned to Patient: "
+4 WRITE ?35,$PIECE($GET(^DPT(BDPDFN,0)),U)
+5 WRITE !,?25,"********************"
+6 WRITE !,?10,"**CATEGORY TYPE**",?46,"**CURRENT PROVIDER ASSIGNED**",!
+7 IF '$DATA(^BDPRECN("AA",BDPDFN))
WRITE !,?20,"**--NO EXISTING DESIGNATED PROVIDERS--**",!
SET BDPQ=1
QUIT
+8 SET BDPQ=0
+9 SET BDPTYPE=""
+10 SET BDPCOUNT=0
+11 FOR I=1:1:100
SET BDPTYPE=$ORDER(^BDPRECN("AA",BDPDFN,BDPTYPE))
IF BDPTYPE=""
QUIT
SET BDPCOUNT=BDPCOUNT+1
DO NEXT
+12 QUIT
NEXT ;2ND $O
+1 SET BDPRIEN=""
+2 FOR
SET BDPRIEN=$ORDER(^BDPRECN("AA",BDPDFN,BDPTYPE,BDPRIEN))
IF BDPRIEN'=+BDPRIEN
QUIT
Begin DoDot:1
+3 IF BDPTYPE=""
QUIT
+4 IF BDPRIEN=""
QUIT
+5 ;Patient Print Name
SET BDPPTNAM=$PIECE(^DPT(BDPDFN,0),U,1)
+6 ;Type Print
SET BDPTYPNM=$PIECE(^BDPTCAT(BDPTYPE,0),U,1)
+7 ;Current Provider IEN
SET BDPCPRV=$PIECE($GET(^BDPRECN(BDPRIEN,0)),U,3)
+8 ;If no current Provider
IF BDPCPRV=""
SET BDPCPRVP="<None Currently Assigned>"
+9 ;Provider Print Name
IF '$TEST
SET BDPCPRVP=$PIECE(^VA(200,BDPCPRV,0),U,1)
+10 WRITE !,?5,BDPCOUNT,?10,$EXTRACT(BDPTYPNM,1,30),?50,$EXTRACT(BDPCPRVP,1,35)
+11 ; increment outer loop counter to limit display to 10 Designated Providers
SET I=I+1
+12 QUIT
End DoDot:1
+13 QUIT
+14 ;
+15 ;
+16 ;
TYPE ; GET CATEGORY TYPE FOR DESIGNATED PROVIDER
+1 WRITE !
+2 SET BDPQ=1
+3 ;
+4 SET DIR(0)="90360.1,.01"
SET DIR("B")="DPCP"
KILL DA
DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)
QUIT
+6 SET BDPTYPE=+Y
SET BDPREC("PROV TYPE")=Y(0)
+7 SET BDPQ=0
+8 QUIT
PROV ; GET NEW DESIGNATED PROVIDER
+1 SET BDPPROV=""
SET BDPQ=1
+2 SET DIC("A")="Select New Designated Provider: "
SET DIC="^VA(200,"
SET DIC(0)="AEMQ"
+3 IF $$GET1^DIQ(90360.3,BDPTYPE,.01)="MESSAGE AGENT"
SET DIC("S")="I $D(^BDPMSGA(+Y,0)),'$P(^BDPMSGA(+Y,0),U,3)"
KILL DIC("B")
+4 DO ^DIC
KILL DIC,DA
IF $DATA(DUOUT)
SET DIRUT=1
+5 IF $DATA(DIRUT)
QUIT
+6 IF +Y<1
SET BDPQ=1
QUIT
+7 ;Provider IEN
SET BDPPROV=+Y
SET BDPRPROV=$PIECE(Y,U,2)
+8 ;Provider Print Name
SET BDPRPRVP=$PIECE(^VA(200,BDPPROV,0),U,1)
+9 SET BDPQ=0
+10 QUIT
+11 ;
ADD ; ADD NEW DESIGNATED PROVIDER RECORD
+1 SET BDPQ=1
+2 ;Check to see if this Patient already has this Type
SET BDPRR=$ORDER(^BDPRECN("AA",BDPDFN,BDPTYPE,""))
+3 ;Current Provider
IF BDPRR'=""
SET BDPLPROV=$PIECE($GET(^BDPRECN(BDPRR,0)),U,3)
+4 IF BDPRR=""
WRITE !!,?10,"This patient does NOT have a Designated Provider",!,"for the Category you selected. See the Listing above."
+5 IF BDPRR=""
WRITE !!,"-Use the ADD menu option to Add a CURRENT Provider for this Category Type-",!!
DO PAUSE^BDP
QUIT
+6 ;
+7 ;Assign Record IEN to populate Multiple
SET BDPRIEN=BDPRR
+8 ;
+9 DO PROV
+10 IF BDPQ
QUIT
+11 IF BDPRPROV=""
QUIT
+12 ;Quit if the same Provider
IF BDPLPROV=BDPPROV
WRITE !!,"This is the existing Current Provider for this Category",!!
DO PAUSE^BDP
QUIT
ASKGO ;Ask to continue
+1 ;
+2 WRITE !!!,?8,"**********************************************",!
+3 WRITE !!,?8,"Okay, you have selected DESIGNATED PROVIDER : ",BDPRPRVP,!
+4 WRITE ?8,"To be assigned to Patient Name: "_$PIECE($GET(^DPT(BDPDFN,0)),U,1)
WRITE !
+5 WRITE ?8,"For Designated Provider Category/Type: "_$PIECE($GET(^BDPTCAT(BDPTYPE,0)),U,1)
WRITE !!
+6 WRITE !,?8,"**********************************************",!
+7 ;
+8 ;
+9 SET DIR(0)="Y"
SET DIR("A")="Do you wish to Continue Changing to a new 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
+10 IF $DATA(DIRUT)
SET BDPQ=1
QUIT
+11 IF Y=0
SET BDPQ=1
QUIT
+12 WRITE !!,"Okay - I have changed this Patient Record - as follows: ",!
Begin DoDot:1
+13 WRITE !!,"DESIGNATED PROVIDER : ",BDPRPRVP,!
+14 WRITE "Has been assigned to Patient Name: "_$PIECE($GET(^DPT(BDPDFN,0)),U,1)
WRITE !
+15 WRITE "For Designated Provider Category/Type: "_$PIECE($GET(^BDPTCAT(BDPTYPE,0)),U,1)
WRITE !!
+16 SET BDPLINKI=1
+17 IF '$DATA(^BDPRECN(BDPRIEN,1,0))
SET $PIECE(^(0),U,2)="90360.11P"
+18 SET (X,BDPLIEN,BDPLNUM)=0
+19 ;get last ien in multiple
FOR
SET X=$ORDER(^BDPRECN(BDPRIEN,1,X))
IF X'=+X
QUIT
SET BDPLIEN=X
SET BDPLNUM=BDPLNUM+1
+20 SET BDPNIEN=BDPLIEN+1
+21 SET BDPLNUM=BDPLNUM+1
+22 SET $PIECE(^BDPRECN(BDPRIEN,1,0),U,3)=BDPNIEN
+23 SET $PIECE(^BDPRECN(BDPRIEN,1,0),U,4)=BDPLNUM
+24 ;INACTIVE PREVIOUS ONE
+25 IF BDPNIEN'=1
IF $PIECE(^BDPRECN(BDPRIEN,1,BDPLIEN,0),U,5)=""
SET DIE="^BDPRECN("_BDPRIEN_",1,"
SET DA(1)=BDPRIEN
SET DA=BDPLIEN
SET DR=".02////"_DUZ_";.03////"_DT_";.05////"_DT
DO ^DIE
KILL DIE,DR,DA,DINUM
+26 ;tell fileman you are coming from BDP
SET BDPLINKI=1
+27 ;S DR=".01///"_"`"_BDPPROV
+28 SET ^BDPRECN(BDPRIEN,1,BDPNIEN,0)=BDPPROV_U_DUZ_U_DT_U_DT
+29 ;L +^BDPRECN(BDPRIEN):10 I '$T Q "0^UNABLE TO LOCK GLOBAL"
+30 ;S DIE="^BDPRECN("_BDPRIEN_",1,",DA(1)=BDPRIEN,DA=BDPLIEN D ^DIE K DIE,DR,DA,DINUM
+31 ;L -^BDPRECN(BDPRIEN)
+32 ;REINDEX MULTIPLE ENTRY
+33 NEW DIK
+34 SET DA(1)=BDPRIEN
SET DA=BDPNIEN
SET DIK="^BDPRECN("_BDPRIEN_",1,"
DO IX^DIK
KILL DIC,DA
+35 ;I $D(Y) Q "0^ADDING PROVIDER TO LOG FAILED"
+36 DO PAUSE^BDP
+37 SET BDPQ=0
+38 QUIT
End DoDot:1
QUIT
EOJ ; END OF JOB
+1 DO ^BDPKILL
+2 QUIT
+3 ;
+4 ;
INFORM ;Data Entry Explanation
+1 ;
+2 WRITE !,?20,"******************************"
+3 WRITE !,?2,"Utilize this Option to MODIFY Existing Designated Specialty Provider Records.",!
+4 WRITE ?3,"If the Patient has already been assigned the same Provider for the",!,?3,"Category and Provider selected - the record will not be Updated.",!
+5 WRITE ?20,"******************************",!
+6 QUIT
IMA ;EP - called from option to inactivate a message agent so they can no longer be selected
+1 ;select provider to inactive
+2 WRITE !!
+3 SET DIC="^BDPMSGA("
SET DIC(0)="AEMQ"
SET DIC("A")="Select Message Agent: "
DO ^DIC
KILL DIC,DA
+4 IF Y=-1
WRITE !!,"No message agent selected."
DO PAUSE^BDP
QUIT
+5 SET BDPMA=+Y
+6 IF $PIECE(^BDPMSGA(BDPMA,0),U,3)
GOTO REACT
+7 SET DIR(0)="Y"
SET DIR("A")="Are you sure you want to inactivate "_$$GET1^DIQ(90360.5,BDPMA,.01)_" as a message agent"
SET DIR("B")="Y"
+8 KILL DA
DO ^DIR
KILL DIR
+9 IF $DATA(DIRUT)
WRITE !,"No action taken."
DO PAUSE^BDP
KILL Y,BDPMA
QUIT
+10 IF 'Y
WRITE !,"No action taken."
DO PAUSE^BDP
KILL Y,BDPMA
QUIT
+11 SET DA=BDPMA
SET DIE="^BDPMSGA("
SET DR=".03///1"
DO ^DIE
KILL DIE,DA,R,Y
+12 WRITE !,$$GET1^DIQ(90360.5,BDPMA,.01)," has been inactivated."
+13 DO COUNT
+14 DO PAUSE^BDP
+15 KILL BDPMA
+16 QUIT
REACT ;
+1 WRITE !!,$$GET1^DIQ(90360.5,BDPMA,.01)," is currently inactive.",!
+2 SET DIR(0)="Y"
SET DIR("A")="Are you sure you want to reactivate "_$$GET1^DIQ(90360.5,BDPMA,.01)_" as a message agent"
SET DIR("B")="Y"
+3 KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
WRITE !,"No action taken."
DO PAUSE^BDP
KILL Y,BDPMA
QUIT
+5 IF 'Y
WRITE !,"No action taken."
DO PAUSE^BDP
KILL Y,BDPMA
QUIT
+6 SET DA=BDPMA
SET DIE="^BDPMSGA("
SET DR=".03///@"
DO ^DIE
KILL DIE,DA,R,Y
+7 WRITE !,$$GET1^DIQ(90360.5,BDPMA,.01)," has been reactivated."
DO PAUSE^BDP
KILL Y,BDPMA
+8 QUIT
COUNT ;Count of # Patients for this Old Provider
+1 SET BDPI=""
SET BDPQ=0
SET BDPC=0
+2 SET BDPTYPE=$ORDER(^BDPTCAT("B","MESSAGE AGENT",0))
+3 FOR
SET BDPI=$ORDER(^BDPRECN("AC",BDPMA,BDPI))
IF BDPI=""
QUIT
Begin DoDot:1
+4 IF $PIECE(^BDPRECN(BDPI,0),U,1)'=BDPTYPE
QUIT
+5 SET BDPC=BDPC+1
End DoDot:1
+6 IF BDPC>0
Begin DoDot:1
+7 WRITE !!,"There are ",BDPC," patients currently assigned ",$$GET1^DIQ(90360.5,BDPMA,.01)," as their Message"
+8 WRITE !,"Agent. Use option CLOP-Change all of one Provider's Patients to Another"
+9 WRITE !,"to change them to another Message Agent.",!
End DoDot:1
+10 KILL BDPI,BDPYI,BDPC,BDPQ
+11 WRITE !
+12 WRITE !
+13 QUIT
