- 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
