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