- 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
