BDPADD ; IHS/CMI/TMJ - ADD A NEW 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 with adding a new Designated Provider",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 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")
I $$GET1^DIQ(90360.3,BDPTYPE,.01)'="MESSAGE AGENT" S DIC("S")="I $D(^VA(200,""AK.PROVIDER"",$P($G(^VA(200,+Y,0)),U),+Y)),$P($G(^VA(200,+Y,""PS"")),U,4)="""""
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)
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 Type
I BDPRR'="" S BDPLPROV=$P($G(^BDPRECN(BDPRR,0)),U,3) ;Current Provider
I BDPRR>0 W !!,?10,"This patient already has a Designated Provider Type",!," the Category you selected. See the Designated Provider Listing above."
I BDPRR>0 W !!,"-Use the MOD menu item to change to a new CURRENT Provider for this Category Type-",!! D PAUSE^BDP Q
;
D PROV
Q:BDPQ
ASKGO ;Ask to continue
;
W !!,"Okay, you have selected DESIGNATED PROVIDER : ",BDPRPRVP,!
W "To be 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 DIR(0)="Y",DIR("A")="Do you wish to Continue with the Adding of the new 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 will add this provider to this patient record! ",! D Q
.S DIC="^BDPRECN(",DIC(0)="L",DLAYGO=90360.1,DIC("DR")=".02////"_BDPDFN,X=BDPTYPE
.D FILE^BDPFMC
.I Y<0 W !,"Error creating DESIGNATED PROVIDER.",!,"Notify programmer.",! D EOP^BDP 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 BDPRIEN=+Y
.;SEEMS TO ME THE MULTIPLE IEN WILL ALWAYS BE 1 SO NO NEED TO GET THE LAST AND INACTIVATE IT OR PUT IN A STOP DATE
.I $D(BDPRIEN) D
.. Q:'BDPRIEN
.. S:'$D(^BDPRECN(BDPRIEN,1,0)) $P(^(0),U,2)="90360.11P"
.. S BDPLIEN=$P($G(^BDPRECN(BDPRIEN,1,0)),U,3) ;Last IEN in Multiple
.. I BDPLIEN="" S BDPLIEN=0
.. S BDPLNUM=$P($G(^BDPRECN(BDPRIEN,1,0)),U,4) ;Las Number in Multiple
.. I BDPLNUM="" S BDPLNUM=0
.. S BDPLIEN=BDPLIEN+1
.. S BDPLNUM=BDPLNUM+1
.. S $P(^BDPRECN(BDPRIEN,1,0),U,3)=BDPLIEN
.. S $P(^BDPRECN(BDPRIEN,1,0),U,4)=BDPLNUM
.. S BDPLINKI=1 ;tell fileman you are coming from bdp
.. S DR=".01///"_"`"_BDPPROV_";.04////"_DT ;ihs/cmi/lab - added effective date
.. S DIE="^BDPRECN("_BDPRIEN_",1,",DA(1)=BDPRIEN,DA=BDPLIEN D ^DIE K DIE,DR,DA,DINUM
. D PAUSE^BDP
.S BDPQ=0
.Q
EOJ ; END OF JOB
D ^BDPKILL
Q
;
;
INFORM ;Data Entry Explanation
;
W !,?20,"******************************"
W !,?3,"Utilize this Option to Add a NEW Designated Specialty Provider Record.",!
W ?3,"If the Patient has already been assigned an Existing Provider for the",!,?3,"Category selected - you must use the MODIFY Data Entry Menu Option",!,?3,"to CHANGE the Existing Provider for this Patient's Category Type.",!
W ?20,"******************************",!
Q
BDPADD ; IHS/CMI/TMJ - ADD A NEW 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 FOR
DO MAIN
IF BDPQ
QUIT
DO HDR^BDP
+4 DO EOJ
+5 QUIT
+6 ;
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 with adding a new Designated Provider"
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 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 IF $$GET1^DIQ(90360.3,BDPTYPE,.01)'="MESSAGE AGENT"
SET DIC("S")="I $D(^VA(200,""AK.PROVIDER"",$P($G(^VA(200,+Y,0)),U),+Y)),$P($G(^VA(200,+Y,""PS"")),U,4)="""""
+5 DO ^DIC
KILL DIC,DA
IF $DATA(DUOUT)
SET DIRUT=1
+6 IF $DATA(DIRUT)
QUIT
+7 IF +Y<1
SET BDPQ=1
QUIT
+8 SET BDPPROV=+Y
SET BDPRPROV=$PIECE(Y,U,2)
+9 ;Provider Print Name
SET BDPRPRVP=$PIECE(^VA(200,BDPPROV,0),U,1)
+10 SET BDPQ=0
+11 QUIT
+12 ;
ADD ; ADD NEW DESIGNATED PROVIDER RECORD
+1 SET BDPQ=1
+2 ;Check to see if this Patient already has 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>0
WRITE !!,?10,"This patient already has a Designated Provider Type",!," the Category you selected. See the Designated Provider Listing above."
+5 IF BDPRR>0
WRITE !!,"-Use the MOD menu item to change to a new CURRENT Provider for this Category Type-",!!
DO PAUSE^BDP
QUIT
+6 ;
+7 DO PROV
+8 IF BDPQ
QUIT
ASKGO ;Ask to continue
+1 ;
+2 WRITE !!,"Okay, you have selected DESIGNATED PROVIDER : ",BDPRPRVP,!
+3 WRITE "To be assigned to Patient Name: "_$PIECE($GET(^DPT(BDPDFN,0)),U,1)
WRITE !
+4 WRITE "For Designated Provider Category/Type: "_$PIECE($GET(^BDPTCAT(BDPTYPE,0)),U,1)
WRITE !!
+5 ;
+6 ;
+7 SET DIR(0)="Y"
SET DIR("A")="Do you wish to Continue with the Adding of the new 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
+8 IF $DATA(DIRUT)
SET BDPQ=1
QUIT
+9 IF Y=0
SET BDPQ=1
QUIT
+10 WRITE !!,"Okay I will add this provider to this patient record! ",!
Begin DoDot:1
+11 SET DIC="^BDPRECN("
SET DIC(0)="L"
SET DLAYGO=90360.1
SET DIC("DR")=".02////"_BDPDFN
SET X=BDPTYPE
+12 DO FILE^BDPFMC
+13 IF Y<0
WRITE !,"Error creating DESIGNATED PROVIDER.",!,"Notify programmer.",!
DO EOP^BDP
QUIT
+14 WRITE !!,"DESIGNATED PROVIDER : ",BDPRPRVP,!
+15 WRITE "Has been assigned to Patient Name: "_$PIECE($GET(^DPT(BDPDFN,0)),U,1)
WRITE !
+16 WRITE "For Designated Provider Category/Type: "_$PIECE($GET(^BDPTCAT(BDPTYPE,0)),U,1)
WRITE !!
+17 SET BDPRIEN=+Y
+18 ;SEEMS TO ME THE MULTIPLE IEN WILL ALWAYS BE 1 SO NO NEED TO GET THE LAST AND INACTIVATE IT OR PUT IN A STOP DATE
+19 IF $DATA(BDPRIEN)
Begin DoDot:2
+20 IF 'BDPRIEN
QUIT
+21 IF '$DATA(^BDPRECN(BDPRIEN,1,0))
SET $PIECE(^(0),U,2)="90360.11P"
+22 ;Last IEN in Multiple
SET BDPLIEN=$PIECE($GET(^BDPRECN(BDPRIEN,1,0)),U,3)
+23 IF BDPLIEN=""
SET BDPLIEN=0
+24 ;Las Number in Multiple
SET BDPLNUM=$PIECE($GET(^BDPRECN(BDPRIEN,1,0)),U,4)
+25 IF BDPLNUM=""
SET BDPLNUM=0
+26 SET BDPLIEN=BDPLIEN+1
+27 SET BDPLNUM=BDPLNUM+1
+28 SET $PIECE(^BDPRECN(BDPRIEN,1,0),U,3)=BDPLIEN
+29 SET $PIECE(^BDPRECN(BDPRIEN,1,0),U,4)=BDPLNUM
+30 ;tell fileman you are coming from bdp
SET BDPLINKI=1
+31 ;ihs/cmi/lab - added effective date
SET DR=".01///"_"`"_BDPPROV_";.04////"_DT
+32 SET DIE="^BDPRECN("_BDPRIEN_",1,"
SET DA(1)=BDPRIEN
SET DA=BDPLIEN
DO ^DIE
KILL DIE,DR,DA,DINUM
End DoDot:2
+33 DO PAUSE^BDP
+34 SET BDPQ=0
+35 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 !,?3,"Utilize this Option to Add a NEW Designated Specialty Provider Record.",!
+4 WRITE ?3,"If the Patient has already been assigned an Existing Provider for the",!,?3,"Category selected - you must use the MODIFY Data Entry Menu Option",!,?3,"to CHANGE the Existing Provider for this Patient's Category Type.",!
+5 WRITE ?20,"******************************",!
+6 QUIT
