APCDVLK ; IHS/CMI/LAB - VISIT LOOKUP ;
;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
;IHS/CMI/LAB - added VCN display
;
;EP;CALLED BY THIS PACKAGE AND OTHER PACKAGES
;This routine is a 'published', callable entry point used to
;look-up a visit for a patient.
;Called by QA.
;Caller can pass the visit date in APCDVLDT or this routine
;will prompt for the visit date/time.
;Variable APCDPAT must contain the patient DFN.
;User will be returned the following variables:
;APCDVSIT-ien of visit
;APCDCAT-service category of visit
;APCDTYPE-type of visit
;APCDDATE-date of visit
;APCDCLN-clinic of visit
;APCDLOC-location of visit
;APCDPAT-patient dfn
;Caller is responsible for killing these variables
;This routine is called by INPUT TEMPLATES, therefore, I would
;prefer NOT to use DIR for reads until I'm sure that DIE and DIR
;do not collide with each other. Especially using the variables
;X and Y.
; ADD DUZ(2) LOGIC WHEN STABLE ********
S U="^",APCDLOOK=""
I $D(APCDVLK),APCDVLK S APCDLOOK=APCDVLK Q ;*** FOR MODIFY IN ADD MODE ***
I $D(APCDVLDT) S Y=$P(APCDVLDT,".") G VDPASSED
RDV W !,"Enter VISIT date: " R X:$S($D(DTIME):DTIME,1:300) S:'$T X="" I X=" " W $C(7)," ??" G RDV
Q:X=""!(X="^")
S %DT="EX" D ^%DT
G:X="?" RDV
I Y<0 K Y Q
VDPASSED ; FOR CALLER PASSING VISIT DATE
K APCDVLKT
S APCDVLDC=Y,(APCDVLI,APCDVLV)=0 K Y
;IHS/CMI/LAB - modified to use AA xref rather than AC to speed it up
;F APCDVLL=0:0 S APCDVLV=$O(^AUPNVSIT("AC",APCDPAT,APCDVLV)) Q:APCDVLV="" I APCDVLDC=$P(+^AUPNVSIT(APCDVLV,0),"."),'$P(^(0),U,11) D
S APCDVLID=9999999-APCDVLDC,APCDVLL=$$FMADD^XLFDT(APCDVLDC,1),APCDVLL=9999999-APCDVLL,APCDVLL=APCDVLL_".9999"
F S APCDVLL=$O(^AUPNVSIT("AA",APCDPAT,APCDVLL)) Q:APCDVLL'=+APCDVLL!($P(APCDVLL,".")'=APCDVLID) D
.S APCDVLV=0 F S APCDVLV=$O(^AUPNVSIT("AA",APCDPAT,APCDVLL,APCDVLV)) Q:APCDVLV'=+APCDVLV I $D(^AUPNVSIT(APCDVLV,0)),'$P(^(0),U,11) D
..S APCDVLI=APCDVLI+1,APCDVLKT(APCDVLI)=APCDVLV
.Q
G:'$D(APCDVLKT) XIT
I APCDVLI=1,'$D(APCDVLDT) S APCDLOOK=APCDVLKT(1) G XIT
SELECT ; SELECT EXISTING VISIT
W !!,"PATIENT: ",$P(^DPT(APCDPAT,0),U)," has one or more VISITs on this date.",!
S APCDVLI="" F APCDVLL=0:0 S APCDVLI=$O(APCDVLKT(APCDVLI)) Q:APCDVLI="" S APCDVLX=^AUPNVSIT(APCDVLKT(APCDVLI),0),APCDA11=$G(^AUPNVSIT(APCDVLKT(APCDVLI),11)) D WRITE
S APCDVLV=""
SRDR W !!,"Select one: " R APCDVLI:$S($D(DTIME):DTIME,1:300) I '$T S APCDVLI=""
G:APCDVLI=""!(APCDVLI="^") XIT
I APCDVLI'?1N.N W $C(7),$C(7) G SELECT
I '$D(APCDVLKT(APCDVLI)) W $C(7),$C(7) G SELECT
S APCDLOOK=APCDVLKT(APCDVLI)
G XIT
;
WRITE ; WRITE VISITS FOR SELECT
S APCDVLT=$P(+APCDVLX,".",2),APCDVLT=$S(APCDVLT="":"<NONE>",$L(APCDVLT)=1:APCDVLT_"0:00 ",1:$E(APCDVLT,1,2)_":"_$E(APCDVLT,3,4)_$E("00",1,2-$L($E(APCDVLT,3,4)))_" ")
S APCDVLOC=""
I $P(APCDVLX,U,6),$D(^AUTTLOC($P(APCDVLX,U,6),0)) S APCDVLOC=$P(^(0),U,7),APCDVLOC=APCDVLOC_$E(" ",1,4-$L(APCDVLOC))
S:APCDVLOC="" APCDVLOC="...."
W !,APCDVLI," TIME: ",APCDVLT,"LOC: ",APCDVLOC," TYPE: ",$P(APCDVLX,U,3)," CAT: ",$P(APCDVLX,U,7)," CLINIC: ",$S($P(APCDVLX,U,8)]"":$E($P(^DIC(40.7,$P(APCDVLX,U,8),0),U),1,8),1:"<NONE>") D
.W ?57,"DEC: ",$S($P(APCDVLX,U,9):$P(APCDVLX,U,9),1:0),$S($P(APCDA11,U,3)]"":" VCN:"_$P(APCDA11,U,3),1:"")
.I $P(APCDVLX,U,22) W !?3,"Hospital Location: ",$P($G(^SC($P(APCDVLX,U,22),0)),U)
.I $$PRIMPROV^APCLV(APCDVLKT(APCDVLI))]"" W !?3,"Primary Provider: ",$$PRIMPROV^APCLV(APCDVLKT(APCDVLI),"N")
K APCDVLT,APCDVLOC
Q
;
XIT ; KILL VARIABLES AND QUIT
I APCDLOOK S APCDVSIT=APCDLOOK,APCDDATE=+^AUPNVSIT(APCDLOOK,0),APCDTYPE=$P(^AUPNVSIT(APCDLOOK,0),U,3),APCDCAT=$P(^(0),U,7),APCDLOC=$P(^(0),U,6),APCDCLN=$P(^(0),U,8)
I APCDVLI="^",$D(APCDGHVD) S APCDGHVD="^"
K APCDVLDC,APCDVLDT,APCDVLI,APCDVLKT,APCDVLL,APCDVLOC,APCDVLT,APCDVLV,APCDVLX,Y,APCDA11,APCDVLID
Q
APCDVLK ; IHS/CMI/LAB - VISIT LOOKUP ;
+1 ;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
+2 ;IHS/CMI/LAB - added VCN display
+3 ;
+4 ;EP;CALLED BY THIS PACKAGE AND OTHER PACKAGES
+5 ;This routine is a 'published', callable entry point used to
+6 ;look-up a visit for a patient.
+7 ;Called by QA.
+8 ;Caller can pass the visit date in APCDVLDT or this routine
+9 ;will prompt for the visit date/time.
+10 ;Variable APCDPAT must contain the patient DFN.
+11 ;User will be returned the following variables:
+12 ;APCDVSIT-ien of visit
+13 ;APCDCAT-service category of visit
+14 ;APCDTYPE-type of visit
+15 ;APCDDATE-date of visit
+16 ;APCDCLN-clinic of visit
+17 ;APCDLOC-location of visit
+18 ;APCDPAT-patient dfn
+19 ;Caller is responsible for killing these variables
+20 ;This routine is called by INPUT TEMPLATES, therefore, I would
+21 ;prefer NOT to use DIR for reads until I'm sure that DIE and DIR
+22 ;do not collide with each other. Especially using the variables
+23 ;X and Y.
+24 ; ADD DUZ(2) LOGIC WHEN STABLE ********
+25 SET U="^"
SET APCDLOOK=""
+26 ;*** FOR MODIFY IN ADD MODE ***
IF $DATA(APCDVLK)
IF APCDVLK
SET APCDLOOK=APCDVLK
QUIT
+27 IF $DATA(APCDVLDT)
SET Y=$PIECE(APCDVLDT,".")
GOTO VDPASSED
RDV WRITE !,"Enter VISIT date: "
READ X:$SELECT($DATA(DTIME):DTIME,1:300)
IF '$TEST
SET X=""
IF X=" "
WRITE $CHAR(7)," ??"
GOTO RDV
+1 IF X=""!(X="^")
QUIT
+2 SET %DT="EX"
DO ^%DT
+3 IF X="?"
GOTO RDV
+4 IF Y<0
KILL Y
QUIT
VDPASSED ; FOR CALLER PASSING VISIT DATE
+1 KILL APCDVLKT
+2 SET APCDVLDC=Y
SET (APCDVLI,APCDVLV)=0
KILL Y
+3 ;IHS/CMI/LAB - modified to use AA xref rather than AC to speed it up
+4 ;F APCDVLL=0:0 S APCDVLV=$O(^AUPNVSIT("AC",APCDPAT,APCDVLV)) Q:APCDVLV="" I APCDVLDC=$P(+^AUPNVSIT(APCDVLV,0),"."),'$P(^(0),U,11) D
+5 SET APCDVLID=9999999-APCDVLDC
SET APCDVLL=$$FMADD^XLFDT(APCDVLDC,1)
SET APCDVLL=9999999-APCDVLL
SET APCDVLL=APCDVLL_".9999"
+6 FOR
SET APCDVLL=$ORDER(^AUPNVSIT("AA",APCDPAT,APCDVLL))
IF APCDVLL'=+APCDVLL!($PIECE(APCDVLL,".")'=APCDVLID)
QUIT
Begin DoDot:1
+7 SET APCDVLV=0
FOR
SET APCDVLV=$ORDER(^AUPNVSIT("AA",APCDPAT,APCDVLL,APCDVLV))
IF APCDVLV'=+APCDVLV
QUIT
IF $DATA(^AUPNVSIT(APCDVLV,0))
IF '$PIECE(^(0),U,11)
Begin DoDot:2
+8 SET APCDVLI=APCDVLI+1
SET APCDVLKT(APCDVLI)=APCDVLV
End DoDot:2
+9 QUIT
End DoDot:1
+10 IF '$DATA(APCDVLKT)
GOTO XIT
+11 IF APCDVLI=1
IF '$DATA(APCDVLDT)
SET APCDLOOK=APCDVLKT(1)
GOTO XIT
SELECT ; SELECT EXISTING VISIT
+1 WRITE !!,"PATIENT: ",$PIECE(^DPT(APCDPAT,0),U)," has one or more VISITs on this date.",!
+2 SET APCDVLI=""
FOR APCDVLL=0:0
SET APCDVLI=$ORDER(APCDVLKT(APCDVLI))
IF APCDVLI=""
QUIT
SET APCDVLX=^AUPNVSIT(APCDVLKT(APCDVLI),0)
SET APCDA11=$GET(^AUPNVSIT(APCDVLKT(APCDVLI),11))
DO WRITE
+3 SET APCDVLV=""
SRDR WRITE !!,"Select one: "
READ APCDVLI:$SELECT($DATA(DTIME):DTIME,1:300)
IF '$TEST
SET APCDVLI=""
+1 IF APCDVLI=""!(APCDVLI="^")
GOTO XIT
+2 IF APCDVLI'?1N.N
WRITE $CHAR(7),$CHAR(7)
GOTO SELECT
+3 IF '$DATA(APCDVLKT(APCDVLI))
WRITE $CHAR(7),$CHAR(7)
GOTO SELECT
+4 SET APCDLOOK=APCDVLKT(APCDVLI)
+5 GOTO XIT
+6 ;
WRITE ; WRITE VISITS FOR SELECT
+1 SET APCDVLT=$PIECE(+APCDVLX,".",2)
SET APCDVLT=$SELECT(APCDVLT="":"<NONE>",$LENGTH(APCDVLT)=1:APCDVLT_"0:00 ",1:$EXTRACT(APCDVLT,1,2)_":"_$EXTRACT(APCDVLT,3,4)_$EXTRACT("00",1,2-$LENGTH($EXTRACT(APCDVLT,3,4)))_" ")
+2 SET APCDVLOC=""
+3 IF $PIECE(APCDVLX,U,6)
IF $DATA(^AUTTLOC($PIECE(APCDVLX,U,6),0))
SET APCDVLOC=$PIECE(^(0),U,7)
SET APCDVLOC=APCDVLOC_$EXTRACT(" ",1,4-$LENGTH(APCDVLOC))
+4 IF APCDVLOC=""
SET APCDVLOC="...."
+5 WRITE !,APCDVLI," TIME: ",APCDVLT,"LOC: ",APCDVLOC," TYPE: ",$PIECE(APCDVLX,U,3)," CAT: ",$PIECE(APCDVLX,U,7)," CLINIC: ",$SELECT($PIECE(APCDVLX,U,8)]"":$EXTRACT($PIECE(^DIC(40.7,$PIECE(APCDVLX,U,8),0),U),1,8),1:"<NONE>")
Begin DoDot:1
+6 WRITE ?57,"DEC: ",$SELECT">SELECT($PIECE(APCDVLX,U,9):$PIECE(APCDVLX,U,9),1:0),$SELECT">SELECT($PIECE(APCDA11,U,3)]"":" VCN:"_$PIECE(APCDA11,U,3),1:"")
+7 IF $PIECE(APCDVLX,U,22)
WRITE !?3,"Hospital Location: ",$PIECE($GET(^SC($PIECE(APCDVLX,U,22),0)),U)
+8 IF $$PRIMPROV^APCLV(APCDVLKT(APCDVLI))]""
WRITE !?3,"Primary Provider: ",$$PRIMPROV^APCLV(APCDVLKT(APCDVLI),"N")
End DoDot:1
+9 KILL APCDVLT,APCDVLOC
+10 QUIT
+11 ;
XIT ; KILL VARIABLES AND QUIT
+1 IF APCDLOOK
SET APCDVSIT=APCDLOOK
SET APCDDATE=+^AUPNVSIT(APCDLOOK,0)
SET APCDTYPE=$PIECE(^AUPNVSIT(APCDLOOK,0),U,3)
SET APCDCAT=$PIECE(^(0),U,7)
SET APCDLOC=$PIECE(^(0),U,6)
SET APCDCLN=$PIECE(^(0),U,8)
+2 IF APCDVLI="^"
IF $DATA(APCDGHVD)
SET APCDGHVD="^"
+3 KILL APCDVLDC,APCDVLDT,APCDVLI,APCDVLKT,APCDVLL,APCDVLOC,APCDVLT,APCDVLV,APCDVLX,Y,APCDA11,APCDVLID
+4 QUIT
