BPCBHDSP.m

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