APCDCAF1 ; IHS/CMI/LAB - MENTAL HLTH ROUTINE 16-AUG-1994 ;
;;2.0;IHS PCC SUITE;**2,5,7,8,11**;MAY 14, 2009;Build 58
;; ;
;
DISP ;EP
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",$J,"IDX",Y,Y)
;RELINKER?
D ^XBFMK
S APCDCAFV=APCDVSIT,APCDCAF="IN CAF" D EP^APCDKDE D ^APCDVD S APCDVSIT=APCDCAFV
;
DISPX ;
K DIR,DIRUT,DUOUT,Y,APCDVSIT,APCDCAF,APCDCAFV
D KILL^AUPNPAT
D BACK
Q
;
BACK ;EP - go back to listman
D BACK^APCDCAF
Q
;
MODIFY ;EP
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",$J,"IDX",Y,Y)
;RELINKER?
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
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 ;EP
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",$J,"IDX",Y,Y)
;RELINKER
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
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,APCDCAFD
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",$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 ;EP
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",$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,APCDCAFD,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",$J,"IDX",Y,Y)
D ^XBFMK
;DSPLY ;
S APCDVDSP=APCDVSIT D ^APCDVDSP
I '$$ALLRET(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
ALLRET(V) ;EP - are all notes
NEW A,B,C
S C=1
S A=0 F S A=$O(^AUPNVNOT("AD",V,A)) Q:A'=+A D
.I $P($G(^AUPNVNOT(A,0)),U,4)="" S C=0
.Q
Q C
;
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",$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 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
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 !!!,"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) G MERGEDDX
I 'Y G MERGEDDX
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^APCDVMDD
;
MERGEDDX ;
K APCDVSIT,APCDPAT,X,Y,AUPNVSIT,AUPNDAYS,APCDCAF,APCDCAFD,APCDPAT,APCDVMT,APCDVMF
D EN1^APCDEKL
D EN2^APCDEKL
D KILL^AUPNPAT
D BACK
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
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",$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,APCDCAFD,APCDPAT,APCDVMT,APCDVMF
D EN1^APCDEKL
D EN2^APCDEKL
D KILL^AUPNPAT
D BACK
Q
CVD ;EP
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 CVDX
I $D(DIRUT) W !,"No VISIT selected." D EOP G CVDX
S APCDVSIT=^TMP("APCDCAF",$J,"IDX",Y,Y)
D ^XBFMK
;DSPLY ;
W !
S DIC="^AUPNVSIT(",DA=APCDVSIT D EN^DIQ K DIC,DIQ,DA
CHANGEVD ; CHANGE VISIT DATE/TIME
W !!,"The date and time of the VISIT is ",$$VAL^XBDIQ1(9000010,APCDVSIT,.01),!
S %DT="ATRX",%DT("A")="Enter new date and time: " D ^%DT K %DT
I Y<0 W !!,"Bye" G CVDX
W !,"The new visit date and time will be: ",$$FMTE^XLFDT(Y,1)
S X=Y D CHKVD
I '$D(X) W !!,"Invalid Date/Time" D EOP G CVDX
S APCDX=X
S DIR(0)="Y",DIR("A")="Is this okay",DIR("B")="Y" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D EOP G CVDX
I 'Y D EOP G CVDX
W " <WAIT>"
S APCDCVDT("VISIT DFN")=APCDVSIT
S APCDCVDT("VISIT DATE/TIME")=APCDX
S APCDCVDT("TALK")=1
D ^APCDCVDT
I $D(Y) W !,"Updating the Date Last Modified failed!!"
CVDX ;
K DIR,DIRUT,DUOUT,Y,APCDVSIT,APCDCAF,APCDCAFV,APCDVDLT,APCDCVDT,APCDX
D KILL^AUPNPAT
D BACK
Q
CHKVD ; CHECK NEW VISIT DATE
S Y=$P(^AUPNVSIT(APCDVSIT,0),U,5) D ^AUPNPAT
D VSIT01^AUPNVSIT
Q
MOVEVDD ;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 MOVEVDDX
I $D(DIRUT) W !,"No VISIT selected." D EOP G MOVEVDDX
S APCDVSIT=^TMP("APCDCAF",$J,"IDX",Y,Y)
S APCDPAT=$P(^AUPNVSIT(APCDVSIT,0),U,5)
S Y=APCDPAT D ^AUPNPAT
D GETFROM^APCDKULD
I 'APCDVMF G MOVEVDDX
D GETTO^APCDKULD
I 'APCDVMT G MOVEVDDX
I APCDVMF=APCDVMT W !!,"'From' and 'To' the same. Bye!" D EOP G MOVEVDDX Q
D EP1^APCDKULD
MOVEVDDX ;
K APCDVSIT,APCDPAT,X,Y,AUPNVSIT,AUPNDAYS,APCDCAF,APCDCAFD,APCDPAT,APCDVMT,APCDVMF
D EN1^APCDEKL
D EN2^APCDEKL
D KILL^AUPNPAT
D BACK
Q
;
ADDVISIT ;EP - ADD NEW VISIT CALLED FROM PROTOCOL ENTRY
D FULL^VALM1
D EN^XBNEW("^APCDEA","")
D EN^APCDEKL
D EN2^APCDEKL
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",$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,APCDCAFD
D EN^APCDEKL
D EN2^APCDEKL
D KILL^AUPNPAT
D BACK
Q
APCDCAF1 ; IHS/CMI/LAB - MENTAL HLTH ROUTINE 16-AUG-1994 ;
+1 ;;2.0;IHS PCC SUITE;**2,5,7,8,11**;MAY 14, 2009;Build 58
+2 ;; ;
+3 ;
DISP ;EP
+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",$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 ;
DISPX ;
+1 KILL DIR,DIRUT,DUOUT,Y,APCDVSIT,APCDCAF,APCDCAFV
+2 DO KILL^AUPNPAT
+3 DO BACK
+4 QUIT
+5 ;
BACK ;EP - go back to listman
+1 DO BACK^APCDCAF
+2 QUIT
+3 ;
MODIFY ;EP
+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",$JOB,"IDX",Y,Y)
+8 ;RELINKER?
+9 SET (Y,APCDPAT)=$PIECE(^AUPNVSIT(APCDVSIT,0),U,5)
+10 DO ^AUPNPAT
+11 SET APCDVLK=APCDVSIT
+12 SET APCDDATE=$PIECE($PIECE(^AUPNVSIT(APCDVSIT,0),U),".")
+13 SET APCDCAT=$PIECE(^AUPNVSIT(APCDVSIT,0),U,7)
+14 SET APCDTYPE=$PIECE(^AUPNVSIT(APCDVSIT,0),U,3)
+15 SET APCDLOC=$PIECE(^AUPNVSIT(APCDVSIT,0),U,6)
+16 SET APCDCLN=$PIECE(^AUPNVSIT(APCDVSIT,0),U,8)
+17 ; 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
+18 SET APCDFLG=0
DO ^APCDEIN
IF APCDFLG
WRITE !!,"error in data entry modify mode"
DO EOP
GOTO MODIFYX
+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 ;EP
+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",$JOB,"IDX",Y,Y)
+8 ;RELINKER
+9 SET (Y,APCDPAT)=$PIECE(^AUPNVSIT(APCDVSIT,0),U,5)
+10 DO ^AUPNPAT
+11 SET APCDVLK=APCDVSIT
+12 SET APCDDATE=$PIECE($PIECE(^AUPNVSIT(APCDVSIT,0),U),".")
+13 SET APCDCAT=$PIECE(^AUPNVSIT(APCDVSIT,0),U,7)
+14 SET APCDTYPE=$PIECE(^AUPNVSIT(APCDVSIT,0),U,3)
+15 SET APCDLOC=$PIECE(^AUPNVSIT(APCDVSIT,0),U,6)
+16 SET APCDCLN=$PIECE(^AUPNVSIT(APCDVSIT,0),U,8)
+17 ; 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
+18 SET APCDFLG=0
DO ^APCDEIN
IF APCDFLG
WRITE !!,"error in data entry APPEND mode"
DO EOP
GOTO APPENDX
+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,APCDCAFD
+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",$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 ;EP
+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",$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,APCDCAFD,APCDPAT,APCDVMT,APCDVMF
+2 DO EN1^APCDEKL
+3 DO EN2^APCDEKL
+4 DO KILL^AUPNPAT
+5 DO BACK
+6 QUIT
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",$JOB,"IDX",Y,Y)
+8 DO ^XBFMK
+9 ;DSPLY ;
+10 SET APCDVDSP=APCDVSIT
DO ^APCDVDSP
+11 IF '$$ALLRET(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
ALLRET(V) ;EP - are all notes
+1 NEW A,B,C
+2 SET C=1
+3 SET A=0
FOR
SET A=$ORDER(^AUPNVNOT("AD",V,A))
IF A'=+A
QUIT
Begin DoDot:1
+4 IF $PIECE($GET(^AUPNVNOT(A,0)),U,4)=""
SET C=0
+5 QUIT
End DoDot:1
+6 QUIT C
+7 ;
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",$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 MERGEX
+14 ;S APCDVLDT=+^AUPNVSIT(APCDVMF,0)\1
+15 WRITE !!,"Select 'To' visit.",!
+16 SET APCDVV="APCDVMT"
DO GETVISIT
+17 IF 'APCDVMT
GOTO MERGEX
+18 IF APCDVMF=APCDVMT
WRITE !!,"'From' and 'To' the same. Bye!"
DO EOP
GOTO MERGEX
+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 !!!,"You will be merging the following 2 visits:"
+21 WRITE !,"FROM VISIT:"
SET APCDAX=APCDVMF
DO WRITE
+22 WRITE !,"TO VISIT:"
SET APCDAX=APCDVMT
DO WRITE
+23 WRITE !!
SET DIR(0)="Y"
SET DIR("A")="Do you want to continue"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+24 IF $DATA(DIRUT)
GOTO MERGEDDX
+25 IF 'Y
GOTO MERGEDDX
+26 WRITE !!,"*** FROM VISIT ***"
+27 KILL DR
SET APCDVDSP=APCDVMF
DO ^APCDVDSP
+28 WRITE !!,"*** TO VISIT ***"
+29 KILL DR
SET APCDVDSP=APCDVMT
DO ^APCDVDSP
+30 SET APCDCAF="IN CAF"
DO EN1^APCDVMDD
+31 ;
MERGEDDX ;
+1 KILL APCDVSIT,APCDPAT,X,Y,AUPNVSIT,AUPNDAYS,APCDCAF,APCDCAFD,APCDPAT,APCDVMT,APCDVMF
+2 DO EN1^APCDEKL
+3 DO EN2^APCDEKL
+4 DO KILL^AUPNPAT
+5 DO BACK
+6 QUIT
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
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",$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,APCDCAFD,APCDPAT,APCDVMT,APCDVMF
+2 DO EN1^APCDEKL
+3 DO EN2^APCDEKL
+4 DO KILL^AUPNPAT
+5 DO BACK
+6 QUIT
CVD ;EP
+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 CVDX
+5 IF $DATA(DIRUT)
WRITE !,"No VISIT selected."
DO EOP
GOTO CVDX
+6 SET APCDVSIT=^TMP("APCDCAF",$JOB,"IDX",Y,Y)
+7 DO ^XBFMK
+8 ;DSPLY ;
+9 WRITE !
+10 SET DIC="^AUPNVSIT("
SET DA=APCDVSIT
DO EN^DIQ
KILL DIC,DIQ,DA
CHANGEVD ; CHANGE VISIT DATE/TIME
+1 WRITE !!,"The date and time of the VISIT is ",$$VAL^XBDIQ1(9000010,APCDVSIT,.01),!
+2 SET %DT="ATRX"
SET %DT("A")="Enter new date and time: "
DO ^%DT
KILL %DT
+3 IF Y<0
WRITE !!,"Bye"
GOTO CVDX
+4 WRITE !,"The new visit date and time will be: ",$$FMTE^XLFDT(Y,1)
+5 SET X=Y
DO CHKVD
+6 IF '$DATA(X)
WRITE !!,"Invalid Date/Time"
DO EOP
GOTO CVDX
+7 SET APCDX=X
+8 SET DIR(0)="Y"
SET DIR("A")="Is this okay"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+9 IF $DATA(DIRUT)
DO EOP
GOTO CVDX
+10 IF 'Y
DO EOP
GOTO CVDX
+11 WRITE " <WAIT>"
+12 SET APCDCVDT("VISIT DFN")=APCDVSIT
+13 SET APCDCVDT("VISIT DATE/TIME")=APCDX
+14 SET APCDCVDT("TALK")=1
+15 DO ^APCDCVDT
+16 IF $DATA(Y)
WRITE !,"Updating the Date Last Modified failed!!"
CVDX ;
+1 KILL DIR,DIRUT,DUOUT,Y,APCDVSIT,APCDCAF,APCDCAFV,APCDVDLT,APCDCVDT,APCDX
+2 DO KILL^AUPNPAT
+3 DO BACK
+4 QUIT
CHKVD ; CHECK NEW VISIT DATE
+1 SET Y=$PIECE(^AUPNVSIT(APCDVSIT,0),U,5)
DO ^AUPNPAT
+2 DO VSIT01^AUPNVSIT
+3 QUIT
MOVEVDD ;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 MOVEVDDX
+6 IF $DATA(DIRUT)
WRITE !,"No VISIT selected."
DO EOP
GOTO MOVEVDDX
+7 SET APCDVSIT=^TMP("APCDCAF",$JOB,"IDX",Y,Y)
+8 SET APCDPAT=$PIECE(^AUPNVSIT(APCDVSIT,0),U,5)
+9 SET Y=APCDPAT
DO ^AUPNPAT
+10 DO GETFROM^APCDKULD
+11 IF 'APCDVMF
GOTO MOVEVDDX
+12 DO GETTO^APCDKULD
+13 IF 'APCDVMT
GOTO MOVEVDDX
+14 IF APCDVMF=APCDVMT
WRITE !!,"'From' and 'To' the same. Bye!"
DO EOP
GOTO MOVEVDDX
QUIT
+15 DO EP1^APCDKULD
MOVEVDDX ;
+1 KILL APCDVSIT,APCDPAT,X,Y,AUPNVSIT,AUPNDAYS,APCDCAF,APCDCAFD,APCDPAT,APCDVMT,APCDVMF
+2 DO EN1^APCDEKL
+3 DO EN2^APCDEKL
+4 DO KILL^AUPNPAT
+5 DO BACK
+6 QUIT
+7 ;
ADDVISIT ;EP - ADD NEW VISIT CALLED FROM PROTOCOL ENTRY
+1 DO FULL^VALM1
+2 DO EN^XBNEW("^APCDEA","")
+3 DO EN^APCDEKL
+4 DO EN2^APCDEKL
+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",$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,APCDCAFD
+2 DO EN^APCDEKL
+3 DO EN2^APCDEKL
+4 DO KILL^AUPNPAT
+5 DO BACK
+6 QUIT
