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

AMHLEDV.m

Go to the documentation of this file. 
  1. AMHLEDV ; IHS/CMI/LAB - ;
  1.  ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
  1.  ;
  1.  ;
  1. START ;
  1.  W !!,"This option has been disabled." H 4 Q
  1.  D FULL^VALM1
  1.  ;D EN^AMHEKL
  1.  D ^AMHLEIN
  1.  W:$D(IOF) @IOF
  1.  W !!,"This option is used to duplicate a patient visit that occurred on a different",!,"day.  The user selects a visit, enters a new date, and then the visit",!,"is copied to the new date.",!!
  1.  W !,"You must first identify the patient and the visit to duplicate.",!
  1. GETPAT ;EP
  1.  D ^XBFMK
  1.  S AMHC=0
  1.  I $G(AMHPAT) G GETDATE
  1. GETPAT1 W !!!?20,"TYPE THE PATIENT'S HRN, NAME, SSN OR DOB" S DIC("A")="                    Patient:  "
  1.  S AMHPAT=""
  1.  S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC,DA,DR,DLAYGO,DIADD
  1.  I Y<0 D XIT Q
  1.  S AMHPAT=+Y
  1.  I AMHPAT,'$$ALLOWP^AMHUTIL(DUZ,AMHPAT) D NALLOWP^AMHUTIL D PAUSE^AMHLEA G GETPAT1
  1.  I $G(AUPNDOD)]"" W !!?10,"***** PATIENT'S DATE OF DEATH IS ",$$FMTE^XLFDT(AUPNDOD),!! H 2
  1.  W !?25,"Ok" S %=1 D YN^DICN I %'=1 S AMHPAT="" K AMHC Q
  1. GETDATE ;EP
  1.  S AMHDATE=""
  1.  S DIR(0)="DO^::EP",DIR("A")="Enter PREVIOUS DATE OF ENCOUNTER (if known, otherwise press ENTER)" KILL DA D ^DIR KILL DIR
  1.  I $D(DUOUT) D XIT Q
  1.  S AMHDATE=Y
  1. GETPROV ;
  1.  S DIC=200,DIC(0)="AEMQ",DIC("A")="Enter PROVIDER of SERVICE: " D ^DIC K DIC,DA
  1.  I Y=-1 G GETDATE
  1.  S AMHPROV=+Y
  1. GETVISIT ;
  1.  I '$D(^AMHREC("C",AMHPAT)) W $C(7),$C(7),!,"Patient has no visits to duplicate" D PAUSE,XIT Q
  1.  ;gather visits for this provider in array AMHPATV
  1.  K AMHPATV
  1.  S AMHX=0 F  S AMHX=$O(^AMHREC("C",AMHPAT,AMHX)) Q:AMHX'=+AMHX  D
  1.  .I AMHDATE]"",$P($P(^AMHREC(AMHX,0),U),".")'=AMHDATE Q
  1.  .Q:'$$ALLOWVI^AMHUTIL(DUZ,AMHX)
  1.  .I $$PPINT^AMHUTIL(AMHX)'=AMHPROV Q
  1.  .S AMHPATV(AMHX)=""
  1.  .Q
  1.  I '$D(AMHPATV) W $C(7),$C(7),!,"Patient has no visits to meeting your criteria to duplicate.",! D PAUSE,XIT Q
  1. EN ; EP -- main entry point for AMH UPDATE ACTIVITY RECORDS
  1.  S VALMCC=1
  1.  D EN^VALM("AMH DE LIST PATIENTS VISITS")
  1.  D CLEAR^VALM1
  1.  Q
  1.  ;
  1. HDR ;EP -- header code
  1.  S VALMHDR(1)=$TR($J(" ",80)," ","-")
  1.  D GETHRN
  1.  S VALMHDR(2)="Visits for "_$P(^DPT(AMHPAT,0),U)_"   HRN:  "_AMHHRN
  1.  S VALMHDR(3)="Provider:  "_$P(^VA(200,AMHPROV,0),U)
  1.  S VALMHDR(4)=$TR($J(" ",80)," ","-")
  1.  K AMHHRN
  1.  S VALMHDR(5)=" #  PRV VISIT DATE          CONTACT   LOC     ACT   PROB    NARRATIVE"
  1.  Q
  1.  ;
  1. INIT ;EP -- init variables and list array
  1.  S VALMSG="QU - Quit ?? for more actions + next screen - prev screen"
  1.  D GATHER^AMHLEDV1 ;gather up all records for display
  1.  S VALMCNT=AMHRCNT
  1.  Q
  1.  ;
  1. HELP ;EP -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  K AMHRCNT,^TMP("AMHPATV",$J)
  1.  K VALMCC,VALMHDR
  1.  Q
  1.  ;
  1. XIT ;kill variables and quit
  1.  D CLEAR^VALM1
  1.  D EN^AMHEKL
  1.  K ^TMP("AMHPATV",$J)
  1.  K AMHPAT,AMHDATE,AMHPROV,AMHPATV,AMHX,AMHC,AMHNEWD,AMHR1
  1.  Q
  1. PAUSE ;EP
  1.  S DIR(0)="EO",DIR("A")="Press enter to continue...." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  Q
  1. EXPND ; -- expand code
  1.  Q
  1.  ;
  1. GETHRN ;
  1.  S AMHHRN=""
  1.  I AMHPAT]""  D
  1.  .I $D(^AUPNPAT(AMHPAT,41,AMHPAT)) S AMHHRN=$P(^AUTTLOC(AMHPAT,0),U,7)_" "_$P(^AUPNPAT(AMHPAT,41,AMHPAT,0),U,2) Q
  1.  .I $D(^AUPNPAT(AMHPAT,41,DUZ(2))) S AMHHRN=$P(^AUTTLOC(DUZ(2),0),U,7)_" "_$P(^AUPNPAT(AMHPAT,41,DUZ(2),0),U,2) Q
  1.  .S AMHHRN="<none>"
  1.  E  S AMHHRN="  --  "
  1.  Q
  1. SELECT ;select record, get new date, confirm, duplicate
  1.  D EN^VALM2(XQORNOD(0),"OS")
  1.  I '$D(VALMY) W !,"No records selected." G XIT
  1.  S AMHR1=$O(VALMY(0)) I 'AMHR1 K AMHR1,VALMY,XQORNOD W !,"No record selected." G XIT
  1.  S AMHR1=^TMP("AMHPATV",$J,"IDX",AMHR1,AMHR1) I 'AMHR1 K AMHRDEL,AMHR1 D PAUSE D XIT Q
  1.  I '$D(^AMHREC(AMHR1,0)) W !,"Not a valid BH RECORD." K AMHRDEL,AMHR1 D PAUSE D XIT Q
  1.  D FULL^VALM1
  1.  W !,"The following visit will be duplicated:",!
  1.  W !,$TR($J(" ",80)," ","-"),! W ^TMP("AMHPATV",$J,$O(VALMY(0)),0),!!!
  1.  S AMHNEWD=""
  1. NEWDATE ;get new date
  1.  D FULL^VALM1 W:$D(IOF) @IOF
  1.  S DIR(0)="D^::EP",DIR("A")="Enter NEW Visit Date" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) W !,$C(7),$C(7),"New date not entered" D BACK
  1.  S AMHNEWD=Y
  1. DUPLICAT ;
  1.  W !,"Duplicating visit to ",$$FMTE^XLFDT(AMHNEWD)," HOLD ON..."
  1.  S AMHPTYPE=$P(^AMHREC(AMHR1,0),U,2)
  1.  S APCDOVRR=""
  1.  S AMHQUIT=0,AMHACTN=1
  1. CREATE ;
  1.  W !,"Creating new record..." K DD,D0,DO,DINUM,DIC,DA,DR S DIC(0)="EL",DIC="^AMHREC(",DLAYGO=9002011,DIADD=1,X=AMHNEWD,DIC("DR")=".03///^S X=DT;.19////"_DUZ_";.21///^S X=DT;.22///A;.28////"_DUZ_";1111////1"
  1.  D FILE^DICN K DIC,DR,DIE,DIADD,DLAYGO,X,D0
  1.  I Y=-1 W !!,$C(7),$C(7),"Behavioral Health Record is NOT complete!!  Deleting Record.",! D PAUSE Q
  1.  ;update multiple of user last update/date edited
  1.  S AMHR=+Y
  1.  S DIE="^AMHREC(",DA=AMHR,DR="5100///NOW",DR(2,9002011.5101)=".02////^S X=DUZ" D ^DIE K DIE,DA,DR
  1.  S DA=AMHR,DR=".08////"_AMHPAT,DIE="^AMHREC(" D CALLDIE^AMHLEIN
  1.  ;set up DIE string and 4 slash
  1.  F X=2,4,5,6,7,8,9,25,26,29,31,33 S $P(^AMHREC(AMHR,0),U,X)=$P(^AMHREC(AMHR1,0),U,X)
  1.  S DA=AMHR,DIK="^AMHREC(" D IX1^DIK
  1. POVS ;
  1.  S AMHX=0 F  S AMHX=$O(^AMHRPRO("AD",AMHR1,AMHX)) Q:AMHX'=+AMHX  D
  1.  .S DIC="^AMHRPRO(",X=+^AMHRPRO(AMHX,0),DIC("DR")=".02////"_AMHPAT_";.03////"_AMHR_";.04////"_$P(^AMHRPRO(AMHX,0),U,4),DIADD=1,DLAYGO=9002011.01,DIC(0)="L" K DD,DA,D0,DO D FILE^DICN K DIADD,DIC,DR,DA,DD,D0,DLAYGO
  1.  .I Y=-1 W !!,"Creating pov FAILED!" H 5 Q
  1.  ;copy all povs from 1 visit to another
  1. PROVS ;
  1.  S AMHX=0 F  S AMHX=$O(^AMHRPROV("AD",AMHR1,AMHX)) Q:AMHX'=+AMHX  D
  1.  .S DIC="^AMHRPROV(",X=+^AMHRPROV(AMHX,0),DIC("DR")=".02////"_AMHPAT_";.03////"_AMHR_";.04////"_$P(^AMHRPROV(AMHX,0),U,4),DIADD=1,DLAYGO=9002011.02,DIC(0)="L" K DD,DA,D0,DO D FILE^DICN K DIADD,DIC,DR,DA,DD,D0,DLAYGO
  1. SM ;
  1.  S DA=AMHR,AMHDATE=$P(^AMHREC(AMHR,0),U),DDSFILE=9002011,DR="[AMH ADD RECORD]" D ^DDS
  1.  I $D(DIMSG) W !!,"ERROR IN SCREENMAN FORM!!  ***NOTIFY PROGRAMMER***" S AMHQUIT=1 K DIMSG Q
  1.  ;CHECK RECORD
  1.  S AMHOKAY=0 D RECCHECK^AMHLE2 I AMHOKAY W !!,"Incomplete record!! Deleting record!!" D DEL^AMHLEA,EXIT Q
  1.  I $G(AMHERROR) W !!,$C(7),$C(7),"PLEASE EDIT THIS RECORD!!",!!
  1.  D OTHER^AMHLEA
  1.  D PCCLINK^AMHLE2
  1.  D XIT
  1.  Q
  1. DISPLAY ;EP-DISPLAY AN ACTIVITY RECORD
  1.  D EN^VALM2(XQORNOD(0),"OS")
  1.  I '$D(VALMY) W !,"No records selected." G XIT
  1.  S AMHR=$O(VALMY(0)) I 'AMHR K AMHR,VALMY,XQORNOD W !,"No record selected." G XIT
  1.  S AMHR=^TMP("AMHPATV",$J,"IDX",AMHR,AMHR) I 'AMHR K AMHRDEL,AMHR D PAUSE D XIT Q
  1.  I '$D(^AMHREC(AMHR,0)) W !,"Not a valid BH RECORD." K AMHRDEL,AMHR D PAUSE D XIT Q
  1.  D FULL^VALM1
  1. DISP ;
  1.  NEW AMHPAT,AMHPROV,AMHDATE
  1.  D ^AMHDVD
  1.  D XIT
  1.  Q
  1. BACK ;
  1.  S VALMBCK="R"
  1.  D TERM^VALM0
  1.  D GATHER^AMHLEDV1
  1.  S VALMCNT=AMHRCNT
  1.  D HDR
  1.  K AMHNEWD
  1.  Q
  1. EP1 ;EP
  1.  I '$G(AMHPAT) W "No patient defined." Q
  1.  D FULL^VALM1
  1.  ;D EN^AMHEKL
  1.  D ^AMHLEIN
  1.  W:$D(IOF) @IOF
  1.  W !!,"This option is used to duplicate a patient visit that occurred on a different",!,"day.  The user selects a visit, enters a new date, and then the visit",!,"is copied to the new date.",!!
  1.  W !,"You must first identify the patient and the visit to duplicate.",!
  1.  G GETDATE
  1. RBLK(V,L) ;EP - right blank fill
  1.  NEW %,I
  1.  S %=$L(V),Z=L-% F I=1:1:Z S V=V_" "
  1.  Q V
  1. LBLK(V,L) ;left blank fill
  1.  NEW %,I
  1.  S %=$L(V),Z=L-% F I=1:1:Z S V=" "_V
  1.  Q V