- 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
