BDPTRANS ; IHS/CMI/TMJ - TRANSFER FROM A TEMPLATE OF PATIENTS ;
;;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
;
D MAIN Q:BDPQ D HDR^BDP
D EOJ
Q
;
MAIN ;
S BDPQ=0
D TEMPLATE ; get patient Name
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
;
TEMPLATE ; GET TEMPLATE
;
TLOOK K DIC,DIRUT
S DIC="^DIBT(",DIC(0)="AEQZ",DIC("A")="Select SEARCH TEMPLATE: ",DIC("S")="I ($P(^(0),U,4)=2!($P(^(0),U,4)=9000001)),$D(^DIBT(+$G(Y),1))"
D ^DIC K DIC,DA,DR
I $D(DIRUT) S BDPQ=1 Q
I +Y<1 S BDPQ=1 Q
W !
S BDPTRN=+Y,BDPTRNA=$P(Y,U,2),(BDPRGTP,BDPI)=""
F BDPYI=1:1 S BDPI=$O(^DIBT(BDPTRN,1,BDPI)) Q:BDPI=""
W !!?10,"There are ",BDPYI-1," patients in this SEARCH TEMPLATE."
K BDPI,BDPYI
W !
S BDPYI=0
K BDPYI
W !
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 in this Template",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 in Template Named: "_BDPTRNA 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
;
;
ADDTEMP ;Add Patients in Template to File
;
;S BDPPAT=""
S BDPPAT="" F S BDPPAT=$O(^DIBT(BDPTRN,1,BDPPAT)) Q:BDPPAT'=+BDPPAT D
. 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 existing in Template: "_BDPTRNA 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 ADD/UPDATE of Records from a Patient TEMPLATE",!
W ?3,"The User is prompted for the TEMPLATE 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 the Template of Patients and",!,?3,"Add or Update the selected Current Provider for this Category Type.",!!
W ?3,"If an existing patient's Current Provider/Category Type are the same,",!,?3,"no update will occur.",!
Q
BDPTRANS ; IHS/CMI/TMJ - TRANSFER FROM A TEMPLATE OF PATIENTS ;
+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 DO MAIN
IF BDPQ
QUIT
DO HDR^BDP
+5 DO EOJ
+6 QUIT
+7 ;
MAIN ;
+1 SET BDPQ=0
+2 ; get patient Name
DO TEMPLATE
+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 ;
TEMPLATE ; GET TEMPLATE
+1 ;
TLOOK KILL DIC,DIRUT
+1 SET DIC="^DIBT("
SET DIC(0)="AEQZ"
SET DIC("A")="Select SEARCH TEMPLATE: "
SET DIC("S")="I ($P(^(0),U,4)=2!($P(^(0),U,4)=9000001)),$D(^DIBT(+$G(Y),1))"
+2 DO ^DIC
KILL DIC,DA,DR
+3 IF $DATA(DIRUT)
SET BDPQ=1
QUIT
+4 IF +Y<1
SET BDPQ=1
QUIT
+5 WRITE !
+6 SET BDPTRN=+Y
SET BDPTRNA=$PIECE(Y,U,2)
SET (BDPRGTP,BDPI)=""
+7 FOR BDPYI=1:1
SET BDPI=$ORDER(^DIBT(BDPTRN,1,BDPI))
IF BDPI=""
QUIT
+8 WRITE !!?10,"There are ",BDPYI-1," patients in this SEARCH TEMPLATE."
+9 KILL BDPI,BDPYI
+10 WRITE !
+11 SET BDPYI=0
+12 KILL BDPYI
+13 WRITE !
+14 QUIT
+15 ;
+16 ;
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 in this Template"
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 SET BDPQ=0
+16 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 in Template Named: "_BDPTRNA
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 ;
ADDTEMP ;Add Patients in Template to File
+1 ;
+2 ;S BDPPAT=""
+3 SET BDPPAT=""
FOR
SET BDPPAT=$ORDER(^DIBT(BDPTRN,1,BDPPAT))
IF BDPPAT'=+BDPPAT
QUIT
Begin DoDot:1
+4 IF BDPPAT=""
QUIT
+5 IF BDPTYPE=""
QUIT
+6 IF BDPPROV=""
QUIT
+7 SET X=$$CREATE^BDPAMA(BDPPAT,BDPTYPE,BDPPROV)
QUIT
+8 ;
End DoDot:1
+9 ;
+10 ;
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 existing in Template: "_BDPTRNA
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 ADD/UPDATE of Records from a Patient TEMPLATE",!
+3 WRITE ?3,"The User is prompted for the TEMPLATE Name and the desired Provider Name.",!
+4 WRITE ?3,"Once the desired Provider Category Type is selected by the User,",!
+5 WRITE ?3,"the Program will automatically LOOP through the Template of Patients and",!,?3,"Add or Update the selected Current Provider for this Category Type.",!!
+6 WRITE ?3,"If an existing patient's Current Provider/Category Type are the same,",!,?3,"no update will occur.",!
+7 QUIT
