BDPCOMA ; IHS/CMI/TMJ - ADD RECORDS FOR A PARTICULAR COMMUNITY ;
;;2.0;IHS PCC SUITE;**10,21**;MAY 14, 2009;Build 34
;
;This routine adds patient living in a selected community
;for a selected Provider and Provider Type
;If Matching Record Exists no update is done
;
;
; 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
;
D MAIN Q:BDPQ D HDR^BDP
D EOJ
Q
;
MAIN ;
S BDPQ=0
D COM ; get patient Community
Q:BDPQ
D PROV
I BDPQ=1 G MAIN
;
D ASK
Q:BDPQ
;
GETTYPE ;Do Get Date if no existing Designated Providers
D TYPE ; get Provider Category Type
Q:BDPQ
D ASKGO ; add new Designated Provider record
S BDPQ=0
Q
;
COM ; GET COMMUNITY
S DIC="^AUTTCOM(",DIC(0)="AEMQ",DIC("A")="Select a Particular COMMUNITY: " D ^DIC K DIC
I Y=-1 S BDPQ=1 Q
S BDPCOMN=+Y
Q:BDPCOMN=""
S BDPCOMP=$P($G(^AUTTCOM(BDPCOMN,0)),U,1) ;Community Text
Q:BDPCOMP=""
Q
;
;
;
ASK ;Ask to Continue
S BDPQ=0
W !! S DIR(0)="Y",DIR("A")="Do you want to continue changing the Designated Provider for each Patient living in this Community",DIR("B")="Y" K DA D ^DIR K DIR
I $D(DIRUT) S BDPQ=1 Q
I 'Y S BDPQ=1 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)
I $P(^BDPTCAT(BDPTYPE,0),U,1)="MESSAGE AGENT",'$D(^BDPMSGA("B",BDPPROV)) D G TYPE
.W !!,"The provider you selected is not listed as a Message Agent, he/she must "
.W !,"be added to the Message Agent List using the option on the Manager's "
.W !,"Menu before they can be assigned as a message agent.",!
I $P(^BDPTCAT(BDPTYPE,0),U,1)="MESSAGE AGENT",$P($G(^BDPMSGA(BDPPROV,0)),U,3) D G TYPE
.W !!,"The provider you selected has been inactivated as a message agent, he/she"
.W !," must be reactivated using the option on the Manager's Menu before they can "
.W !,"be assigned as a message agent.",!
;
;
S BDPQ=0
Q
PROV ; GET DESIGNATED PROVIDER
S BDPPROV="",BDPQ=0
S DIC("A")="Select New Designated Provider: ",DIC="^VA(200,",DIC(0)="AEMQ" D ^DIC K DIC,DA S:$D(DUOUT) DIRUT=1,BDPQ=1
Q:$D(DIRUT)
I +Y<1 S BDPQ=1 Q
S X=$$CHKPROV^BDPDPEE(+Y) I X 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
;
ASKGO ;Ask to continue
;
W !!!,?8,"**********************************************",!
W !!,?8,"Okay, you have selected DESIGNATED PROVIDER : ",BDPRPRVP,!
W ?8,"To be assigned to Patients living in Community Named: "_BDPCOMP 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
;
;
ADDCOM ;Add Patients in this Community to File
;
;S BDPPAT=""
S BDPIEN="" F S BDPIEN=$O(^BDPRECN("B",BDPTYPE,BDPIEN)) Q:BDPIEN'=+BDPIEN D
. S BDPPAT=$P($G(^BDPRECN(BDPIEN,0)),U,2) ;Get Patient
. Q:BDPPAT="" ;Quit if Patient Missing
. S BDPTYPEM=$P($G(^BDPRECN(BDPIEN,0)),U) ;Type of Match On
. Q:BDPTYPEM=""
. Q:BDPTYPE=""
. I BDPTYPE'=BDPTYPEM Q ;Quit No Match on Type
. S BDPCMCK=$P($G(^AUPNPAT(BDPPAT,11)),U,17) ;Get Patients Existing Community IEN
. I BDPCMCK'=BDPCOMN Q ;Quit if No Match On Community
. Q:BDPPAT=""
. Q:BDPTYPE=""
. Q:BDPPROV=""
. S X=$$CREATE^BDPAMA(BDPPAT,BDPTYPE,BDPPROV) Q
. ;
;
;
MSGEND ;End of Add Message
W !!!!,"Okay - I have changed all Patient Records - as follows: ",! D Q
.W !,"DESIGNATED PROVIDER : ",BDPRPRVP,!
. W "Has been assigned to Patients Living in Community: "_BDPCOMP W !
. W "For Designated Provider Category/Type: "_$P($G(^BDPTCAT(BDPTYPE,0)),U,1) W !!
. W "Note: If this Designated Provider already existed for the patient",!,?7," - No change was made to the patient record-.",!
. D PAUSE^BDP
S BDPQ=0
Q
;
;
EOJ ; END OF JOB
D ^BDPKILL
Q
;
;
INFORM ;Data Entry Explanation
;
W !,?3,"This Option allows automatic UPDATE of Existing Records for Patients",!,?15,"Living in a Selected C0MMUNITY",!
W !?3,"The patient must have been assigned a provider for the category ",!,"you select in the past in order to be updated by this option."
W !?3,"If the patient has never been assigned a provider in the category you select",!?3,"they will not be updated even though they live in the community you select."
W !,?3,"The User is prompted for the COMMUNITY Name and the desired Provider Name.",!
W ?3,"Once the desired Provider Category Type is selected by the User,",!
W ?3,"the Program will automatically LOOP through all existing Patient Records and",!,?3,"Update the selected Current Provider for this Category Type.",!!
W ?3,"If the patient's Current Provider/Category Type/Community",!,?3,"are the same, no updating will occur.",!
BDPCOMA ; IHS/CMI/TMJ - ADD RECORDS FOR A PARTICULAR COMMUNITY ;
+1 ;;2.0;IHS PCC SUITE;**10,21**;MAY 14, 2009;Build 34
+2 ;
+3 ;This routine adds patient living in a selected community
+4 ;for a selected Provider and Provider Type
+5 ;If Matching Record Exists no update is done
+6 ;
+7 ;
+8 ; Subscripted BDPREC is EXTERNAL form.
+9 ; BDPREC("PAT NAME")=patient name
+10 ; BDPREC("PROV TYPE")=Provider Category Type
+11 ; BDPDFN=patient ien
+12 ; BDPRDATE=date in internal FileMan form
+13 ; BDPRIEN=Designated Provider ien
+14 ;
START ;
+1 ;
+2 ;Data Entry Explanation
DO INFORM
+3 ;
+4 DO MAIN
IF BDPQ
QUIT
DO HDR^BDP
+5 DO EOJ
+6 QUIT
+7 ;
MAIN ;
+1 SET BDPQ=0
+2 ; get patient Community
DO COM
+3 IF BDPQ
QUIT
+4 DO PROV
+5 IF BDPQ=1
GOTO MAIN
+6 ;
+7 DO ASK
+8 IF BDPQ
QUIT
+9 ;
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 ASKGO
+4 SET BDPQ=0
+5 QUIT
+6 ;
COM ; GET COMMUNITY
+1 SET DIC="^AUTTCOM("
SET DIC(0)="AEMQ"
SET DIC("A")="Select a Particular COMMUNITY: "
DO ^DIC
KILL DIC
+2 IF Y=-1
SET BDPQ=1
QUIT
+3 SET BDPCOMN=+Y
+4 IF BDPCOMN=""
QUIT
+5 ;Community Text
SET BDPCOMP=$PIECE($GET(^AUTTCOM(BDPCOMN,0)),U,1)
+6 IF BDPCOMP=""
QUIT
+7 QUIT
+8 ;
+9 ;
+10 ;
ASK ;Ask to Continue
+1 SET BDPQ=0
+2 WRITE !!
SET DIR(0)="Y"
SET DIR("A")="Do you want to continue changing the Designated Provider for each Patient living in this Community"
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 ;
+7 ;
TYPE ; GET CATEGORY TYPE FOR DESIGNATED PROVIDER
+1 WRITE !
+2 SET BDPQ=1
+3 SET DIR(0)="90360.1,.01"
SET DIR("B")="DPCP"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
QUIT
+5 SET BDPTYPE=+Y
SET BDPREC("PROV TYPE")=Y(0)
+6 IF $PIECE(^BDPTCAT(BDPTYPE,0),U,1)="MESSAGE AGENT"
IF '$DATA(^BDPMSGA("B",BDPPROV))
Begin DoDot:1
+7 WRITE !!,"The provider you selected is not listed as a Message Agent, he/she must "
+8 WRITE !,"be added to the Message Agent List using the option on the Manager's "
+9 WRITE !,"Menu before they can be assigned as a message agent.",!
End DoDot:1
GOTO TYPE
+10 IF $PIECE(^BDPTCAT(BDPTYPE,0),U,1)="MESSAGE AGENT"
IF $PIECE($GET(^BDPMSGA(BDPPROV,0)),U,3)
Begin DoDot:1
+11 WRITE !!,"The provider you selected has been inactivated as a message agent, he/she"
+12 WRITE !," must be reactivated using the option on the Manager's Menu before they can "
+13 WRITE !,"be assigned as a message agent.",!
End DoDot:1
GOTO TYPE
+14 ;
+15 ;
+16 SET BDPQ=0
+17 QUIT
PROV ; GET DESIGNATED PROVIDER
+1 SET BDPPROV=""
SET BDPQ=0
+2 SET DIC("A")="Select New Designated Provider: "
SET DIC="^VA(200,"
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC,DA
IF $DATA(DUOUT)
SET DIRUT=1
SET BDPQ=1
+3 IF $DATA(DIRUT)
QUIT
+4 IF +Y<1
SET BDPQ=1
QUIT
+5 SET X=$$CHKPROV^BDPDPEE(+Y)
IF X
SET BDPQ=1
QUIT
+6 SET BDPPROV=+Y
SET BDPRPROV=$PIECE(Y,U,2)
+7 ;Provider Print Name
SET BDPRPRVP=$PIECE(^VA(200,BDPPROV,0),U,1)
+8 SET BDPQ=0
+9 QUIT
+10 ;
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 Patients living in Community Named: "_BDPCOMP
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 ;
+13 ;
ADDCOM ;Add Patients in this Community to File
+1 ;
+2 ;S BDPPAT=""
+3 SET BDPIEN=""
FOR
SET BDPIEN=$ORDER(^BDPRECN("B",BDPTYPE,BDPIEN))
IF BDPIEN'=+BDPIEN
QUIT
Begin DoDot:1
+4 ;Get Patient
SET BDPPAT=$PIECE($GET(^BDPRECN(BDPIEN,0)),U,2)
+5 ;Quit if Patient Missing
IF BDPPAT=""
QUIT
+6 ;Type of Match On
SET BDPTYPEM=$PIECE($GET(^BDPRECN(BDPIEN,0)),U)
+7 IF BDPTYPEM=""
QUIT
+8 IF BDPTYPE=""
QUIT
+9 ;Quit No Match on Type
IF BDPTYPE'=BDPTYPEM
QUIT
+10 ;Get Patients Existing Community IEN
SET BDPCMCK=$PIECE($GET(^AUPNPAT(BDPPAT,11)),U,17)
+11 ;Quit if No Match On Community
IF BDPCMCK'=BDPCOMN
QUIT
+12 IF BDPPAT=""
QUIT
+13 IF BDPTYPE=""
QUIT
+14 IF BDPPROV=""
QUIT
+15 SET X=$$CREATE^BDPAMA(BDPPAT,BDPTYPE,BDPPROV)
QUIT
+16 ;
End DoDot:1
+17 ;
+18 ;
MSGEND ;End of Add Message
+1 WRITE !!!!,"Okay - I have changed all Patient Records - as follows: ",!
Begin DoDot:1
+2 WRITE !,"DESIGNATED PROVIDER : ",BDPRPRVP,!
+3 WRITE "Has been assigned to Patients Living in Community: "_BDPCOMP
WRITE !
+4 WRITE "For Designated Provider Category/Type: "_$PIECE($GET(^BDPTCAT(BDPTYPE,0)),U,1)
WRITE !!
+5 WRITE "Note: If this Designated Provider already existed for the patient",!,?7," - No change was made to the patient record-.",!
+6 DO PAUSE^BDP
End DoDot:1
QUIT
+7 SET BDPQ=0
+8 QUIT
+9 ;
+10 ;
EOJ ; END OF JOB
+1 DO ^BDPKILL
+2 QUIT
+3 ;
+4 ;
INFORM ;Data Entry Explanation
+1 ;
+2 WRITE !,?3,"This Option allows automatic UPDATE of Existing Records for Patients",!,?15,"Living in a Selected C0MMUNITY",!
+3 WRITE !?3,"The patient must have been assigned a provider for the category ",!,"you select in the past in order to be updated by this option."
+4 WRITE !?3,"If the patient has never been assigned a provider in the category you select",!?3,"they will not be updated even though they live in the community you select."
+5 WRITE !,?3,"The User is prompted for the COMMUNITY Name and the desired Provider Name.",!
+6 WRITE ?3,"Once the desired Provider Category Type is selected by the User,",!
+7 WRITE ?3,"the Program will automatically LOOP through all existing Patient Records and",!,?3,"Update the selected Current Provider for this Category Type.",!!
+8 WRITE ?3,"If the patient's Current Provider/Category Type/Community",!,?3,"are the same, no updating will occur.",!
