- 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
