Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: APCDCAF3

APCDCAF3.m

Go to the documentation of this file. 
  1. 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
  1.  ;; ;
  1.  ;
  1. DISP ;
  1.  K DIR
  1.  S DIR(0)="NO^1:"_APCDRCNT,DIR("A")="Which Visit"
  1.  D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I Y="" W !,"No VISIT selected." D EOP G DISPX
  1.  I $D(DIRUT) W !,"No VISIT selected." D EOP G DISPX
  1.  S APCDVSIT=^TMP("APCDCAF OP",$J,"IDX",Y,Y)
  1.  ;RELINKER?
  1.  D ^XBFMK
  1.  S APCDCAFV=APCDVSIT,APCDCAF="IN CAF" D EP^APCDKDE D ^APCDVD S APCDVSIT=APCDCAFV
  1.  ;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
  1.  ;I $D(DIRUT) G DISPX
  1.  ;I 'Y G DISPX
  1.  ;D UPD0
  1.  ;
  1. DISPX ;
  1.  K DIR,DIRUT,DUOUT,Y,APCDVSIT,APCDCAF,APCDCAFV
  1.  D KILL^AUPNPAT
  1.  D BACK
  1.  Q
  1.  ;
  1. BACK ;go back to listman
  1.  D BACK^APCDCAF2
  1.  Q
  1.  ;
  1. MODIFY ;
  1.  D FULL^VALM1
  1.  K DIR
  1.  S DIR(0)="NO^1:"_APCDRCNT,DIR("A")="Modify which Visit"
  1.  D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I Y="" W !,"No VISIT selected." D EOP G MODIFYX
  1.  I $D(DIRUT) W !,"No VISIT selected." D EOP G MODIFYX
  1.  S APCDVSIT=^TMP("APCDCAF OP",$J,"IDX",Y,Y)
  1.  S (Y,APCDPAT)=$P(^AUPNVSIT(APCDVSIT,0),U,5)
  1.  D ^AUPNPAT
  1.  S APCDVLK=APCDVSIT
  1.  S APCDDATE=$P($P(^AUPNVSIT(APCDVSIT,0),U),".")
  1.  S APCDCAT=$P(^AUPNVSIT(APCDVSIT,0),U,7)
  1.  S APCDTYPE=$P(^AUPNVSIT(APCDVSIT,0),U,3)
  1.  S APCDLOC=$P(^AUPNVSIT(APCDVSIT,0),U,6)
  1.  S APCDCLN=$P(^AUPNVSIT(APCDVSIT,0),U,8)
  1.  I AUPNDOB]"",$D(APCDDATE) S X2=AUPNDOB,X1=APCDDATE D ^%DTC S AUPNDAYS=X ; re-set days of age to visit date-dob
  1.  S APCDFLG=0 D ^APCDEIN I APCDFLG W !!,"error in data entry modify mode" D EOP G MODIFYX
  1.  D START^APCDEWHO(APCDVSIT)
  1.  S APCDMODE="M"
  1.  S AUPNVSIT=APCDVSIT D MOD^AUPNVSIT
  1.  D ^XBFMK
  1.  S APCDCAFV=APCDVSIT,APCDCAF="IN CAF" D EP^APCDKDE D PROCESS^APCDEM S APCDVSIT=APCDCAFV
  1.  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
  1.  I $D(DIRUT) G MODIFYX
  1.  I 'Y G MODIFYX
  1.  D UPD0
  1.  ;
  1. MODIFYX ;
  1.  K APCDVSIT,APCDPAT,X,Y,AUPNVSIT,AUPNDAYS,APCDCAF,APCDCAFV
  1.  D EN^APCDEKL
  1.  D EN2^APCDEKL
  1.  D KILL^AUPNPAT
  1.  D BACK
  1.  Q
  1.  ;
  1. APPEND ;
  1.  D FULL^VALM1
  1.  K DIR
  1.  S DIR(0)="NO^1:"_APCDRCNT,DIR("A")="APPEND to which Visit"
  1.  D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I Y="" W !,"No VISIT selected." D EOP G APPENDX
  1.  I $D(DIRUT) W !,"No VISIT selected." D EOP G APPENDX
  1.  S APCDVSIT=^TMP("APCDCAF OP",$J,"IDX",Y,Y)
  1.  S (Y,APCDPAT)=$P(^AUPNVSIT(APCDVSIT,0),U,5)
  1.  D ^AUPNPAT
  1.  S APCDVLK=APCDVSIT
  1.  S APCDDATE=$P($P(^AUPNVSIT(APCDVSIT,0),U),".")
  1.  S APCDCAT=$P(^AUPNVSIT(APCDVSIT,0),U,7)
  1.  S APCDTYPE=$P(^AUPNVSIT(APCDVSIT,0),U,3)
  1.  S APCDLOC=$P(^AUPNVSIT(APCDVSIT,0),U,6)
  1.  S APCDCLN=$P(^AUPNVSIT(APCDVSIT,0),U,8)
  1.  I AUPNDOB]"",$D(APCDDATE) S X2=AUPNDOB,X1=APCDDATE D ^%DTC S AUPNDAYS=X ; re-set days of age to visit date-dob
  1.  S APCDFLG=0 D ^APCDEIN I APCDFLG W !!,"error in data entry APPEND mode" D EOP G APPENDX
  1.  D START^APCDEWHO(APCDVSIT)
  1.  S APCDMODE="A",APCDNOXV=""
  1.  S AUPNVSIT=APCDVSIT D MOD^AUPNVSIT
  1.  D ^XBFMK
  1.  S APCDCAFV=APCDVSIT,APCDCAF="IN CAF" D EP^APCDKDE D MNEPROC^APCDEAP S APCDVSIT=APCDCAFV
  1.  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
  1.  I $D(DIRUT) G APPENDX
  1.  I 'Y G APPENDX
  1.  D UPD0
  1.  ;
  1. APPENDX ;
  1.  K APCDVSIT,APCDPAT,X,Y,AUPNVSIT,AUPNDAYS,APCDCAF
  1.  D EN^APCDEKL
  1.  D EN2^APCDEKL
  1.  D KILL^AUPNPAT
  1.  D BACK
  1.  Q
  1.  ;
  1. UPDATE ;EP
  1.  D FULL^VALM1
  1.  K DIR
  1.  S DIR(0)="NO^1:"_APCDRCNT,DIR("A")="Update Chart Audit Status for which Visit"
  1.  D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I Y="" W !,"No VISIT selected." D EOP G UPDATEX
  1.  I $D(DIRUT) W !,"No VISIT selected." D EOP G UPDATEX
  1.  S APCDVSIT=^TMP("APCDCAF OP",$J,"IDX",Y,Y)
  1.  D MOD^AUPNVSIT
  1. UPD0 ;EP
  1.  K DIC,DD,D0,DO
  1.  S X=$$NOW^XLFDT,DIC="^AUPNVCA(",DIC(0)="L",DIADD=1,DLAYGO=9000010.45
  1.  S DIC("DR")=".02////"_$P(^AUPNVSIT(APCDVSIT,0),U,5)_";.03////"_APCDVSIT_";.05////"_DUZ_";1216////"_$$NOW^XLFDT D FILE^DICN
  1.  I Y=-1 W !!,"updating status failed" D EOP G UPDATEX
  1.  K DIC,DD,D0,DIADD,DLAYGO
  1.  S (APCDVCA,DA)=+Y
  1. UPD1 ;
  1.  D ^XBFMK
  1.  S DA=APCDVCA,DIE="^AUPNVCA(",DR=".04" D ^DIE K DA,DIE,DR
  1.  D ^XBFMK
  1.  S APCDCAR=$P(^AUPNVCA(APCDVCA,0),U,4)
  1.  I APCDCAR="" W !!,"You must enter a status" G UPD1
  1.  S APCDERR=$$ERRORCHK^APCDCAF(APCDVSIT)
  1.  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
  1.  S DIE="^AUPNVSIT(",DA=APCDVSIT,DR=".13////"_DT_";1111////"_APCDCAR D ^DIE K DIE,DA,DR
  1.  I APCDCAR="R" D RNU^APCDCAF4 G UPDATEX
  1. R ;
  1.  D EN^APCDCAF6(APCDVSIT)
  1.  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
  1.  ;PUT CHART AUDIT NOTE HERE
  1.  ;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
  1.  ;I $D(DIRUT) G UPDATEX
  1.  ;I 'Y G UPDATEX
  1.  ;I '$D(^AUPNCANT(APCDVSIT)) D ADDCANT
  1.  ;I '$D(^AUPNCANT(APCDVSIT)) W !!,"adding entry to chart audit notes failed." H 3 G UPDATEX
  1.  ;S DA=APCDVSIT,DIE="^AUPNCANT(",DR=1100 D ^DIE K DIE,DA,DR
  1.  ;
  1.  ;
  1. UPDATEX ;
  1.  K DIADD,DLAYGO
  1.  D ^XBFMK
  1.  K APCDCAR,APCDCVA,APCDVSIT
  1.  D BACK
  1.  Q
  1.  ;
  1. ADDCANT ;
  1.  S ^AUPNCANT(APCDVSIT,0)=APCDVSIT_U_$P(^AUPNVSIT(APCDVSIT,0),U,5)
  1.  S DA=APCDVSIT,DIK="^AUPNCANT(" D IX1^DIK
  1.  Q
  1. EOP ;EP - End of page.
  1.  Q:$E(IOST)'="C"
  1.  ;Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
  1.  NEW DIR
  1.  K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
  1.  S DIR("A")="Press Enter to Continue",DIR(0)="E" D ^DIR
  1.  Q
  1.  ;----------
  1. MERGE ;EP
  1.  D FULL^VALM1
  1.  K DIR
  1.  S DIR(0)="NO^1:"_APCDRCNT,DIR("A")="Which Visit"
  1.  D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I Y="" W !,"No VISIT selected." D EOP G MERGEX
  1.  I $D(DIRUT) W !,"No VISIT selected." D EOP G MERGEX
  1.  S APCDVSIT=^TMP("APCDCAF OP",$J,"IDX",Y,Y)
  1.  S APCDVLDT=$P($P(^AUPNVSIT(APCDVSIT,0),U),"."),APCDPAT=$P(^AUPNVSIT(APCDVSIT,0),U,5)
  1.  S (X,APCDIDT)=(9999999-APCDVLDT),C=0 F  S X=$O(^AUPNVSIT("AA",APCDPAT,X)) Q:X=""!($P(X,".")>APCDIDT)  D
  1.  .S V=0 F  S V=$O(^AUPNVSIT("AA",APCDPAT,X,V)) Q:V'=+V  S C=C+1
  1.  I C<2 W !!,"Patient only has 1 visit on that day, cannot do a merge." D EOP G MERGEX
  1.  S Y=APCDPAT D ^AUPNPAT
  1.  W !!,"Select 'From' visit.",!
  1.  S APCDVV="APCDVMF" D GETVISIT
  1.  I 'APCDVMF G MERGEX
  1.  S APCDVLDT=+^AUPNVSIT(APCDVMF,0)\1
  1.  W !!,"Select 'To' visit.",!
  1.  S APCDVV="APCDVMT" D GETVISIT
  1.  I 'APCDVMT G MERGEX
  1.  I APCDVMF=APCDVMT W !!,"'From' and 'To' the same.  Bye!" D EOP G MERGEX Q
  1.  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
  1.  W !!,"*** FROM VISIT ***"
  1.  K DR S APCDVDSP=APCDVMF D ^APCDVDSP
  1.  W !!,"*** TO VISIT ***"
  1.  K DR S APCDVDSP=APCDVMT D ^APCDVDSP
  1.  S APCDCAF="IN CAF" D EN1^APCDVMRG
  1.  ;
  1. MERGEX ;
  1.  K APCDVSIT,APCDPAT,X,Y,AUPNVSIT,AUPNDAYS,APCDCAF,APCDPAT,APCDVMT,APCDVMF
  1.  D EN1^APCDEKL
  1.  D EN2^APCDEKL
  1.  D KILL^AUPNPAT
  1.  D BACK
  1.  Q
  1.  ;
  1. GETVISIT ;
  1.  K APCDVLK
  1.  S APCDLOOK=""
  1.  D ^APCDVLK
  1.  S @APCDVV=APCDLOOK
  1.  K APCDLOOK
  1.  Q
  1.  ;
  1. DEL ;EP
  1.  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
  1.  K DIR
  1.  S DIR(0)="NO^1:"_APCDRCNT,DIR("A")="Which Visit"
  1.  D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I Y="" W !,"No VISIT selected." D EOP G DELX
  1.  I $D(DIRUT) W !,"No VISIT selected." D EOP G DELX
  1.  S APCDVSIT=^TMP("APCDCAF OP",$J,"IDX",Y,Y)
  1.  D ^XBFMK
  1.  ;DSPLY ;
  1.  S APCDVDSP=APCDVSIT D ^APCDVDSP
  1.  I '$$ALLRET^APCDCAF1(APCDVSIT) W !!,"All Notes must be retracted before you can delete this visit." D EOP G DELX
  1.  W !!,"THE ABOVE VISIT AND RELATED V FILE ENTRIES WILL BE REMOVED FOREVER !!!"
  1. DELETE ; DELETE VISIT AND RELATED V FILES
  1.  W !,"Sure you want to delete" S %=2 D YN^DICN S %Y=$E(%Y)
  1.  Q:%Y="^"
  1.  I "Nn"[%Y G DELX
  1.  S DIE="^AUPNVSIT(",DA=APCDVSIT,DR=2201 D ^DIE K DA,DIE,DR
  1.  I $P($G(^AUPNVSIT(APCDVSIT,22)),U)="" S DA=APCDVSIT,DIE="^AUPNVSIT(",DR="2201///NO RESPONSE FROM OPERATOR" D ^DIE K DA,DIE,DR
  1.  ;UPDATE DELETE LOG
  1.  D UPDLOG^APCDVDEL(APCDVSIT)
  1.  S APCDVDLT=APCDVSIT D ^APCDVDLT
  1. DELX ;
  1.  K DIR,DIRUT,DUOUT,Y,APCDVSIT,APCDCAF,APCDCAFV,APCDVDLT
  1.  D KILL^AUPNPAT
  1.  D BACK
  1.  Q
  1.  ;
  1. MERGEDD ;EP
  1.  D FULL^VALM1
  1.  K DIR
  1.  S DIR(0)="NO^1:"_APCDRCNT,DIR("A")="Which Visit"
  1.  D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I Y="" W !,"No VISIT selected." D EOP G MERGEDDX
  1.  I $D(DIRUT) W !,"No VISIT selected." D EOP G MERGEDDX
  1.  S APCDVSIT=^TMP("APCDCAF OP",$J,"IDX",Y,Y)
  1.  ;S APCDVLDT=$P($P(^AUPNVSIT(APCDVSIT,0),U),".")
  1.  S APCDPAT=$P(^AUPNVSIT(APCDVSIT,0),U,5)
  1.  S Y=APCDPAT D ^AUPNPAT
  1.  W !!,"Select 'From' visit.",!
  1.  S APCDVV="APCDVMF" D GETVISIT
  1.  I 'APCDVMF G MERGEDDX
  1.  ;S APCDVLDT=+^AUPNVSIT(APCDVMF,0)\1
  1.  W !!,"Select 'To' visit.",!
  1.  S APCDVV="APCDVMT" D GETVISIT
  1.  I 'APCDVMT G MERGEDDX
  1.  I APCDVMF=APCDVMT W !!,"'From' and 'To' the same.  Bye!" D EOP G MERGEDDX Q
  1.  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
  1.  W !!,"*** FROM VISIT ***"
  1.  K DR S APCDVDSP=APCDVMF D ^APCDVDSP
  1.  W !!,"*** TO VISIT ***"
  1.  K DR S APCDVDSP=APCDVMT D ^APCDVDSP
  1.  S APCDCAF="IN CAF" D EN1^APCDVMRG
  1.  ;
  1. MERGEDDX ;
  1.  K APCDVSIT,APCDPAT,X,Y,AUPNVSIT,AUPNDAYS,APCDCAF,APCDPAT,APCDVMT,APCDVMF
  1.  D EN1^APCDEKL
  1.  D EN2^APCDEKL
  1.  D KILL^AUPNPAT
  1.  D BACK
  1.  Q
  1.  ;
  1. MOVEVD ;EP
  1.  D FULL^VALM1
  1.  K DIR
  1.  S DIR(0)="NO^1:"_APCDRCNT,DIR("A")="Which Visit"
  1.  D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I Y="" W !,"No VISIT selected." D EOP G MOVEVDX
  1.  I $D(DIRUT) W !,"No VISIT selected." D EOP G MOVEVDX
  1.  S APCDVSIT=^TMP("APCDCAF OP",$J,"IDX",Y,Y)
  1.  S APCDVLDT=$P($P(^AUPNVSIT(APCDVSIT,0),U),"."),APCDPAT=$P(^AUPNVSIT(APCDVSIT,0),U,5)
  1.  S (X,APCDIDT)=(9999999-APCDVLDT),C=0 F  S X=$O(^AUPNVSIT("AA",APCDPAT,X)) Q:X=""!($P(X,".")>APCDIDT)  D
  1.  .S V=0 F  S V=$O(^AUPNVSIT("AA",APCDPAT,X,V)) Q:V'=+V  S C=C+1
  1.  I C<2 W !!,"Patient only has 1 visit on that day, cannot move data." D EOP G MOVEVDX
  1.  S Y=APCDPAT D ^AUPNPAT
  1.  W !!,"Select 'From' visit.",!
  1.  S APCDVV="APCDVMF" D GETVISIT
  1.  I 'APCDVMF G MOVEVDX
  1.  S APCDVLDT=+^AUPNVSIT(APCDVMF,0)\1
  1.  W !!,"Select 'To' visit.",!
  1.  S APCDVV="APCDVMT" D GETVISIT
  1.  I 'APCDVMT G MOVEVDX
  1.  I APCDVMF=APCDVMT W !!,"'From' and 'To' the same.  Bye!" D EOP G MOVEVDX Q
  1.  D EP1^APCDKUL
  1. MOVEVDX ;
  1.  K APCDVSIT,APCDPAT,X,Y,AUPNVSIT,AUPNDAYS,APCDCAF,APCDPAT,APCDVMT,APCDVMF
  1.  D EN1^APCDEKL
  1.  D EN2^APCDEKL
  1.  D KILL^AUPNPAT
  1.  D BACK
  1.  Q
  1. RESEQ ;EP
  1.  D FULL^VALM1
  1.  K DIR
  1.  S DIR(0)="NO^1:"_APCDRCNT,DIR("A")="Resequence POVs for which visit"
  1.  D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I Y="" W !,"No VISIT selected." D EOP G RESEQX
  1.  I $D(DIRUT) W !,"No VISIT selected." D EOP G RESEQX
  1.  S APCDVSIT=^TMP("APCDCAF OP",$J,"IDX",Y,Y)
  1.  D EN^APCDRPOV(APCDVSIT)
  1.  D ^XBFMK
  1.  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
  1.  I $D(DIRUT) G RESEQX
  1.  I 'Y G RESEQX
  1.  D UPD0
  1.  ;
  1. RESEQX ;
  1.  K APCDVSIT,APCDPAT,X,Y,AUPNVSIT,AUPNDAYS,APCDCAF
  1.  D EN^APCDEKL
  1.  D EN2^APCDEKL
  1.  D KILL^AUPNPAT
  1.  D BACK
  1.  Q