- BMCADDP ;IHS/OIT/FCJ - LINK PCC VISIT/PROBLEM TO NEW REF
- ;;4.0;REFERRED CARE INFO SYSTEM;**8**;JAN 09, 2006;Build 101
- ;ABILITY TO SELECT A PCC VISIT ADD A NEW VISIT AND SELECT FROM THE PROBLEM LIST
- ;BMC*4.0*8 NEW ROUTINE IN PATCH 8
- ;
- DSPV ;DISPLAY VISITS FOR DEFINED PATIENT
- ;D ALLV^APCLAPIU(dfn,beg date,end date,array)
- K BMCV S BMCQ=0,BMCQ1=0
- S VCT=30,X1=DT,X2=-VCT D C^%DTC
- S BMCBDT=X,BMCEDT=DT
- ;S VCT=3330 USED FOR TESTING
- DSPV2 ;
- D ALLV^APCLAPIU(BMCDFN,BMCBDT,BMCEDT,"BMCV")
- I '$D(BMCV) D Q:BMCQ=1 G:BMCQ1>0 DSPV2
- .W !
- .S DIR("A")="Patient has not had a visit in the past "_VCT_" days, continue searching"
- .S DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR
- .I $D(DUOUT)!$D(DTOUT)!(+Y'>0) S BMCQ=1 Q
- .I +Y>0 S BMCQ1=+Y,VCT=VCT+30,X1=DT,X2=-VCT,BMCEDT=BMCBDT D C^%DTC S BMCBDT=X
- E D VDSP I BMCQ1=0 S BMCQ=0,VCT=VCT+30,X1=DT,X2=-VCT,BMCEDT=BMCBDT D C^%DTC S BMCBDT=X K BMCV G DSPV2
- K BMCV,BMCEDT,BMCBDT,BMCQ1,VCT
- Q
- ;
- VDSP ;DISPLAY VISTS
- S BMCQ1=0,BMCVCT=0,L=0 F S L=$O(BMCV(L)) Q:L'?1N.N S BMCVCT=BMCVCT+1
- W !!,"PATIENT VISITS:"
- F L=1:1:BMCVCT D Q:BMCQ1
- .S VDFN=$P(BMCV(L),U,5)
- .W !?5,$J(L,5),". ",$$VDTM^APCLV(VDFN,"E")," ",$$LOCENC^APCLV(VDFN,"E"),?40,$$PRIMPROV^APCLV(VDFN,"N")
- .W !,?13,$$PRIMPOV^APCLV(VDFN,"E")
- .I L#10=0 D
- ..S DIR("A")="Continue displaying visits",DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR
- ..S:+Y<1 BMCQ1=1
- ;
- VSEL ;SELECT A VIST
- W !
- S DIR("A")="Select a visit for the referral, Enter 1-"_L,DIR(0)="NO^1:"_L_":0"
- S DIR("?")="Select a visit from the list, if a visit is not selected you will need to add a new PCC Visit for this Patient"
- D ^DIR K DIR
- I +Y>0 S BMCVDFN=$P(BMCV(+Y),U,5),BMCQ1=1 D VUP Q
- I $D(DUOUT)!$D(DTOUT) D VADD Q
- I +Y<1 D
- .S DIR("A")="Continue displaying visits",DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR
- .I +Y<1 S BMCQ1=1 D VADD
- Q
- ;
- VADD ;Need to ADD A NEW VISIT
- W !!,"A visit was not selected you will need to select a visit or a New PCC Visit"
- W !!,"will need to be added for this Patient before entering a Referral."
- S BMCQ=1
- ;
- Q
- VUP ;UPDATE THE VISIT POINTER IN THE REF
- S DIE="^BMCREF(",DA=BMCRIEN
- S DR="1309////"_BMCVDFN
- D ^DIE
- K DIE
- Q
- BMCADDP ;IHS/OIT/FCJ - LINK PCC VISIT/PROBLEM TO NEW REF
- +1 ;;4.0;REFERRED CARE INFO SYSTEM;**8**;JAN 09, 2006;Build 101
- +2 ;ABILITY TO SELECT A PCC VISIT ADD A NEW VISIT AND SELECT FROM THE PROBLEM LIST
- +3 ;BMC*4.0*8 NEW ROUTINE IN PATCH 8
- +4 ;
- DSPV ;DISPLAY VISITS FOR DEFINED PATIENT
- +1 ;D ALLV^APCLAPIU(dfn,beg date,end date,array)
- +2 KILL BMCV
- SET BMCQ=0
- SET BMCQ1=0
- +3 SET VCT=30
- SET X1=DT
- SET X2=-VCT
- DO C^%DTC
- +4 SET BMCBDT=X
- SET BMCEDT=DT
- +5 ;S VCT=3330 USED FOR TESTING
- DSPV2 ;
- +1 DO ALLV^APCLAPIU(BMCDFN,BMCBDT,BMCEDT,"BMCV")
- +2 IF '$DATA(BMCV)
- Begin DoDot:1
- +3 WRITE !
- +4 SET DIR("A")="Patient has not had a visit in the past "_VCT_" days, continue searching"
- +5 SET DIR(0)="Y"
- SET DIR("B")="NO"
- DO ^DIR
- KILL DIR
- +6 IF $DATA(DUOUT)!$DATA(DTOUT)!(+Y'>0)
- SET BMCQ=1
- QUIT
- +7 IF +Y>0
- SET BMCQ1=+Y
- SET VCT=VCT+30
- SET X1=DT
- SET X2=-VCT
- SET BMCEDT=BMCBDT
- DO C^%DTC
- SET BMCBDT=X
- End DoDot:1
- IF BMCQ=1
- QUIT
- IF BMCQ1>0
- GOTO DSPV2
- +8 IF '$TEST
- DO VDSP
- IF BMCQ1=0
- SET BMCQ=0
- SET VCT=VCT+30
- SET X1=DT
- SET X2=-VCT
- SET BMCEDT=BMCBDT
- DO C^%DTC
- SET BMCBDT=X
- KILL BMCV
- GOTO DSPV2
- +9 KILL BMCV,BMCEDT,BMCBDT,BMCQ1,VCT
- +10 QUIT
- +11 ;
- VDSP ;DISPLAY VISTS
- +1 SET BMCQ1=0
- SET BMCVCT=0
- SET L=0
- FOR
- SET L=$ORDER(BMCV(L))
- IF L'?1N.N
- QUIT
- SET BMCVCT=BMCVCT+1
- +2 WRITE !!,"PATIENT VISITS:"
- +3 FOR L=1:1:BMCVCT
- Begin DoDot:1
- +4 SET VDFN=$PIECE(BMCV(L),U,5)
- +5 WRITE !?5,$JUSTIFY(L,5),". ",$$VDTM^APCLV(VDFN,"E")," ",$$LOCENC^APCLV(VDFN,"E"),?40,$$PRIMPROV^APCLV(VDFN,"N")
- +6 WRITE !,?13,$$PRIMPOV^APCLV(VDFN,"E")
- +7 IF L#10=0
- Begin DoDot:2
- +8 SET DIR("A")="Continue displaying visits"
- SET DIR(0)="Y"
- SET DIR("B")="NO"
- DO ^DIR
- KILL DIR
- +9 IF +Y<1
- SET BMCQ1=1
- End DoDot:2
- End DoDot:1
- IF BMCQ1
- QUIT
- +10 ;
- VSEL ;SELECT A VIST
- +1 WRITE !
- +2 SET DIR("A")="Select a visit for the referral, Enter 1-"_L
- SET DIR(0)="NO^1:"_L_":0"
- +3 SET DIR("?")="Select a visit from the list, if a visit is not selected you will need to add a new PCC Visit for this Patient"
- +4 DO ^DIR
- KILL DIR
- +5 IF +Y>0
- SET BMCVDFN=$PIECE(BMCV(+Y),U,5)
- SET BMCQ1=1
- DO VUP
- QUIT
- +6 IF $DATA(DUOUT)!$DATA(DTOUT)
- DO VADD
- QUIT
- +7 IF +Y<1
- Begin DoDot:1
- +8 SET DIR("A")="Continue displaying visits"
- SET DIR(0)="Y"
- SET DIR("B")="NO"
- DO ^DIR
- KILL DIR
- +9 IF +Y<1
- SET BMCQ1=1
- DO VADD
- End DoDot:1
- +10 QUIT
- +11 ;
- VADD ;Need to ADD A NEW VISIT
- +1 WRITE !!,"A visit was not selected you will need to select a visit or a New PCC Visit"
- +2 WRITE !!,"will need to be added for this Patient before entering a Referral."
- +3 SET BMCQ=1
- +4 ;
- +5 QUIT
- VUP ;UPDATE THE VISIT POINTER IN THE REF
- +1 SET DIE="^BMCREF("
- SET DA=BMCRIEN
- +2 SET DR="1309////"_BMCVDFN
- +3 DO ^DIE
- +4 KILL DIE
- +5 QUIT
