APCDVMRG ; IHS/CMI/LAB - VISIT MERGE ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
;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 !!,"*** 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 ;direct set as visit is being deleted
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
;
;
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
APCDVMRG ; IHS/CMI/LAB - VISIT MERGE ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
+3 ;merge 2 visits during data entry process.
+4 DO GETPAT
+5 IF 'APCDPAT
DO EOJ
QUIT
+6 WRITE !!,"Select 'From' visit.",!
+7 SET APCDVV="APCDVMF"
DO GETVISIT
+8 IF 'APCDVMF
DO EOJ
QUIT
+9 SET APCDVLDT=+^AUPNVSIT(APCDVMF,0)\1
+10 WRITE !!,"Select 'To' visit.",!
+11 SET APCDVV="APCDVMT"
DO GETVISIT
+12 IF 'APCDVMT
DO EOJ
QUIT
+13 IF APCDVMF=APCDVMT
WRITE !!,"'From' and 'To' the same. Bye!"
DO EOJ
QUIT
+14 ;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
+15 WRITE !!,"*** FROM VISIT ***"
+16 KILL DR
SET APCDVDSP=APCDVMF
DO ^APCDVDSP
+17 WRITE !!,"*** TO VISIT ***"
+18 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 ;direct set as visit is being deleted
SET $PIECE(^AUPNVSIT(APCDVMF,22),U)="MERGED TO VISIT IEN "_APCDVMT
+9 DO UPDLOG^APCDVDEL(APCDVMF,APCDVMT)
+10 SET AUPNVSIT=APCDVMF
DO DEL^AUPNVSIT
+11 WRITE !!,"*** MERGED VISIT ***"
+12 DO ZTSK
+13 KILL DR
SET APCDVDSP=APCDVMT
DO ^APCDVDSP
+14 SET APCDVSIT=APCDVMT
DO ^APCDVCHK
KILL APCDVSIT
+15 DO EOJ
+16 QUIT
+17 ;
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 ;
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
