APCDVLK.m

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