APCDCAF3 ; IHS/CMI/LAB - MENTAL HLTH ROUTINE 16-AUG-1994 ;
;;2.0;IHS PCC SUITE;**2,5,7,8,11,20**;MAY 14, 2009;Build 25
;; ;
;
DISP ;
K DIR
S DIR(0)="NO^1:"_APCDRCNT,DIR("A")="Which Visit"
D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I Y="" W !,"No VISIT selected." D EOP G DISPX
I $D(DIRUT) W !,"No VISIT selected." D EOP G DISPX
S APCDVSIT=^TMP("APCDCAF OP",$J,"IDX",Y,Y)
;RELINKER?
D ^XBFMK
S APCDCAFV=APCDVSIT,APCDCAF="IN CAF" D EP^APCDKDE D ^APCDVD S APCDVSIT=APCDCAFV
;K DIR S DIR(0)="Y",DIR("A")="Do you want to update the Chart Audit Status for this visit",DIR("B")="Y" KILL DA D ^DIR KILL DIR
;I $D(DIRUT) G DISPX
;I 'Y G DISPX
;D UPD0
;
DISPX ;
K DIR,DIRUT,DUOUT,Y,APCDVSIT,APCDCAF,APCDCAFV
D KILL^AUPNPAT
D BACK
Q
;
BACK ;go back to listman
D BACK^APCDCAF2
Q
;
MODIFY ;
D FULL^VALM1
K DIR
S DIR(0)="NO^1:"_APCDRCNT,DIR("A")="Modify which Visit"
D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I Y="" W !,"No VISIT selected." D EOP G MODIFYX
I $D(DIRUT) W !,"No VISIT selected." D EOP G MODIFYX
S APCDVSIT=^TMP("APCDCAF OP",$J,"IDX",Y,Y)
S (Y,APCDPAT)=$P(^AUPNVSIT(APCDVSIT,0),U,5)
D ^AUPNPAT
S APCDVLK=APCDVSIT
S APCDDATE=$P($P(^AUPNVSIT(APCDVSIT,0),U),".")
S APCDCAT=$P(^AUPNVSIT(APCDVSIT,0),U,7)
S APCDTYPE=$P(^AUPNVSIT(APCDVSIT,0),U,3)
S APCDLOC=$P(^AUPNVSIT(APCDVSIT,0),U,6)
S APCDCLN=$P(^AUPNVSIT(APCDVSIT,0),U,8)
I AUPNDOB]"",$D(APCDDATE) S X2=AUPNDOB,X1=APCDDATE D ^%DTC S AUPNDAYS=X ; re-set days of age to visit date-dob
S APCDFLG=0 D ^APCDEIN I APCDFLG W !!,"error in data entry modify mode" D EOP G MODIFYX
D START^APCDEWHO(APCDVSIT)
S APCDMODE="M"
S AUPNVSIT=APCDVSIT D MOD^AUPNVSIT
D ^XBFMK
S APCDCAFV=APCDVSIT,APCDCAF="IN CAF" D EP^APCDKDE D PROCESS^APCDEM S APCDVSIT=APCDCAFV
K DIR S DIR(0)="Y",DIR("A")="Do you want to update the Chart Audit Status for this visit",DIR("B")="Y" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G MODIFYX
I 'Y G MODIFYX
D UPD0
;
MODIFYX ;
K APCDVSIT,APCDPAT,X,Y,AUPNVSIT,AUPNDAYS,APCDCAF,APCDCAFV
D EN^APCDEKL
D EN2^APCDEKL
D KILL^AUPNPAT
D BACK
Q
;
APPEND ;
D FULL^VALM1
K DIR
S DIR(0)="NO^1:"_APCDRCNT,DIR("A")="APPEND to which Visit"
D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I Y="" W !,"No VISIT selected." D EOP G APPENDX
I $D(DIRUT) W !,"No VISIT selected." D EOP G APPENDX
S APCDVSIT=^TMP("APCDCAF OP",$J,"IDX",Y,Y)
S (Y,APCDPAT)=$P(^AUPNVSIT(APCDVSIT,0),U,5)
D ^AUPNPAT
S APCDVLK=APCDVSIT
S APCDDATE=$P($P(^AUPNVSIT(APCDVSIT,0),U),".")
S APCDCAT=$P(^AUPNVSIT(APCDVSIT,0),U,7)
S APCDTYPE=$P(^AUPNVSIT(APCDVSIT,0),U,3)
S APCDLOC=$P(^AUPNVSIT(APCDVSIT,0),U,6)
S APCDCLN=$P(^AUPNVSIT(APCDVSIT,0),U,8)
I AUPNDOB]"",$D(APCDDATE) S X2=AUPNDOB,X1=APCDDATE D ^%DTC S AUPNDAYS=X ; re-set days of age to visit date-dob
S APCDFLG=0 D ^APCDEIN I APCDFLG W !!,"error in data entry APPEND mode" D EOP G APPENDX
D START^APCDEWHO(APCDVSIT)
S APCDMODE="A",APCDNOXV=""
S AUPNVSIT=APCDVSIT D MOD^AUPNVSIT
D ^XBFMK
S APCDCAFV=APCDVSIT,APCDCAF="IN CAF" D EP^APCDKDE D MNEPROC^APCDEAP S APCDVSIT=APCDCAFV
K DIR S DIR(0)="Y",DIR("A")="Do you want to update the Chart Audit Status for this visit",DIR("B")="Y" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G APPENDX
I 'Y G APPENDX
D UPD0
;
APPENDX ;
K APCDVSIT,APCDPAT,X,Y,AUPNVSIT,AUPNDAYS,APCDCAF
D EN^APCDEKL
D EN2^APCDEKL
D KILL^AUPNPAT
D BACK
Q
;
UPDATE ;EP
D FULL^VALM1
K DIR
S DIR(0)="NO^1:"_APCDRCNT,DIR("A")="Update Chart Audit Status for which Visit"
D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I Y="" W !,"No VISIT selected." D EOP G UPDATEX
I $D(DIRUT) W !,"No VISIT selected." D EOP G UPDATEX
S APCDVSIT=^TMP("APCDCAF OP",$J,"IDX",Y,Y)
D MOD^AUPNVSIT
UPD0 ;EP
K DIC,DD,D0,DO
S X=$$NOW^XLFDT,DIC="^AUPNVCA(",DIC(0)="L",DIADD=1,DLAYGO=9000010.45
S DIC("DR")=".02////"_$P(^AUPNVSIT(APCDVSIT,0),U,5)_";.03////"_APCDVSIT_";.05////"_DUZ_";1216////"_$$NOW^XLFDT D FILE^DICN
I Y=-1 W !!,"updating status failed" D EOP G UPDATEX
K DIC,DD,D0,DIADD,DLAYGO
S (APCDVCA,DA)=+Y
UPD1 ;
D ^XBFMK
S DA=APCDVCA,DIE="^AUPNVCA(",DR=".04" D ^DIE K DA,DIE,DR
D ^XBFMK
S APCDCAR=$P(^AUPNVCA(APCDVCA,0),U,4)
I APCDCAR="" W !!,"You must enter a status" G UPD1
S APCDERR=$$ERRORCHK^APCDCAF(APCDVSIT)
I APCDERR]"",APCDCAR="R" W !!,"This visit has the following error: ",APCDERR,!,"You cannot mark a visit as Reviewed/Completed if there is an error." S DA=APCDVCA,DIE="^AUPNVCA(",DR=".04///I" D ^DIE G UPD1
S DIE="^AUPNVSIT(",DA=APCDVSIT,DR=".13////"_DT_";1111////"_APCDCAR D ^DIE K DIE,DA,DR
I APCDCAR="R" D RNU^APCDCAF4 G UPDATEX
R ;
D EN^APCDCAF6(APCDVSIT)
I '$$FINDPEND^APCDCAF6(APCDVSIT),$$VALI^XBDIQ1(9000010,APCDVSIT,1111)'="R",$P(^APCDSITE(DUZ(2),0),U,32) W !!,"A chart Deficiency reason is required." H 3 G R
;PUT CHART AUDIT NOTE HERE
;K DIR S DIR(0)="Y",DIR("A")="Do you want to update the Chart Audit Notes for this visit",DIR("B")="N" KILL DA D ^DIR KILL DIR
;I $D(DIRUT) G UPDATEX
;I 'Y G UPDATEX
;I '$D(^AUPNCANT(APCDVSIT)) D ADDCANT
;I '$D(^AUPNCANT(APCDVSIT)) W !!,"adding entry to chart audit notes failed." H 3 G UPDATEX
;S DA=APCDVSIT,DIE="^AUPNCANT(",DR=1100 D ^DIE K DIE,DA,DR
;
;
UPDATEX ;
K DIADD,DLAYGO
D ^XBFMK
K APCDCAR,APCDCVA,APCDVSIT
D BACK
Q
;
ADDCANT ;
S ^AUPNCANT(APCDVSIT,0)=APCDVSIT_U_$P(^AUPNVSIT(APCDVSIT,0),U,5)
S DA=APCDVSIT,DIK="^AUPNCANT(" D IX1^DIK
Q
EOP ;EP - End of page.
Q:$E(IOST)'="C"
;Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
NEW DIR
K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
S DIR("A")="Press Enter to Continue",DIR(0)="E" D ^DIR
Q
;----------
MERGE ;EP
D FULL^VALM1
K DIR
S DIR(0)="NO^1:"_APCDRCNT,DIR("A")="Which Visit"
D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I Y="" W !,"No VISIT selected." D EOP G MERGEX
I $D(DIRUT) W !,"No VISIT selected." D EOP G MERGEX
S APCDVSIT=^TMP("APCDCAF OP",$J,"IDX",Y,Y)
S APCDVLDT=$P($P(^AUPNVSIT(APCDVSIT,0),U),"."),APCDPAT=$P(^AUPNVSIT(APCDVSIT,0),U,5)
S (X,APCDIDT)=(9999999-APCDVLDT),C=0 F S X=$O(^AUPNVSIT("AA",APCDPAT,X)) Q:X=""!($P(X,".")>APCDIDT) D
.S V=0 F S V=$O(^AUPNVSIT("AA",APCDPAT,X,V)) Q:V'=+V S C=C+1
I C<2 W !!,"Patient only has 1 visit on that day, cannot do a merge." D EOP G MERGEX
S Y=APCDPAT D ^AUPNPAT
W !!,"Select 'From' visit.",!
S APCDVV="APCDVMF" D GETVISIT
I 'APCDVMF G MERGEX
S APCDVLDT=+^AUPNVSIT(APCDVMF,0)\1
W !!,"Select 'To' visit.",!
S APCDVV="APCDVMT" D GETVISIT
I 'APCDVMT G MERGEX
I APCDVMF=APCDVMT W !!,"'From' and 'To' the same. Bye!" D EOP G MERGEX Q
I $D(^ABSBITMS(9002302,"AD",APCDVMF)) W !!,"Cannot merge from a visit that has a Claim associate with it." G MERGEX ;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
S APCDCAF="IN CAF" D EN1^APCDVMRG
;
MERGEX ;
K APCDVSIT,APCDPAT,X,Y,AUPNVSIT,AUPNDAYS,APCDCAF,APCDPAT,APCDVMT,APCDVMF
D EN1^APCDEKL
D EN2^APCDEKL
D KILL^AUPNPAT
D BACK
Q
;
GETVISIT ;
K APCDVLK
S APCDLOOK=""
D ^APCDVLK
S @APCDVV=APCDLOOK
K APCDLOOK
Q
;
DEL ;EP
I '$D(^XUSEC("APCDZDELETEVISIT",DUZ)) W !!,"You do not have the security key to delete a Visit.",!,"Please see your supervisor or program manager.",! G DELX
K DIR
S DIR(0)="NO^1:"_APCDRCNT,DIR("A")="Which Visit"
D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I Y="" W !,"No VISIT selected." D EOP G DELX
I $D(DIRUT) W !,"No VISIT selected." D EOP G DELX
S APCDVSIT=^TMP("APCDCAF OP",$J,"IDX",Y,Y)
D ^XBFMK
;DSPLY ;
S APCDVDSP=APCDVSIT D ^APCDVDSP
I '$$ALLRET^APCDCAF1(APCDVSIT) W !!,"All Notes must be retracted before you can delete this visit." D EOP G DELX
W !!,"THE ABOVE VISIT AND RELATED V FILE ENTRIES WILL BE REMOVED FOREVER !!!"
DELETE ; DELETE VISIT AND RELATED V FILES
W !,"Sure you want to delete" S %=2 D YN^DICN S %Y=$E(%Y)
Q:%Y="^"
I "Nn"[%Y G DELX
S DIE="^AUPNVSIT(",DA=APCDVSIT,DR=2201 D ^DIE K DA,DIE,DR
I $P($G(^AUPNVSIT(APCDVSIT,22)),U)="" S DA=APCDVSIT,DIE="^AUPNVSIT(",DR="2201///NO RESPONSE FROM OPERATOR" D ^DIE K DA,DIE,DR
;UPDATE DELETE LOG
D UPDLOG^APCDVDEL(APCDVSIT)
S APCDVDLT=APCDVSIT D ^APCDVDLT
DELX ;
K DIR,DIRUT,DUOUT,Y,APCDVSIT,APCDCAF,APCDCAFV,APCDVDLT
D KILL^AUPNPAT
D BACK
Q
;
MERGEDD ;EP
D FULL^VALM1
K DIR
S DIR(0)="NO^1:"_APCDRCNT,DIR("A")="Which Visit"
D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I Y="" W !,"No VISIT selected." D EOP G MERGEDDX
I $D(DIRUT) W !,"No VISIT selected." D EOP G MERGEDDX
S APCDVSIT=^TMP("APCDCAF OP",$J,"IDX",Y,Y)
;S APCDVLDT=$P($P(^AUPNVSIT(APCDVSIT,0),U),".")
S APCDPAT=$P(^AUPNVSIT(APCDVSIT,0),U,5)
S Y=APCDPAT D ^AUPNPAT
W !!,"Select 'From' visit.",!
S APCDVV="APCDVMF" D GETVISIT
I 'APCDVMF G MERGEDDX
;S APCDVLDT=+^AUPNVSIT(APCDVMF,0)\1
W !!,"Select 'To' visit.",!
S APCDVV="APCDVMT" D GETVISIT
I 'APCDVMT G MERGEDDX
I APCDVMF=APCDVMT W !!,"'From' and 'To' the same. Bye!" D EOP G MERGEDDX Q
I $D(^ABSBITMS(9002302,"AD",APCDVMF)) W !!,"Cannot merge from a visit that has a Claim associate with it." G MERGEX ;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
S APCDCAF="IN CAF" D EN1^APCDVMRG
;
MERGEDDX ;
K APCDVSIT,APCDPAT,X,Y,AUPNVSIT,AUPNDAYS,APCDCAF,APCDPAT,APCDVMT,APCDVMF
D EN1^APCDEKL
D EN2^APCDEKL
D KILL^AUPNPAT
D BACK
Q
;
MOVEVD ;EP
D FULL^VALM1
K DIR
S DIR(0)="NO^1:"_APCDRCNT,DIR("A")="Which Visit"
D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I Y="" W !,"No VISIT selected." D EOP G MOVEVDX
I $D(DIRUT) W !,"No VISIT selected." D EOP G MOVEVDX
S APCDVSIT=^TMP("APCDCAF OP",$J,"IDX",Y,Y)
S APCDVLDT=$P($P(^AUPNVSIT(APCDVSIT,0),U),"."),APCDPAT=$P(^AUPNVSIT(APCDVSIT,0),U,5)
S (X,APCDIDT)=(9999999-APCDVLDT),C=0 F S X=$O(^AUPNVSIT("AA",APCDPAT,X)) Q:X=""!($P(X,".")>APCDIDT) D
.S V=0 F S V=$O(^AUPNVSIT("AA",APCDPAT,X,V)) Q:V'=+V S C=C+1
I C<2 W !!,"Patient only has 1 visit on that day, cannot move data." D EOP G MOVEVDX
S Y=APCDPAT D ^AUPNPAT
W !!,"Select 'From' visit.",!
S APCDVV="APCDVMF" D GETVISIT
I 'APCDVMF G MOVEVDX
S APCDVLDT=+^AUPNVSIT(APCDVMF,0)\1
W !!,"Select 'To' visit.",!
S APCDVV="APCDVMT" D GETVISIT
I 'APCDVMT G MOVEVDX
I APCDVMF=APCDVMT W !!,"'From' and 'To' the same. Bye!" D EOP G MOVEVDX Q
D EP1^APCDKUL
MOVEVDX ;
K APCDVSIT,APCDPAT,X,Y,AUPNVSIT,AUPNDAYS,APCDCAF,APCDPAT,APCDVMT,APCDVMF
D EN1^APCDEKL
D EN2^APCDEKL
D KILL^AUPNPAT
D BACK
Q
RESEQ ;EP
D FULL^VALM1
K DIR
S DIR(0)="NO^1:"_APCDRCNT,DIR("A")="Resequence POVs for which visit"
D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I Y="" W !,"No VISIT selected." D EOP G RESEQX
I $D(DIRUT) W !,"No VISIT selected." D EOP G RESEQX
S APCDVSIT=^TMP("APCDCAF OP",$J,"IDX",Y,Y)
D EN^APCDRPOV(APCDVSIT)
D ^XBFMK
K DIR S DIR(0)="Y",DIR("A")="Do you want to update the Chart Audit Status for this visit",DIR("B")="Y" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G RESEQX
I 'Y G RESEQX
D UPD0
;
RESEQX ;
K APCDVSIT,APCDPAT,X,Y,AUPNVSIT,AUPNDAYS,APCDCAF
D EN^APCDEKL
D EN2^APCDEKL
D KILL^AUPNPAT
D BACK
Q
APCDCAF3 ; IHS/CMI/LAB - MENTAL HLTH ROUTINE 16-AUG-1994 ;
+1 ;;2.0;IHS PCC SUITE;**2,5,7,8,11,20**;MAY 14, 2009;Build 25
+2 ;; ;
+3 ;
DISP ;
+1 KILL DIR
+2 SET DIR(0)="NO^1:"_APCDRCNT
SET DIR("A")="Which Visit"
+3 DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+4 IF Y=""
WRITE !,"No VISIT selected."
DO EOP
GOTO DISPX
+5 IF $DATA(DIRUT)
WRITE !,"No VISIT selected."
DO EOP
GOTO DISPX
+6 SET APCDVSIT=^TMP("APCDCAF OP",$JOB,"IDX",Y,Y)
+7 ;RELINKER?
+8 DO ^XBFMK
+9 SET APCDCAFV=APCDVSIT
SET APCDCAF="IN CAF"
DO EP^APCDKDE
DO ^APCDVD
SET APCDVSIT=APCDCAFV
+10 ;K DIR S DIR(0)="Y",DIR("A")="Do you want to update the Chart Audit Status for this visit",DIR("B")="Y" KILL DA D ^DIR KILL DIR
+11 ;I $D(DIRUT) G DISPX
+12 ;I 'Y G DISPX
+13 ;D UPD0
+14 ;
DISPX ;
+1 KILL DIR,DIRUT,DUOUT,Y,APCDVSIT,APCDCAF,APCDCAFV
+2 DO KILL^AUPNPAT
+3 DO BACK
+4 QUIT
+5 ;
BACK ;go back to listman
+1 DO BACK^APCDCAF2
+2 QUIT
+3 ;
MODIFY ;
+1 DO FULL^VALM1
+2 KILL DIR
+3 SET DIR(0)="NO^1:"_APCDRCNT
SET DIR("A")="Modify which Visit"
+4 DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+5 IF Y=""
WRITE !,"No VISIT selected."
DO EOP
GOTO MODIFYX
+6 IF $DATA(DIRUT)
WRITE !,"No VISIT selected."
DO EOP
GOTO MODIFYX
+7 SET APCDVSIT=^TMP("APCDCAF OP",$JOB,"IDX",Y,Y)
+8 SET (Y,APCDPAT)=$PIECE(^AUPNVSIT(APCDVSIT,0),U,5)
+9 DO ^AUPNPAT
+10 SET APCDVLK=APCDVSIT
+11 SET APCDDATE=$PIECE($PIECE(^AUPNVSIT(APCDVSIT,0),U),".")
+12 SET APCDCAT=$PIECE(^AUPNVSIT(APCDVSIT,0),U,7)
+13 SET APCDTYPE=$PIECE(^AUPNVSIT(APCDVSIT,0),U,3)
+14 SET APCDLOC=$PIECE(^AUPNVSIT(APCDVSIT,0),U,6)
+15 SET APCDCLN=$PIECE(^AUPNVSIT(APCDVSIT,0),U,8)
+16 ; re-set days of age to visit date-dob
IF AUPNDOB]""
IF $DATA(APCDDATE)
SET X2=AUPNDOB
SET X1=APCDDATE
DO ^%DTC
SET AUPNDAYS=X
+17 SET APCDFLG=0
DO ^APCDEIN
IF APCDFLG
WRITE !!,"error in data entry modify mode"
DO EOP
GOTO MODIFYX
+18 DO START^APCDEWHO(APCDVSIT)
+19 SET APCDMODE="M"
+20 SET AUPNVSIT=APCDVSIT
DO MOD^AUPNVSIT
+21 DO ^XBFMK
+22 SET APCDCAFV=APCDVSIT
SET APCDCAF="IN CAF"
DO EP^APCDKDE
DO PROCESS^APCDEM
SET APCDVSIT=APCDCAFV
+23 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Do you want to update the Chart Audit Status for this visit"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+24 IF $DATA(DIRUT)
GOTO MODIFYX
+25 IF 'Y
GOTO MODIFYX
+26 DO UPD0
+27 ;
MODIFYX ;
+1 KILL APCDVSIT,APCDPAT,X,Y,AUPNVSIT,AUPNDAYS,APCDCAF,APCDCAFV
+2 DO EN^APCDEKL
+3 DO EN2^APCDEKL
+4 DO KILL^AUPNPAT
+5 DO BACK
+6 QUIT
+7 ;
APPEND ;
+1 DO FULL^VALM1
+2 KILL DIR
+3 SET DIR(0)="NO^1:"_APCDRCNT
SET DIR("A")="APPEND to which Visit"
+4 DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+5 IF Y=""
WRITE !,"No VISIT selected."
DO EOP
GOTO APPENDX
+6 IF $DATA(DIRUT)
WRITE !,"No VISIT selected."
DO EOP
GOTO APPENDX
+7 SET APCDVSIT=^TMP("APCDCAF OP",$JOB,"IDX",Y,Y)
+8 SET (Y,APCDPAT)=$PIECE(^AUPNVSIT(APCDVSIT,0),U,5)
+9 DO ^AUPNPAT
+10 SET APCDVLK=APCDVSIT
+11 SET APCDDATE=$PIECE($PIECE(^AUPNVSIT(APCDVSIT,0),U),".")
+12 SET APCDCAT=$PIECE(^AUPNVSIT(APCDVSIT,0),U,7)
+13 SET APCDTYPE=$PIECE(^AUPNVSIT(APCDVSIT,0),U,3)
+14 SET APCDLOC=$PIECE(^AUPNVSIT(APCDVSIT,0),U,6)
+15 SET APCDCLN=$PIECE(^AUPNVSIT(APCDVSIT,0),U,8)
+16 ; re-set days of age to visit date-dob
IF AUPNDOB]""
IF $DATA(APCDDATE)
SET X2=AUPNDOB
SET X1=APCDDATE
DO ^%DTC
SET AUPNDAYS=X
+17 SET APCDFLG=0
DO ^APCDEIN
IF APCDFLG
WRITE !!,"error in data entry APPEND mode"
DO EOP
GOTO APPENDX
+18 DO START^APCDEWHO(APCDVSIT)
+19 SET APCDMODE="A"
SET APCDNOXV=""
+20 SET AUPNVSIT=APCDVSIT
DO MOD^AUPNVSIT
+21 DO ^XBFMK
+22 SET APCDCAFV=APCDVSIT
SET APCDCAF="IN CAF"
DO EP^APCDKDE
DO MNEPROC^APCDEAP
SET APCDVSIT=APCDCAFV
+23 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Do you want to update the Chart Audit Status for this visit"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+24 IF $DATA(DIRUT)
GOTO APPENDX
+25 IF 'Y
GOTO APPENDX
+26 DO UPD0
+27 ;
APPENDX ;
+1 KILL APCDVSIT,APCDPAT,X,Y,AUPNVSIT,AUPNDAYS,APCDCAF
+2 DO EN^APCDEKL
+3 DO EN2^APCDEKL
+4 DO KILL^AUPNPAT
+5 DO BACK
+6 QUIT
+7 ;
UPDATE ;EP
+1 DO FULL^VALM1
+2 KILL DIR
+3 SET DIR(0)="NO^1:"_APCDRCNT
SET DIR("A")="Update Chart Audit Status for which Visit"
+4 DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+5 IF Y=""
WRITE !,"No VISIT selected."
DO EOP
GOTO UPDATEX
+6 IF $DATA(DIRUT)
WRITE !,"No VISIT selected."
DO EOP
GOTO UPDATEX
+7 SET APCDVSIT=^TMP("APCDCAF OP",$JOB,"IDX",Y,Y)
+8 DO MOD^AUPNVSIT
UPD0 ;EP
+1 KILL DIC,DD,D0,DO
+2 SET X=$$NOW^XLFDT
SET DIC="^AUPNVCA("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9000010.45
+3 SET DIC("DR")=".02////"_$PIECE(^AUPNVSIT(APCDVSIT,0),U,5)_";.03////"_APCDVSIT_";.05////"_DUZ_";1216////"_$$NOW^XLFDT
DO FILE^DICN
+4 IF Y=-1
WRITE !!,"updating status failed"
DO EOP
GOTO UPDATEX
+5 KILL DIC,DD,D0,DIADD,DLAYGO
+6 SET (APCDVCA,DA)=+Y
UPD1 ;
+1 DO ^XBFMK
+2 SET DA=APCDVCA
SET DIE="^AUPNVCA("
SET DR=".04"
DO ^DIE
KILL DA,DIE,DR
+3 DO ^XBFMK
+4 SET APCDCAR=$PIECE(^AUPNVCA(APCDVCA,0),U,4)
+5 IF APCDCAR=""
WRITE !!,"You must enter a status"
GOTO UPD1
+6 SET APCDERR=$$ERRORCHK^APCDCAF(APCDVSIT)
+7 IF APCDERR]""
IF APCDCAR="R"
WRITE !!,"This visit has the following error: ",APCDERR,!,"You cannot mark a visit as Reviewed/Completed if there is an error."
SET DA=APCDVCA
SET DIE="^AUPNVCA("
SET DR=".04///I"
DO ^DIE
GOTO UPD1
+8 SET DIE="^AUPNVSIT("
SET DA=APCDVSIT
SET DR=".13////"_DT_";1111////"_APCDCAR
DO ^DIE
KILL DIE,DA,DR
+9 IF APCDCAR="R"
DO RNU^APCDCAF4
GOTO UPDATEX
R ;
+1 DO EN^APCDCAF6(APCDVSIT)
+2 IF '$$FINDPEND^APCDCAF6(APCDVSIT)
IF $$VALI^XBDIQ1(9000010,APCDVSIT,1111)'="R"
IF $PIECE(^APCDSITE(DUZ(2),0),U,32)
WRITE !!,"A chart Deficiency reason is required."
HANG 3
GOTO R
+3 ;PUT CHART AUDIT NOTE HERE
+4 ;K DIR S DIR(0)="Y",DIR("A")="Do you want to update the Chart Audit Notes for this visit",DIR("B")="N" KILL DA D ^DIR KILL DIR
+5 ;I $D(DIRUT) G UPDATEX
+6 ;I 'Y G UPDATEX
+7 ;I '$D(^AUPNCANT(APCDVSIT)) D ADDCANT
+8 ;I '$D(^AUPNCANT(APCDVSIT)) W !!,"adding entry to chart audit notes failed." H 3 G UPDATEX
+9 ;S DA=APCDVSIT,DIE="^AUPNCANT(",DR=1100 D ^DIE K DIE,DA,DR
+10 ;
+11 ;
UPDATEX ;
+1 KILL DIADD,DLAYGO
+2 DO ^XBFMK
+3 KILL APCDCAR,APCDCVA,APCDVSIT
+4 DO BACK
+5 QUIT
+6 ;
ADDCANT ;
+1 SET ^AUPNCANT(APCDVSIT,0)=APCDVSIT_U_$PIECE(^AUPNVSIT(APCDVSIT,0),U,5)
+2 SET DA=APCDVSIT
SET DIK="^AUPNCANT("
DO IX1^DIK
+3 QUIT
EOP ;EP - End of page.
+1 IF $EXTRACT(IOST)'="C"
QUIT
+2 ;Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
+3 NEW DIR
+4 KILL DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
+5 SET DIR("A")="Press Enter to Continue"
SET DIR(0)="E"
DO ^DIR
+6 QUIT
+7 ;----------
MERGE ;EP
+1 DO FULL^VALM1
+2 KILL DIR
+3 SET DIR(0)="NO^1:"_APCDRCNT
SET DIR("A")="Which Visit"
+4 DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+5 IF Y=""
WRITE !,"No VISIT selected."
DO EOP
GOTO MERGEX
+6 IF $DATA(DIRUT)
WRITE !,"No VISIT selected."
DO EOP
GOTO MERGEX
+7 SET APCDVSIT=^TMP("APCDCAF OP",$JOB,"IDX",Y,Y)
+8 SET APCDVLDT=$PIECE($PIECE(^AUPNVSIT(APCDVSIT,0),U),".")
SET APCDPAT=$PIECE(^AUPNVSIT(APCDVSIT,0),U,5)
+9 SET (X,APCDIDT)=(9999999-APCDVLDT)
SET C=0
FOR
SET X=$ORDER(^AUPNVSIT("AA",APCDPAT,X))
IF X=""!($PIECE(X,".")>APCDIDT)
QUIT
Begin DoDot:1
+10 SET V=0
FOR
SET V=$ORDER(^AUPNVSIT("AA",APCDPAT,X,V))
IF V'=+V
QUIT
SET C=C+1
End DoDot:1
+11 IF C<2
WRITE !!,"Patient only has 1 visit on that day, cannot do a merge."
DO EOP
GOTO MERGEX
+12 SET Y=APCDPAT
DO ^AUPNPAT
+13 WRITE !!,"Select 'From' visit.",!
+14 SET APCDVV="APCDVMF"
DO GETVISIT
+15 IF 'APCDVMF
GOTO MERGEX
+16 SET APCDVLDT=+^AUPNVSIT(APCDVMF,0)\1
+17 WRITE !!,"Select 'To' visit.",!
+18 SET APCDVV="APCDVMT"
DO GETVISIT
+19 IF 'APCDVMT
GOTO MERGEX
+20 IF APCDVMF=APCDVMT
WRITE !!,"'From' and 'To' the same. Bye!"
DO EOP
GOTO MERGEX
QUIT
+21 ;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."
GOTO MERGEX
+22 WRITE !!,"*** FROM VISIT ***"
+23 KILL DR
SET APCDVDSP=APCDVMF
DO ^APCDVDSP
+24 WRITE !!,"*** TO VISIT ***"
+25 KILL DR
SET APCDVDSP=APCDVMT
DO ^APCDVDSP
+26 SET APCDCAF="IN CAF"
DO EN1^APCDVMRG
+27 ;
MERGEX ;
+1 KILL APCDVSIT,APCDPAT,X,Y,AUPNVSIT,AUPNDAYS,APCDCAF,APCDPAT,APCDVMT,APCDVMF
+2 DO EN1^APCDEKL
+3 DO EN2^APCDEKL
+4 DO KILL^AUPNPAT
+5 DO BACK
+6 QUIT
+7 ;
GETVISIT ;
+1 KILL APCDVLK
+2 SET APCDLOOK=""
+3 DO ^APCDVLK
+4 SET @APCDVV=APCDLOOK
+5 KILL APCDLOOK
+6 QUIT
+7 ;
DEL ;EP
+1 IF '$DATA(^XUSEC("APCDZDELETEVISIT",DUZ))
WRITE !!,"You do not have the security key to delete a Visit.",!,"Please see your supervisor or program manager.",!
GOTO DELX
+2 KILL DIR
+3 SET DIR(0)="NO^1:"_APCDRCNT
SET DIR("A")="Which Visit"
+4 DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+5 IF Y=""
WRITE !,"No VISIT selected."
DO EOP
GOTO DELX
+6 IF $DATA(DIRUT)
WRITE !,"No VISIT selected."
DO EOP
GOTO DELX
+7 SET APCDVSIT=^TMP("APCDCAF OP",$JOB,"IDX",Y,Y)
+8 DO ^XBFMK
+9 ;DSPLY ;
+10 SET APCDVDSP=APCDVSIT
DO ^APCDVDSP
+11 IF '$$ALLRET^APCDCAF1(APCDVSIT)
WRITE !!,"All Notes must be retracted before you can delete this visit."
DO EOP
GOTO DELX
+12 WRITE !!,"THE ABOVE VISIT AND RELATED V FILE ENTRIES WILL BE REMOVED FOREVER !!!"
DELETE ; DELETE VISIT AND RELATED V FILES
+1 WRITE !,"Sure you want to delete"
SET %=2
DO YN^DICN
SET %Y=$EXTRACT(%Y)
+2 IF %Y="^"
QUIT
+3 IF "Nn"[%Y
GOTO DELX
+4 SET DIE="^AUPNVSIT("
SET DA=APCDVSIT
SET DR=2201
DO ^DIE
KILL DA,DIE,DR
+5 IF $PIECE($GET(^AUPNVSIT(APCDVSIT,22)),U)=""
SET DA=APCDVSIT
SET DIE="^AUPNVSIT("
SET DR="2201///NO RESPONSE FROM OPERATOR"
DO ^DIE
KILL DA,DIE,DR
+6 ;UPDATE DELETE LOG
+7 DO UPDLOG^APCDVDEL(APCDVSIT)
+8 SET APCDVDLT=APCDVSIT
DO ^APCDVDLT
DELX ;
+1 KILL DIR,DIRUT,DUOUT,Y,APCDVSIT,APCDCAF,APCDCAFV,APCDVDLT
+2 DO KILL^AUPNPAT
+3 DO BACK
+4 QUIT
+5 ;
MERGEDD ;EP
+1 DO FULL^VALM1
+2 KILL DIR
+3 SET DIR(0)="NO^1:"_APCDRCNT
SET DIR("A")="Which Visit"
+4 DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+5 IF Y=""
WRITE !,"No VISIT selected."
DO EOP
GOTO MERGEDDX
+6 IF $DATA(DIRUT)
WRITE !,"No VISIT selected."
DO EOP
GOTO MERGEDDX
+7 SET APCDVSIT=^TMP("APCDCAF OP",$JOB,"IDX",Y,Y)
+8 ;S APCDVLDT=$P($P(^AUPNVSIT(APCDVSIT,0),U),".")
+9 SET APCDPAT=$PIECE(^AUPNVSIT(APCDVSIT,0),U,5)
+10 SET Y=APCDPAT
DO ^AUPNPAT
+11 WRITE !!,"Select 'From' visit.",!
+12 SET APCDVV="APCDVMF"
DO GETVISIT
+13 IF 'APCDVMF
GOTO MERGEDDX
+14 ;S APCDVLDT=+^AUPNVSIT(APCDVMF,0)\1
+15 WRITE !!,"Select 'To' visit.",!
+16 SET APCDVV="APCDVMT"
DO GETVISIT
+17 IF 'APCDVMT
GOTO MERGEDDX
+18 IF APCDVMF=APCDVMT
WRITE !!,"'From' and 'To' the same. Bye!"
DO EOP
GOTO MERGEDDX
QUIT
+19 ;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."
GOTO MERGEX
+20 WRITE !!,"*** FROM VISIT ***"
+21 KILL DR
SET APCDVDSP=APCDVMF
DO ^APCDVDSP
+22 WRITE !!,"*** TO VISIT ***"
+23 KILL DR
SET APCDVDSP=APCDVMT
DO ^APCDVDSP
+24 SET APCDCAF="IN CAF"
DO EN1^APCDVMRG
+25 ;
MERGEDDX ;
+1 KILL APCDVSIT,APCDPAT,X,Y,AUPNVSIT,AUPNDAYS,APCDCAF,APCDPAT,APCDVMT,APCDVMF
+2 DO EN1^APCDEKL
+3 DO EN2^APCDEKL
+4 DO KILL^AUPNPAT
+5 DO BACK
+6 QUIT
+7 ;
MOVEVD ;EP
+1 DO FULL^VALM1
+2 KILL DIR
+3 SET DIR(0)="NO^1:"_APCDRCNT
SET DIR("A")="Which Visit"
+4 DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+5 IF Y=""
WRITE !,"No VISIT selected."
DO EOP
GOTO MOVEVDX
+6 IF $DATA(DIRUT)
WRITE !,"No VISIT selected."
DO EOP
GOTO MOVEVDX
+7 SET APCDVSIT=^TMP("APCDCAF OP",$JOB,"IDX",Y,Y)
+8 SET APCDVLDT=$PIECE($PIECE(^AUPNVSIT(APCDVSIT,0),U),".")
SET APCDPAT=$PIECE(^AUPNVSIT(APCDVSIT,0),U,5)
+9 SET (X,APCDIDT)=(9999999-APCDVLDT)
SET C=0
FOR
SET X=$ORDER(^AUPNVSIT("AA",APCDPAT,X))
IF X=""!($PIECE(X,".")>APCDIDT)
QUIT
Begin DoDot:1
+10 SET V=0
FOR
SET V=$ORDER(^AUPNVSIT("AA",APCDPAT,X,V))
IF V'=+V
QUIT
SET C=C+1
End DoDot:1
+11 IF C<2
WRITE !!,"Patient only has 1 visit on that day, cannot move data."
DO EOP
GOTO MOVEVDX
+12 SET Y=APCDPAT
DO ^AUPNPAT
+13 WRITE !!,"Select 'From' visit.",!
+14 SET APCDVV="APCDVMF"
DO GETVISIT
+15 IF 'APCDVMF
GOTO MOVEVDX
+16 SET APCDVLDT=+^AUPNVSIT(APCDVMF,0)\1
+17 WRITE !!,"Select 'To' visit.",!
+18 SET APCDVV="APCDVMT"
DO GETVISIT
+19 IF 'APCDVMT
GOTO MOVEVDX
+20 IF APCDVMF=APCDVMT
WRITE !!,"'From' and 'To' the same. Bye!"
DO EOP
GOTO MOVEVDX
QUIT
+21 DO EP1^APCDKUL
MOVEVDX ;
+1 KILL APCDVSIT,APCDPAT,X,Y,AUPNVSIT,AUPNDAYS,APCDCAF,APCDPAT,APCDVMT,APCDVMF
+2 DO EN1^APCDEKL
+3 DO EN2^APCDEKL
+4 DO KILL^AUPNPAT
+5 DO BACK
+6 QUIT
RESEQ ;EP
+1 DO FULL^VALM1
+2 KILL DIR
+3 SET DIR(0)="NO^1:"_APCDRCNT
SET DIR("A")="Resequence POVs for which visit"
+4 DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+5 IF Y=""
WRITE !,"No VISIT selected."
DO EOP
GOTO RESEQX
+6 IF $DATA(DIRUT)
WRITE !,"No VISIT selected."
DO EOP
GOTO RESEQX
+7 SET APCDVSIT=^TMP("APCDCAF OP",$JOB,"IDX",Y,Y)
+8 DO EN^APCDRPOV(APCDVSIT)
+9 DO ^XBFMK
+10 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Do you want to update the Chart Audit Status for this visit"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+11 IF $DATA(DIRUT)
GOTO RESEQX
+12 IF 'Y
GOTO RESEQX
+13 DO UPD0
+14 ;
RESEQX ;
+1 KILL APCDVSIT,APCDPAT,X,Y,AUPNVSIT,AUPNDAYS,APCDCAF
+2 DO EN^APCDEKL
+3 DO EN2^APCDEKL
+4 DO KILL^AUPNPAT
+5 DO BACK
+6 QUIT
