AMHLEI ; IHS/CMI/LAB - DISPLAY/EDIT TREATMENT NOTES ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
;
;
;; ;
EP1(DFN,AMHREC) ;EP CALLED FROM PROTOCOL
S AMHREC=$G(AMHREC)
I AMHREC,'$D(^AMHREC(AMHREC,0)) S AMHREC=""
Q:'$G(DFN)
Q:'$D(^DPT(DFN))
;get intake document or create new one
D GETINT
D FULL^VALM1
I '$G(AMHINT) W !!,"Error creating intake document." Q
D EN
;D FULL^VALM1
K VALMHDR
K X,Y
Q
EN ; EP -- main entry point for AMH UPDATE ACTIVITY RECORDS
S VALMCC=1
D EN^VALM("AMH INTAKE LIST/EDIT")
D CLEAR^VALM1
Q
;
GETINT ;
S AMHINT=$O(^AMHPINTK("B",DFN,0))
Q:AMHINT
D ^XBFMK
S (DINUM,X)=DFN,DIC(0)="L",DIC="^AMHPINTK(",DLAYGO=9002011.07,DIADD=1,DIC("DR")=".06////^S X=DT" K DD,DO D FILE^DICN K DLAYGO,DIADD,DINUM
I Y=-1 W !!,"Adding new Intake Document failed!!!" H 4 D ^XBFMK Q
S AMHINT=+Y
D ^XBFMK
S DA=AMHINT,DIE="^AMHPINTK("
S DR=".07//"_$S(AMHREC:$$FMTE^XLFDT($P($P(^AMHREC(AMHREC,0),U),".")),1:$$FMTE^XLFDT(DT))_";.08//^S X=$P(^VA(200,DUZ,0),U)"
S DR=DR_";.02//"_$S(AMHREC:$$FMTE^XLFDT($P($P(^AMHREC(AMHREC,0),U),".")),1:$$FMTE^XLFDT(DT))_";.03//^S X=$P(^VA(200,DUZ,0),U)"
D ^DIE,^XBFMK
Q
BACK ;EP - go back to listman
D TERM^VALM0
S VALMBCK="R"
D INIT
D HDR
K DIR
K X,Y,Z,I
Q
D ;
W !
D ^XBFMK S DA=AMHINT,DIE="^AMHPINTK(",DR=AMHX2 D ^DIE D ^XBFMK
Q
RB ;EP
D FULL^VALM1
W !!!
D ^XBFMK S DA=DFN,DIE="^AMHPINTK(",DR=1000 D ^DIE D ^XBFMK
D BACK
Q
ED ;EP
D FULL^VALM1
W !!!
D ^XBFMK
S DA=DFN,DIE="^AMHPINTK("
S DR=".02//"_$S(AMHREC:$$FMTE^XLFDT($P($P(^AMHREC(AMHREC,0),U),".")),1:$$FMTE^XLFDT(DT))_";.03//^S X=$P(^VA(200,DUZ,0),U)"_";4100"
D ^DIE K DIE,DR,DA,DIU,DIV,DIW
D ^XBFMK
D BACK
Q
DP ;update designated provider
S (AMHPAT,AMHPATH)=DFN D 1^AMHLEA S (DFN,AMHPAT)=AMHPATH K AMHPATH
D BACK
Q
GATHER ;EP - called from AMHUAR
K ^TMP("AMHLEI1",$J)
D DISP^AMHLEI2(DFN)
Q
HDR ;EP -- header code
S VALMHDR(1)="Patient Name: "_$P(^DPT(DFN,0),U)_" DOB: "_$$FTIME^VALM1($P(^DPT(DFN,0),U,3))_" Sex: "_$P(^DPT(DFN,0),U,2)
Q
;
INIT ;EP -- init variables and list array
D GATHER ;gather up all records for display
S VALMCNT=AMHCTR
Q
;
HELP ;EP -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
DISP ;
D EN^AMHLEI1(DFN)
D BACK
Q
EXIT ; -- exit code
K AMHRCNT,AMHPTP,AMHE,AMHCTR,AMHLEL,AMHLETXT,AMHGNUM,AMHTPN,AMHCOL,AMHLEI,AMHINT
K VALMCC,VALMHDR
Q
;
EXPND ; -- expand code
Q
;
;
DEL ;EP - called from protocol
I '$D(^XUSEC("AMHZ DELETE RECORD",DUZ)) W !!,"You do not have the security access to delete a Intake Document.",!,"Please see your supervisor or program manager.",! D PAUSE^AMHLEA,BACK Q
D FULL^VALM1
;are you sure??
S DIR(0)="Y",DIR("A")="Are you sure you want to delete this INTAKE DOCUMENT",DIR("B")="N" KILL DA D ^DIR KILL DIR
I 'Y W !!,"Intake document not deleted." D PAUSE^AMHLEA,BACK Q
W !!!
D ^XBFMK S DA=DFN,DIK="^AMHPINTK(" D ^DIK D ^XBFMK
W !!,"Intake document deleted." D PAUSE^AMHLEA
D BACK
Q
AMHLEI ; IHS/CMI/LAB - DISPLAY/EDIT TREATMENT NOTES ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
+3 ;
+4 ;
+5 ;; ;
EP1(DFN,AMHREC) ;EP CALLED FROM PROTOCOL
+1 SET AMHREC=$GET(AMHREC)
+2 IF AMHREC
IF '$DATA(^AMHREC(AMHREC,0))
SET AMHREC=""
+3 IF '$GET(DFN)
QUIT
+4 IF '$DATA(^DPT(DFN))
QUIT
+5 ;get intake document or create new one
+6 DO GETINT
+7 DO FULL^VALM1
+8 IF '$GET(AMHINT)
WRITE !!,"Error creating intake document."
QUIT
+9 DO EN
+10 ;D FULL^VALM1
+11 KILL VALMHDR
+12 KILL X,Y
+13 QUIT
EN ; EP -- main entry point for AMH UPDATE ACTIVITY RECORDS
+1 SET VALMCC=1
+2 DO EN^VALM("AMH INTAKE LIST/EDIT")
+3 DO CLEAR^VALM1
+4 QUIT
+5 ;
GETINT ;
+1 SET AMHINT=$ORDER(^AMHPINTK("B",DFN,0))
+2 IF AMHINT
QUIT
+3 DO ^XBFMK
+4 SET (DINUM,X)=DFN
SET DIC(0)="L"
SET DIC="^AMHPINTK("
SET DLAYGO=9002011.07
SET DIADD=1
SET DIC("DR")=".06////^S X=DT"
KILL DD,DO
DO FILE^DICN
KILL DLAYGO,DIADD,DINUM
+5 IF Y=-1
WRITE !!,"Adding new Intake Document failed!!!"
HANG 4
DO ^XBFMK
QUIT
+6 SET AMHINT=+Y
+7 DO ^XBFMK
+8 SET DA=AMHINT
SET DIE="^AMHPINTK("
+9 SET DR=".07//"_$SELECT(AMHREC:$$FMTE^XLFDT($PIECE($PIECE(^AMHREC(AMHREC,0),U),".")),1:$$FMTE^XLFDT(DT))_";.08//^S X=$P(^VA(200,DUZ,0),U)"
+10 SET DR=DR_";.02//"_$SELECT(AMHREC:$$FMTE^XLFDT($PIECE($PIECE(^AMHREC(AMHREC,0),U),".")),1:$$FMTE^XLFDT(DT))_";.03//^S X=$P(^VA(200,DUZ,0),U)"
+11 DO ^DIE
DO ^XBFMK
+12 QUIT
BACK ;EP - go back to listman
+1 DO TERM^VALM0
+2 SET VALMBCK="R"
+3 DO INIT
+4 DO HDR
+5 KILL DIR
+6 KILL X,Y,Z,I
+7 QUIT
D ;
+1 WRITE !
+2 DO ^XBFMK
SET DA=AMHINT
SET DIE="^AMHPINTK("
SET DR=AMHX2
DO ^DIE
DO ^XBFMK
+3 QUIT
RB ;EP
+1 DO FULL^VALM1
+2 WRITE !!!
+3 DO ^XBFMK
SET DA=DFN
SET DIE="^AMHPINTK("
SET DR=1000
DO ^DIE
DO ^XBFMK
+4 DO BACK
+5 QUIT
ED ;EP
+1 DO FULL^VALM1
+2 WRITE !!!
+3 DO ^XBFMK
+4 SET DA=DFN
SET DIE="^AMHPINTK("
+5 SET DR=".02//"_$SELECT(AMHREC:$$FMTE^XLFDT($PIECE($PIECE(^AMHREC(AMHREC,0),U),".")),1:$$FMTE^XLFDT(DT))_";.03//^S X=$P(^VA(200,DUZ,0),U)"_";4100"
+6 DO ^DIE
KILL DIE,DR,DA,DIU,DIV,DIW
+7 DO ^XBFMK
+8 DO BACK
+9 QUIT
DP ;update designated provider
+1 SET (AMHPAT,AMHPATH)=DFN
DO 1^AMHLEA
SET (DFN,AMHPAT)=AMHPATH
KILL AMHPATH
+2 DO BACK
+3 QUIT
GATHER ;EP - called from AMHUAR
+1 KILL ^TMP("AMHLEI1",$JOB)
+2 DO DISP^AMHLEI2(DFN)
+3 QUIT
HDR ;EP -- header code
+1 SET VALMHDR(1)="Patient Name: "_$PIECE(^DPT(DFN,0),U)_" DOB: "_$$FTIME^VALM1($PIECE(^DPT(DFN,0),U,3))_" Sex: "_$PIECE(^DPT(DFN,0),U,2)
+2 QUIT
+3 ;
INIT ;EP -- init variables and list array
+1 ;gather up all records for display
DO GATHER
+2 SET VALMCNT=AMHCTR
+3 QUIT
+4 ;
HELP ;EP -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
DISP ;
+1 DO EN^AMHLEI1(DFN)
+2 DO BACK
+3 QUIT
EXIT ; -- exit code
+1 KILL AMHRCNT,AMHPTP,AMHE,AMHCTR,AMHLEL,AMHLETXT,AMHGNUM,AMHTPN,AMHCOL,AMHLEI,AMHINT
+2 KILL VALMCC,VALMHDR
+3 QUIT
+4 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
+3 ;
DEL ;EP - called from protocol
+1 IF '$DATA(^XUSEC("AMHZ DELETE RECORD",DUZ))
WRITE !!,"You do not have the security access to delete a Intake Document.",!,"Please see your supervisor or program manager.",!
DO PAUSE^AMHLEA
DO BACK
QUIT
+2 DO FULL^VALM1
+3 ;are you sure??
+4 SET DIR(0)="Y"
SET DIR("A")="Are you sure you want to delete this INTAKE DOCUMENT"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+5 IF 'Y
WRITE !!,"Intake document not deleted."
DO PAUSE^AMHLEA
DO BACK
QUIT
+6 WRITE !!!
+7 DO ^XBFMK
SET DA=DFN
SET DIK="^AMHPINTK("
DO ^DIK
DO ^XBFMK
+8 WRITE !!,"Intake document deleted."
DO PAUSE^AMHLEA
+9 DO BACK
+10 QUIT
