BDPTDEL ; IHS/CMI/TMJ - DELETE FROM A TEMPLATE OF PATIENTS ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
; 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 ; Get existing 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 DELETING the Designated Provider for each Patient in this Templates",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)
S BDPQ=0
Q
PROV ; GET DESIGNATED PROVIDER
S BDPPROV="",BDPQ=0
S DIC("A")="Select Existing 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 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 DELETED from 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 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
;
;
ADDTEMP ;Delete Patients in Template
;
;S BDPPAT=""
S BDPPAT="" F S BDPPAT=$O(^DIBT(BDPTRN,1,BDPPAT)) Q:BDPPAT'=+BDPPAT D
. Q:BDPPAT=""
. Q:BDPTYPE=""
. Q:BDPPROV=""
. D DELETE^BDPPASS 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 DELETED from Patients existing in Template: "_BDPTRNA W !
. W "For Designated Provider Category/Type: "_$P($G(^BDPTCAT(BDPTYPE,0)),U,1) W !!
. D PAUSE^BDP
S BDPQ=0
Q
;
;
EOJ ; END OF JOB
D ^BDPKILL
Q
;
;
INFORM ;Data Entry Explanation
;
W !,?3,"This Option allows automatic DELETE of Records from a Patient TEMPLATE",!
W ?3,"The User is prompted for the TEMPLATE 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,"DELETE the selected Current Provider for this Category Type.",!!
W ?3,"If a patient (listed within the Template) does not currently exist in the",!,?3,"Management System, no Action will be taken",!
Q
BDPTDEL ; IHS/CMI/TMJ - DELETE FROM A TEMPLATE OF PATIENTS ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+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 ; Get existing 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 DELETING the Designated Provider for each Patient in this Templates"
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 SET BDPQ=0
+7 QUIT
PROV ; GET DESIGNATED PROVIDER
+1 SET BDPPROV=""
SET BDPQ=0
+2 SET DIC("A")="Select Existing 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 BDPPROV=+Y
SET BDPRPROV=$PIECE(Y,U,2)
+6 ;Provider Print Name
SET BDPRPRVP=$PIECE(^VA(200,BDPPROV,0),U,1)
+7 SET BDPQ=0
+8 QUIT
+9 ;
ASKGO ;Ask to continue
+1 ;
+2 WRITE !!!,?8,"**********************************************",!
+3 WRITE !!,?8,"Okay, you have selected DESIGNATED PROVIDER : ",BDPRPRVP,!
+4 WRITE ?8,"To be DELETED from 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 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
+10 IF $DATA(DIRUT)
SET BDPQ=1
QUIT
+11 IF Y=0
SET BDPQ=1
QUIT
+12 ;
+13 ;
ADDTEMP ;Delete Patients in Template
+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 DO DELETE^BDPPASS
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 DELETED from Patients existing in Template: "_BDPTRNA
WRITE !
+4 WRITE "For Designated Provider Category/Type: "_$PIECE($GET(^BDPTCAT(BDPTYPE,0)),U,1)
WRITE !!
+5 DO PAUSE^BDP
End DoDot:1
QUIT
+6 SET BDPQ=0
+7 QUIT
+8 ;
+9 ;
EOJ ; END OF JOB
+1 DO ^BDPKILL
+2 QUIT
+3 ;
+4 ;
INFORM ;Data Entry Explanation
+1 ;
+2 WRITE !,?3,"This Option allows automatic DELETE of Records from a Patient TEMPLATE",!
+3 WRITE ?3,"The User is prompted for the TEMPLATE 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,"DELETE the selected Current Provider for this Category Type.",!!
+6 WRITE ?3,"If a patient (listed within the Template) does not currently exist in the",!,?3,"Management System, no Action will be taken",!
+7 QUIT
