APCDVMDD ; IHS/CMI/LAB - VISIT MERGE ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
W !!,"This option is used to merge 2 visits on 2 different dates.",!,"Be very careful in using this option. This will normally need to be used only",!,"when a lab or radiology visit that occurred after midnight needs to be merged",!
W "to a visit that occurred before midnight.",!!
;merge 2 visits during data entry process.
D GETPAT
I 'APCDPAT D EOJ Q
W !!,"Select 'From' visit.",!
S APCDVV="APCDVMF" D GETVISIT
I 'APCDVMF D EOJ Q
;S APCDVLDT=+^AUPNVSIT(APCDVMF,0)\1
W !!,"Select 'To' visit.",!
S APCDVV="APCDVMT" D GETVISIT
I 'APCDVMT D EOJ Q
I APCDVMF=APCDVMT W !!,"'From' and 'To' the same. Bye!" D EOJ Q
I $D(^ABSBITMS(9002302,"AD",APCDVMF)) W !!,"Cannot merge from a visit that has a Claim associate with it." D EOJ Q ;IHS/CMI/LAB - patch 3 per FSI
W !!!,"You will be merging the following 2 visits:"
W !,"FROM VISIT:" S APCDAX=APCDVMF D WRITE
W !,"TO VISIT:" S APCDAX=APCDVMT D WRITE
W !! S DIR(0)="Y",DIR("A")="Do you want to continue",DIR("B")="N" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D EOJ Q
I 'Y D EOJ Q
W !!,"*** FROM VISIT ***"
K DR S APCDVDSP=APCDVMF D ^APCDVDSP
W !!,"*** TO VISIT ***"
K DR S APCDVDSP=APCDVMT D ^APCDVDSP
EN1 ;EP
RDR ;EP
I 'APCDVMT W !!,$C(7),$C(7),"'TO' VISIT NOT DEFINED" D EOJ Q
I 'APCDVMF W !!,$C(7),$C(7),"'FROM' VISIT NOT DEFINED" D EOJ Q
R !!,"Do you want to merge the two visits? (Y/N) Y//",APCDVMX:$S($D(DTIME):DTIME,1:300) S:'$T APCDVMX="N" S:APCDVMX="" APCDVMX="Y" S APCDVMX=$E(APCDVMX) I "YyNn"'[APCDVMX W $C(7) G RDR
I "Nn"[APCDVMX D EOJ Q
D ^APCDVM2
I $D(APCDVMQF) W !!,"*** ERROR encountered. QFLG=",APCDVMQF D EOJ Q
S $P(^AUPNVSIT(APCDVMF,0),U,37)=APCDVMT ;direct set as visit is being deleted. set for billing
S $P(^AUPNVSIT(APCDVMF,22),U)="MERGED TO VISIT IEN "_APCDVMT
;UPDATE DELETE LOG
D UPDLOG^APCDVDEL(APCDVMF,APCDVMT)
S AUPNVSIT=APCDVMF D DEL^AUPNVSIT
W !!,"*** MERGED VISIT ***"
D ZTSK
K DR S APCDVDSP=APCDVMT D ^APCDVDSP
S APCDVSIT=APCDVMT D ^APCDVCHK K APCDVSIT
D EOJ
Q
;
GETPAT ; GET PATIENT
W !
S APCDPAT=""
S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC
Q:Y<0
S APCDPAT=+Y
Q
;
GETVISIT ;
K APCDVLK
S APCDLOOK=""
D ^APCDVLK
S @APCDVV=APCDLOOK
K APCDLOOK
Q
;
ZTSK ;
S X="APCDVM3" X ^%ZOSF("TEST") Q:'$T
K ZTSAVE F %="APCDVMF","APCDVMT" S ZTSAVE(%)=""
S ZTRTN="^APCDVM3",ZTDESC="PACKAGE VISIT MERGE",ZTIO="",ZTDTH=DT D ^%ZTLOAD
K ZTSK
Q
;
;
WRITE ; WRITE VISITS FOR SELECT
NEW APCDA11,APCDAT
S APCDA11=$G(^AUPNVSIT(APCDAX,11)),APCDAX=^AUPNVSIT(APCDAX,0)
S APCDAT=$P(+APCDAX,".",2),APCDAT=$S(APCDAT="":"<NONE>",$L(APCDAT)=1:APCDAT_"0:00 ",1:$E(APCDAT,1,2)_":"_$E(APCDAT,3,4)_$E("00",1,2-$L($E(APCDAT,3,4)))_" ")
W !,$$FMTE^XLFDT($P($P(APCDAX,U),"."))," TIME: ",APCDAT,"TYPE: ",$P(APCDAX,U,3)," CATEGORY: ",$P(APCDAX,U,7)
W " CLINIC: ",$S($P(APCDAX,U,8)]"":$E($P(^DIC(40.7,$P(APCDAX,U,8),0),U),1,8),1:"<NONE>"),?56,"DEC: ",$S($P(APCDAX,U,9):$P(APCDAX,U,9),1:0)
I $P(APCDA11,U,3)]"" W ?64,"VCN: ",$P(APCDA11,U,3)
K APCDAT
Q
EOJ ; EOJ CLEAN UP
K APCDCAT,APCDCLN,APCDDATE,APCDDOB,APCDDOD,APCDLOC,APCDPAT,APCDSEX,APCDTYPE,APCDVSIT,APCDVMF,APCDVMT,APCDVMX,APCDVV
K AUPNPAT,AUPNSEX,AUPNDAYS,AUPNDOB,AUPNVSIT,AUPNDOD
Q
APCDVMDD ; IHS/CMI/LAB - VISIT MERGE ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
+3 WRITE !!,"This option is used to merge 2 visits on 2 different dates.",!,"Be very careful in using this option. This will normally need to be used only",!,"when a lab or radiology visit that occurred after midnight needs to be merged",!
+4 WRITE "to a visit that occurred before midnight.",!!
+5 ;merge 2 visits during data entry process.
+6 DO GETPAT
+7 IF 'APCDPAT
DO EOJ
QUIT
+8 WRITE !!,"Select 'From' visit.",!
+9 SET APCDVV="APCDVMF"
DO GETVISIT
+10 IF 'APCDVMF
DO EOJ
QUIT
+11 ;S APCDVLDT=+^AUPNVSIT(APCDVMF,0)\1
+12 WRITE !!,"Select 'To' visit.",!
+13 SET APCDVV="APCDVMT"
DO GETVISIT
+14 IF 'APCDVMT
DO EOJ
QUIT
+15 IF APCDVMF=APCDVMT
WRITE !!,"'From' and 'To' the same. Bye!"
DO EOJ
QUIT
+16 ;IHS/CMI/LAB - patch 3 per FSI
IF $DATA(^ABSBITMS(9002302,"AD",APCDVMF))
WRITE !!,"Cannot merge from a visit that has a Claim associate with it."
DO EOJ
QUIT
+17 WRITE !!!,"You will be merging the following 2 visits:"
+18 WRITE !,"FROM VISIT:"
SET APCDAX=APCDVMF
DO WRITE
+19 WRITE !,"TO VISIT:"
SET APCDAX=APCDVMT
DO WRITE
+20 WRITE !!
SET DIR(0)="Y"
SET DIR("A")="Do you want to continue"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+21 IF $DATA(DIRUT)
DO EOJ
QUIT
+22 IF 'Y
DO EOJ
QUIT
+23 WRITE !!,"*** FROM VISIT ***"
+24 KILL DR
SET APCDVDSP=APCDVMF
DO ^APCDVDSP
+25 WRITE !!,"*** TO VISIT ***"
+26 KILL DR
SET APCDVDSP=APCDVMT
DO ^APCDVDSP
EN1 ;EP
RDR ;EP
+1 IF 'APCDVMT
WRITE !!,$CHAR(7),$CHAR(7),"'TO' VISIT NOT DEFINED"
DO EOJ
QUIT
+2 IF 'APCDVMF
WRITE !!,$CHAR(7),$CHAR(7),"'FROM' VISIT NOT DEFINED"
DO EOJ
QUIT
+3 READ !!,"Do you want to merge the two visits? (Y/N) Y//",APCDVMX:$SELECT($DATA(DTIME):DTIME,1:300)
IF '$TEST
SET APCDVMX="N"
IF APCDVMX=""
SET APCDVMX="Y"
SET APCDVMX=$EXTRACT(APCDVMX)
IF "YyNn"'[APCDVMX
WRITE $CHAR(7)
GOTO RDR
+4 IF "Nn"[APCDVMX
DO EOJ
QUIT
+5 DO ^APCDVM2
+6 IF $DATA(APCDVMQF)
WRITE !!,"*** ERROR encountered. QFLG=",APCDVMQF
DO EOJ
QUIT
+7 ;direct set as visit is being deleted. set for billing
SET $PIECE(^AUPNVSIT(APCDVMF,0),U,37)=APCDVMT
+8 SET $PIECE(^AUPNVSIT(APCDVMF,22),U)="MERGED TO VISIT IEN "_APCDVMT
+9 ;UPDATE DELETE LOG
+10 DO UPDLOG^APCDVDEL(APCDVMF,APCDVMT)
+11 SET AUPNVSIT=APCDVMF
DO DEL^AUPNVSIT
+12 WRITE !!,"*** MERGED VISIT ***"
+13 DO ZTSK
+14 KILL DR
SET APCDVDSP=APCDVMT
DO ^APCDVDSP
+15 SET APCDVSIT=APCDVMT
DO ^APCDVCHK
KILL APCDVSIT
+16 DO EOJ
+17 QUIT
+18 ;
GETPAT ; GET PATIENT
+1 WRITE !
+2 SET APCDPAT=""
+3 SET DIC="^AUPNPAT("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+4 IF Y<0
QUIT
+5 SET APCDPAT=+Y
+6 QUIT
+7 ;
GETVISIT ;
+1 KILL APCDVLK
+2 SET APCDLOOK=""
+3 DO ^APCDVLK
+4 SET @APCDVV=APCDLOOK
+5 KILL APCDLOOK
+6 QUIT
+7 ;
ZTSK ;
+1 SET X="APCDVM3"
XECUTE ^%ZOSF("TEST")
IF '$TEST
QUIT
+2 KILL ZTSAVE
FOR %="APCDVMF","APCDVMT"
SET ZTSAVE(%)=""
+3 SET ZTRTN="^APCDVM3"
SET ZTDESC="PACKAGE VISIT MERGE"
SET ZTIO=""
SET ZTDTH=DT
DO ^%ZTLOAD
+4 KILL ZTSK
+5 QUIT
+6 ;
+7 ;
WRITE ; WRITE VISITS FOR SELECT
+1 NEW APCDA11,APCDAT
+2 SET APCDA11=$GET(^AUPNVSIT(APCDAX,11))
SET APCDAX=^AUPNVSIT(APCDAX,0)
+3 SET APCDAT=$PIECE(+APCDAX,".",2)
SET APCDAT=$SELECT(APCDAT="":"<NONE>",$LENGTH(APCDAT)=1:APCDAT_"0:00 ",1:$EXTRACT(APCDAT,1,2)_":"_$EXTRACT(APCDAT,3,4)_$EXTRACT("00",1,2-$LENGTH($EXTRACT(APCDAT,3,4)))_" ")
+4 WRITE !,$$FMTE^XLFDT($PIECE($PIECE(APCDAX,U),"."))," TIME: ",APCDAT,"TYPE: ",$PIECE(APCDAX,U,3)," CATEGORY: ",$PIECE(APCDAX,U,7)
+5 WRITE " CLINIC: ",$SELECT($PIECE(APCDAX,U,8)]"":$EXTRACT($PIECE(^DIC(40.7,$PIECE(APCDAX,U,8),0),U),1,8),1:"<NONE>"),?56,"DEC: ",$SELECT($PIECE(APCDAX,U,9):$PIECE(APCDAX,U,9),1:0)
+6 IF $PIECE(APCDA11,U,3)]""
WRITE ?64,"VCN: ",$PIECE(APCDA11,U,3)
+7 KILL APCDAT
+8 QUIT
EOJ ; EOJ CLEAN UP
+1 KILL APCDCAT,APCDCLN,APCDDATE,APCDDOB,APCDDOD,APCDLOC,APCDPAT,APCDSEX,APCDTYPE,APCDVSIT,APCDVMF,APCDVMT,APCDVMX,APCDVV
+2 KILL AUPNPAT,AUPNSEX,AUPNDAYS,AUPNDOB,AUPNVSIT,AUPNDOD
+3 QUIT
