- 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
