BPCBHDSP ; IHS/OIT/MJL - behavioral health display for GUI ; [ 11/14/2007 10:40 AM ]
;;1.5;BPC;**3,4**;FEB 16, 2005
;
;
TESTREC ;
D RECDISP(.RETVAL,33)
Q
TESTENC ;
D ENCFORM(.RETVAL,33,"S")
Q
TESTSUIC ;
D SUICDSP(.RETVAL,5)
Q
SUICDSP(BGUARRAY,BPCIEN) ;EP CALL FROM REMOTE PROC: BPCBH SUICIDE FORM DSP
;
ENSFDSP ;
S JOB=$J,BPCGUI=1,XWBWRAP=1
S ZTIO="",ZTQUEUED=1
S BGUARRAY="^XTMP(""BPCSF"","_$J_")"
S AMHSF=BPCIEN
K ^XTMP("BPCSF",JOB)
S ^XTMP("BPCSFRUN",JOB)=""
D ^XBKSET
;D GUIR^XBLM("PRINT^AMHLESF1","^XTMP(""BPCSF"",JOB)")
;S X=0,BPCCTR=0 F S X=$O(^XTMP("BPCSF",JOB,X)) Q:X'=+X S BPCCTR=BPCCTR+1
;S ^XTMP("BPCSF",JOB,.5)=BPCCTR+1
S ZTRTN="TSK^BPCBHDSP",ZTIO="",ZTDESC="BPC SF REPORT",ZTSAVE("AMHSF")="",ZTSAVE("JOB")="",ZTDTH=$H D ^%ZTLOAD
F I=1:1:60 Q:$G(^XTMP("BPCSFRUN",$J))="DONE" H 1
D KILL
Q
;
TSK ;
D ^XBKSET
S ^XTMP("BPCSFRUN",JOB)="START"
D GUIR^XBLM("PRINT^AMHLESF1","^XTMP(""BPCSF"",JOB)")
S ^XTMP("BPCSF",JOB,.5)=$O(^XTMP("BPCSF",JOB,""),-1)+1
S ^XTMP("BPCSFRUN",JOB)="DONE"
Q
;
TSKITKF ; Task Intake Form
D ^XBKSET
S ^XTMP("BPCIFRUN",JOB)="START"
D GUIR^XBLM("PRINT1^AMHLEI3","^XTMP(""BPCIF"",JOB)")
S ^XTMP("BPCIF",JOB,.5)=$O(^XTMP("BPCIF",JOB,""),-1)+1
S ^XTMP("BPCIFRUN",JOB)="DONE"
Q
;
KILL ;
K BPCCTR,BPCGUI,AMHSF,DIC,JOB,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
Q
ENCFORM(AMHARRY,AMHR,AMHEFT) ;EP called to get encounter form in array
;AMHR=ien of BH record
;array is ^TMP("AMHS",$J,"DCS")
;AMHEFT=type of form to print
; S - Suppressed
; F - Full
S AMHARRY=$NA(@"^TMP(""AMHS"",$J,""DCS"")")
K ^TMP("AMHS",$J,"DCS")
I $G(AMHEFT)="" S AMHEFT="F"
I "FS"'[AMHEFT Q
D EP2^AMHLEFP2(AMHR,1)
NEW BPCCTR,X S (X,BPCCTR)=0 F S X=$O(^TMP("AMHS",$J,"DCS",X)) Q:X'=+X S BPCCTR=BPCCTR+1
S ^TMP("AMHS",$J,"DCS",.5)=BPCCTR+1 K ^TMP("AMHS",$J,"DCS",0)
Q
;
INTAKE(BGUARRAY,BPCIEN) ;EP called to return an INTAKE form in an array
S JOB=$J,BPCGUI=1,XWBWRAP=1
S ZTIO="",ZTQUEUED=1
S BGUARRAY="^XTMP(""BPCIF"","_$J_")"
K ^XTMP("BPCIF",JOB)
S ^XTMP("BPCIFRUN",JOB)=""
D ^XBKSET
S DFN=BPCIEN,AMHPG=0
S ZTRTN="TSKITKF^BPCBHDSP",ZTIO="",ZTDESC="BPCBH INTAKE FORM",ZTSAVE("DFN")="",ZTSAVE("DFN")="",ZTSAVE("JOB")="",ZTSAVE("AMHPG")="",ZTDTH=$H D ^%ZTLOAD
F I=1:1:60 Q:$G(^XTMP("BPCIFRUN",$J))="DONE" H 1
D KILL
Q
;
;
RECDISP(AMHARRY,AMHR) ;EP - called to display one BH record
;retval=array containg data, AMHR=ien of behavioral health record
;array returned is ^TMP("AMHVDSG",$J)
NEW X
S AMHARRY=$NA(@"^TMP(""AMHVDSG"",$J)")
K ^TMP("AMHVDSG",$J)
K X D EN^AMHVDSG1(AMHARRY,AMHR)
NEW BPCCTR S (X,BPCCTR)=0 F S X=$O(^TMP("AMHVDSG",$J,X)) Q:X'=+X S BPCCTR=BPCCTR+1,^TMP("AMHVDSG",$J,X)=^TMP("AMHVDSG",$J,X,0) K ^TMP("AMHVDSG",$J,X,0)
S ^TMP("AMHVDSG",$J,.5)=BPCCTR+1
Q
;
TIUN(BGUARRAY,BPCIEN) ;EP called to return TIU notes in an array
I '$P($G(^AMHREC(BPCIEN,11)),U,8) Q
S BGUARRAY="^TMP(""AMHS"","_$J_",""DCS"")"
S AMHR=BPCIEN
K @BGUARRAY S @BGUARRAY@(0)=0
S X="TIU Note:" D S(X,1)
K AMHAR,AMHERR,AMHTIU
S AMHDOC=$P(^AMHREC(AMHR,11),U,8)
I '+$$CANDO^TIULP(AMHDOC,"PRINT RECORD",DUZ) S X="",$E(X,3)="You do not have security clearance to display the TIU NOTE." D S(X) K AMHTIU Q
; Extract specified note
S AMHGBL=$NA(^TMP("AMHOENPS",$J)),AMHHLF=IOM\2
K @AMHGBL
D EXTRACT^TIULQ(AMHDOC,AMHGBL,.AMHERR,".01;.02;.03;.05;.07;.08;1202;1203;1205;1208;1209;1301;1307;1402;1501:1505;1507:1513;1701","",1,"E")
M AMHTIU=^TMP("AMHOENPS",$J,AMHDOC)
K ^TMP("AMHOENPS",$J)
D S(AMHTIU(.01,"E"))
D S("AUTHOR: "_AMHTIU(1202,"E"))
D S("SIGNED BY: "_AMHTIU(1502,"E")_" STATUS: "_AMHTIU(.05,"E"))
D S("LOCATION: "_AMHTIU(1205,"E"))
F AMHX=0:0 S AMHX=$O(AMHTIU("TEXT",AMHX)) Q:'AMHX D S(AMHTIU("TEXT",AMHX,0))
I $L($G(AMHTIU(1501,"E"))) D
.D S("/es/ "_$G(AMHTIU(1503,"E")))
.D S("Signed: "_$G(AMHTIU(1501,"E")))
;
K AMHTIU
Q
;
S(Y,F,C,T) ;set up array
NEW %
I '$G(F) S F=0
I '$G(T) S T=0
;blank lines
F F=1:1:F S X="" D S1
S X=Y
I $G(C) S L=$L(Y),T=(80-L)/2 D D S1 Q
.F %=1:1:(T-1) S X=" "_X
F %=1:1:T S X=" "_Y
D S1
Q
S1 ;
S %=$P(^TMP("AMHS",$J,"DCS",0),U)+1,$P(^TMP("AMHS",$J,"DCS",0),U)=%
S ^TMP("AMHS",$J,"DCS",%)=X
Q
BPCBHDSP ; IHS/OIT/MJL - behavioral health display for GUI ; [ 11/14/2007 10:40 AM ]
+1 ;;1.5;BPC;**3,4**;FEB 16, 2005
+2 ;
+3 ;
TESTREC ;
+1 DO RECDISP(.RETVAL,33)
+2 QUIT
TESTENC ;
+1 DO ENCFORM(.RETVAL,33,"S")
+2 QUIT
TESTSUIC ;
+1 DO SUICDSP(.RETVAL,5)
+2 QUIT
SUICDSP(BGUARRAY,BPCIEN) ;EP CALL FROM REMOTE PROC: BPCBH SUICIDE FORM DSP
+1 ;
ENSFDSP ;
+1 SET JOB=$JOB
SET BPCGUI=1
SET XWBWRAP=1
+2 SET ZTIO=""
SET ZTQUEUED=1
+3 SET BGUARRAY="^XTMP(""BPCSF"","_$JOB_")"
+4 SET AMHSF=BPCIEN
+5 KILL ^XTMP("BPCSF",JOB)
+6 SET ^XTMP("BPCSFRUN",JOB)=""
+7 DO ^XBKSET
+8 ;D GUIR^XBLM("PRINT^AMHLESF1","^XTMP(""BPCSF"",JOB)")
+9 ;S X=0,BPCCTR=0 F S X=$O(^XTMP("BPCSF",JOB,X)) Q:X'=+X S BPCCTR=BPCCTR+1
+10 ;S ^XTMP("BPCSF",JOB,.5)=BPCCTR+1
+11 SET ZTRTN="TSK^BPCBHDSP"
SET ZTIO=""
SET ZTDESC="BPC SF REPORT"
SET ZTSAVE("AMHSF")=""
SET ZTSAVE("JOB")=""
SET ZTDTH=$HOROLOG
DO ^%ZTLOAD
+12 FOR I=1:1:60
IF $GET(^XTMP("BPCSFRUN",$JOB))="DONE"
QUIT
HANG 1
+13 DO KILL
+14 QUIT
+15 ;
TSK ;
+1 DO ^XBKSET
+2 SET ^XTMP("BPCSFRUN",JOB)="START"
+3 DO GUIR^XBLM("PRINT^AMHLESF1","^XTMP(""BPCSF"",JOB)")
+4 SET ^XTMP("BPCSF",JOB,.5)=$ORDER(^XTMP("BPCSF",JOB,""),-1)+1
+5 SET ^XTMP("BPCSFRUN",JOB)="DONE"
+6 QUIT
+7 ;
TSKITKF ; Task Intake Form
+1 DO ^XBKSET
+2 SET ^XTMP("BPCIFRUN",JOB)="START"
+3 DO GUIR^XBLM("PRINT1^AMHLEI3","^XTMP(""BPCIF"",JOB)")
+4 SET ^XTMP("BPCIF",JOB,.5)=$ORDER(^XTMP("BPCIF",JOB,""),-1)+1
+5 SET ^XTMP("BPCIFRUN",JOB)="DONE"
+6 QUIT
+7 ;
KILL ;
+1 KILL BPCCTR,BPCGUI,AMHSF,DIC,JOB,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
+2 QUIT
ENCFORM(AMHARRY,AMHR,AMHEFT) ;EP called to get encounter form in array
+1 ;AMHR=ien of BH record
+2 ;array is ^TMP("AMHS",$J,"DCS")
+3 ;AMHEFT=type of form to print
+4 ; S - Suppressed
+5 ; F - Full
+6 SET AMHARRY=$NAME(@"^TMP(""AMHS"",$J,""DCS"")")
+7 KILL ^TMP("AMHS",$JOB,"DCS")
+8 IF $GET(AMHEFT)=""
SET AMHEFT="F"
+9 IF "FS"'[AMHEFT
QUIT
+10 DO EP2^AMHLEFP2(AMHR,1)
+11 NEW BPCCTR,X
SET (X,BPCCTR)=0
FOR
SET X=$ORDER(^TMP("AMHS",$JOB,"DCS",X))
IF X'=+X
QUIT
SET BPCCTR=BPCCTR+1
+12 SET ^TMP("AMHS",$JOB,"DCS",.5)=BPCCTR+1
KILL ^TMP("AMHS",$JOB,"DCS",0)
+13 QUIT
+14 ;
INTAKE(BGUARRAY,BPCIEN) ;EP called to return an INTAKE form in an array
+1 SET JOB=$JOB
SET BPCGUI=1
SET XWBWRAP=1
+2 SET ZTIO=""
SET ZTQUEUED=1
+3 SET BGUARRAY="^XTMP(""BPCIF"","_$JOB_")"
+4 KILL ^XTMP("BPCIF",JOB)
+5 SET ^XTMP("BPCIFRUN",JOB)=""
+6 DO ^XBKSET
+7 SET DFN=BPCIEN
SET AMHPG=0
+8 SET ZTRTN="TSKITKF^BPCBHDSP"
SET ZTIO=""
SET ZTDESC="BPCBH INTAKE FORM"
SET ZTSAVE("DFN")=""
SET ZTSAVE("DFN")=""
SET ZTSAVE("JOB")=""
SET ZTSAVE("AMHPG")=""
SET ZTDTH=$HOROLOG
DO ^%ZTLOAD
+9 FOR I=1:1:60
IF $GET(^XTMP("BPCIFRUN",$JOB))="DONE"
QUIT
HANG 1
+10 DO KILL
+11 QUIT
+12 ;
+13 ;
RECDISP(AMHARRY,AMHR) ;EP - called to display one BH record
+1 ;retval=array containg data, AMHR=ien of behavioral health record
+2 ;array returned is ^TMP("AMHVDSG",$J)
+3 NEW X
+4 SET AMHARRY=$NAME(@"^TMP(""AMHVDSG"",$J)")
+5 KILL ^TMP("AMHVDSG",$JOB)
+6 KILL X
DO EN^AMHVDSG1(AMHARRY,AMHR)
+7 NEW BPCCTR
SET (X,BPCCTR)=0
FOR
SET X=$ORDER(^TMP("AMHVDSG",$JOB,X))
IF X'=+X
QUIT
SET BPCCTR=BPCCTR+1
SET ^TMP("AMHVDSG",$JOB,X)=^TMP("AMHVDSG",$JOB,X,0)
KILL ^TMP("AMHVDSG",$JOB,X,0)
+8 SET ^TMP("AMHVDSG",$JOB,.5)=BPCCTR+1
+9 QUIT
+10 ;
TIUN(BGUARRAY,BPCIEN) ;EP called to return TIU notes in an array
+1 IF '$PIECE($GET(^AMHREC(BPCIEN,11)),U,8)
QUIT
+2 SET BGUARRAY="^TMP(""AMHS"","_$JOB_",""DCS"")"
+3 SET AMHR=BPCIEN
+4 KILL @BGUARRAY
SET @BGUARRAY@(0)=0
+5 SET X="TIU Note:"
DO S(X,1)
+6 KILL AMHAR,AMHERR,AMHTIU
+7 SET AMHDOC=$PIECE(^AMHREC(AMHR,11),U,8)
+8 IF '+$$CANDO^TIULP(AMHDOC,"PRINT RECORD",DUZ)
SET X=""
SET $EXTRACT(X,3)="You do not have security clearance to display the TIU NOTE."
DO S(X)
KILL AMHTIU
QUIT
+9 ; Extract specified note
+10 SET AMHGBL=$NAME(^TMP("AMHOENPS",$JOB))
SET AMHHLF=IOM\2
+11 KILL @AMHGBL
+12 DO EXTRACT^TIULQ(AMHDOC,AMHGBL,.AMHERR,".01;.02;.03;.05;.07;.08;1202;1203;1205;1208;1209;1301;1307;1402;1501:1505;1507:1513;1701","",1,"E")
+13 MERGE AMHTIU=^TMP("AMHOENPS",$JOB,AMHDOC)
+14 KILL ^TMP("AMHOENPS",$JOB)
+15 DO S(AMHTIU(.01,"E"))
+16 DO S("AUTHOR: "_AMHTIU(1202,"E"))
+17 DO S("SIGNED BY: "_AMHTIU(1502,"E")_" STATUS: "_AMHTIU(.05,"E"))
+18 DO S("LOCATION: "_AMHTIU(1205,"E"))
+19 FOR AMHX=0:0
SET AMHX=$ORDER(AMHTIU("TEXT",AMHX))
IF 'AMHX
QUIT
DO S(AMHTIU("TEXT",AMHX,0))
+20 IF $LENGTH($GET(AMHTIU(1501,"E")))
Begin DoDot:1
+21 DO S("/es/ "_$GET(AMHTIU(1503,"E")))
+22 DO S("Signed: "_$GET(AMHTIU(1501,"E")))
End DoDot:1
+23 ;
+24 KILL AMHTIU
+25 QUIT
+26 ;
S(Y,F,C,T) ;set up array
+1 NEW %
+2 IF '$GET(F)
SET F=0
+3 IF '$GET(T)
SET T=0
+4 ;blank lines
+5 FOR F=1:1:F
SET X=""
DO S1
+6 SET X=Y
+7 IF $GET(C)
SET L=$LENGTH(Y)
SET T=(80-L)/2
Begin DoDot:1
+8 FOR %=1:1:(T-1)
SET X=" "_X
End DoDot:1
DO S1
QUIT
+9 FOR %=1:1:T
SET X=" "_Y
+10 DO S1
+11 QUIT
S1 ;
+1 SET %=$PIECE(^TMP("AMHS",$JOB,"DCS",0),U)+1
SET $PIECE(^TMP("AMHS",$JOB,"DCS",0),U)=%
+2 SET ^TMP("AMHS",$JOB,"DCS",%)=X
+3 QUIT
