- 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
