BDPDEL ; IHS/CMI/TMJ - DELETE AN EXISTING DESIGNATED PROVIDER ;
;;2.0;IHS PCC SUITE;**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 DELETING 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 BDPLPRVT="<None Currently Assigned>" ;If no current Provider
. E S BDPLPRVT=$P(^VA(200,BDPCPRV,0),U,1) ;Provider Print Name
. W !,?5,BDPCOUNT,?10,$E(BDPTYPNM,1,30),?50,$E(BDPLPRVT,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
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 !!,?5,"This patient does NOT have a Designated Provider Type",!,?5,"for the Category you selected. See the Listing above.",! D PAUSE^BDP Q
;
I BDPLPROV="" W !!,?5,"This patient does not have a current Provider for this Category Type!",! D PAUSE^BDP Q
S BDPRIEN=BDPRR ;Assign Record IEN to populate Multiple
;
ASKGO ;Ask to continue
S BDPLPRVT=$P($G(^VA(200,BDPLPROV,0)),U,1) ;Provider Text
Q:BDPLPRVT="" ;Quit if no Provider
;
W !!!,?8,"**********************************************",!
W !!,?8,"Okay, the current DESIGNATED PROVIDER is : ",BDPLPRVT,!
W ?8,"To be deleted from 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 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
W !!,"Okay - I have deleted the Designated Provider for Patient Record - as follows: ",! D Q
.W !!,"Old DESIGNATED PROVIDER : ",BDPLPRVT,!
. W "Has been deleted from 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 ;tell xrefs we are in BDP
. I $D(BDPRIEN) D
.. S DIE="^BDPRECN(",DA=BDPRIEN,DR=".03///@;.04////"_DUZ_";.05////"_DT D ^DIE K DIE,DR,DA,DINUM
.. ;NOW FIND LAST MULTIPLE AND SET STOP DATE
.. S X=0 F S X=$O(^BDPRECN(BDPRIEN,1,X)) Q:X'=+X I $P(^BDPRECN(BDPRIEN,1,X,0),U,1)=BDPLPROV S Y=X
.. I Y,$P(^BDPRECN(BDPRIEN,1,Y,0),U,5)="" S DIE="^BDPRECN("_BDPRIEN_",1,",DA(1)=BDPRIEN,DA=Y,DR=".02////"_DUZ_";.03////"_DT_";.05////"_DT D ^DIE K DIE,DR,DA,DINUM
.D PAUSE^BDP
.Q
EOJ ; END OF JOB
D ^BDPKILL
Q
;
;
INFORM ;Data Entry Explanation
;
W !,?20,"******************************"
W !,?2,"Utilize this Option to DELETE an Existing Designated Specialty Provider",!
W ?3,"for a selected individual Patient and Provider Category Type.",!
W ?20,"******************************",!
Q
BDPDEL ; IHS/CMI/TMJ - DELETE AN EXISTING DESIGNATED PROVIDER ;
+1 ;;2.0;IHS PCC SUITE;**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 DELETING 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 BDPLPRVT="<None Currently Assigned>"
+9 ;Provider Print Name
IF '$TEST
SET BDPLPRVT=$PIECE(^VA(200,BDPCPRV,0),U,1)
+10 WRITE !,?5,BDPCOUNT,?10,$EXTRACT(BDPTYPNM,1,30),?50,$EXTRACT(BDPLPRVT,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
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 !!,?5,"This patient does NOT have a Designated Provider Type",!,?5,"for the Category you selected. See the Listing above.",!
DO PAUSE^BDP
QUIT
+5 ;
+6 IF BDPLPROV=""
WRITE !!,?5,"This patient does not have a current Provider for this Category Type!",!
DO PAUSE^BDP
QUIT
+7 ;Assign Record IEN to populate Multiple
SET BDPRIEN=BDPRR
+8 ;
ASKGO ;Ask to continue
+1 ;Provider Text
SET BDPLPRVT=$PIECE($GET(^VA(200,BDPLPROV,0)),U,1)
+2 ;Quit if no Provider
IF BDPLPRVT=""
QUIT
+3 ;
+4 WRITE !!!,?8,"**********************************************",!
+5 WRITE !!,?8,"Okay, the current DESIGNATED PROVIDER is : ",BDPLPRVT,!
+6 WRITE ?8,"To be deleted from Patient Name: "_$PIECE($GET(^DPT(BDPDFN,0)),U,1)
WRITE !
+7 WRITE ?8,"For Designated Provider Category/Type: "_$PIECE($GET(^BDPTCAT(BDPTYPE,0)),U,1)
WRITE !!
+8 WRITE !,?8,"**********************************************",!
+9 ;
+10 ;
+11 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
+12 IF $DATA(DIRUT)
SET BDPQ=1
QUIT
+13 IF Y=0
SET BDPQ=1
QUIT
+14 WRITE !!,"Okay - I have deleted the Designated Provider for Patient Record - as follows: ",!
Begin DoDot:1
+15 WRITE !!,"Old DESIGNATED PROVIDER : ",BDPLPRVT,!
+16 WRITE "Has been deleted from Patient Name: "_$PIECE($GET(^DPT(BDPDFN,0)),U,1)
WRITE !
+17 WRITE "For Designated Provider Category/Type: "_$PIECE($GET(^BDPTCAT(BDPTYPE,0)),U,1)
WRITE !!
+18 ;tell xrefs we are in BDP
SET BDPLINKI=1
+19 IF $DATA(BDPRIEN)
Begin DoDot:2
+20 SET DIE="^BDPRECN("
SET DA=BDPRIEN
SET DR=".03///@;.04////"_DUZ_";.05////"_DT
DO ^DIE
KILL DIE,DR,DA,DINUM
+21 ;NOW FIND LAST MULTIPLE AND SET STOP DATE
+22 SET X=0
FOR
SET X=$ORDER(^BDPRECN(BDPRIEN,1,X))
IF X'=+X
QUIT
IF $PIECE(^BDPRECN(BDPRIEN,1,X,0),U,1)=BDPLPROV
SET Y=X
+23 IF Y
IF $PIECE(^BDPRECN(BDPRIEN,1,Y,0),U,5)=""
SET DIE="^BDPRECN("_BDPRIEN_",1,"
SET DA(1)=BDPRIEN
SET DA=Y
SET DR=".02////"_DUZ_";.03////"_DT_";.05////"_DT
DO ^DIE
KILL DIE,DR,DA,DINUM
End DoDot:2
+24 DO PAUSE^BDP
+25 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 DELETE an Existing Designated Specialty Provider",!
+4 WRITE ?3,"for a selected individual Patient and Provider Category Type.",!
+5 WRITE ?20,"******************************",!
+6 QUIT
