GMTSP77B ; CIO/SLC - Post Install GMTS*2.7*77 ; 09/11/2007
;;2.7;Health Summary;**77**;Oct 20, 1995;Build 47
;
Q
POST ; Post-Install
D CI
Q
CI ; Component Install
N GMTSIN,GMTSLIM,GMTSINST,GMTSTL,GMTSINST,GMTSTOT,GMTSBLD,GMTSCPS,GMTSCP,GMTSCI,GMTSINX
S GMTSCPS="MHAL;MHAS"
F GMTSCI=1:1 Q:'$L($P(GMTSCPS,";",GMTSCI)) D
. S GMTSCP=$P(GMTSCPS,";",GMTSCI) K GMTSIN
. D ARRAY Q:'$D(GMTSIN)
. I $L($G(GMTSIN("TIM"))),+($G(GMTSIN(0)))>0 S GMTSLIM(+($G(GMTSIN(0))),"TIM")=$G(GMTSIN("TIM"))
. I $L($G(GMTSIN("OCC"))),+($G(GMTSIN(0)))>0 S GMTSLIM(+($G(GMTSIN(0))),"OCC")=$G(GMTSIN("OCC"))
. I GMTSIN(0)=249 M GMTSINX=GMTSIN
. S GMTSINST=$$ADD^GMTSXPD1(.GMTSIN),GMTSTOT=+($G(GMTSTOT))+($G(GMTSINST))
; Rebuild Ad Hoc Health Summary Type
D:+($G(GMTSTOT))>0 BUILD^GMTSXPD3
I $G(GMTSTOT)<1 D
.W !!," Adding missing data for previously installed components."
.D FIX
.D BUILD^GMTSXPD3
D LIM
I +$$ROK("GMTSXPS1")>0 D
. N GMTSHORT S GMTSHORT=1,GMTSINST="",GMTSBLD="GMTS*2.7*77" D SEND^GMTSXPS1
Q
ARRAY ; Build Array
K GMTSIN N GMTSI,GMTSTXT,GMTSEX,GMTSFLD,GMTSUB,GMTSVAL,GMTSPDX S GMTSPDX=1,GMTSCP=$G(GMTSCP) Q:'$L(GMTSCP)
F GMTSI=1:1 D Q:'$L(GMTSTXT)
. S GMTSTXT="",GMTSEX="S GMTSTXT=$T("_GMTSCP_"+"_GMTSI_")" X GMTSEX S:$L(GMTSTXT,";")'>3 GMTSTXT="" Q:'$L(GMTSTXT)
. S GMTSFLD=$P(GMTSTXT,";",2),GMTSUB=$P(GMTSTXT,";",3),GMTSVAL=$P(GMTSTXT,";",4)
. S:$E(GMTSFLD,1)=1&(+GMTSFLD<2) GMTSVAL=$P(GMTSTXT,";",4,5)
. S:$E(GMTSFLD,1)=" "!('$L(GMTSFLD)) GMTSTXT="" Q:GMTSTXT=""
. S:$L(GMTSFLD)&('$L(GMTSUB)) GMTSIN(GMTSFLD)=GMTSVAL Q:$L(GMTSFLD)&('$L(GMTSUB)) S:$L(GMTSFLD)&($L(GMTSUB)) GMTSIN(GMTSFLD,GMTSUB)=GMTSVAL
. S:$G(GMTSFLD)=7&(+($G(GMTSUB))>0) GMTSPDX=0
K:+($G(GMTSPDX))=0 GMTSIN("PDX")
Q
LIM ; Limits
N GMTSI,GMTST,GMTSO,GMTSA S GMTSI=0 F S GMTSI=$O(GMTSLIM(GMTSI)) Q:+GMTSI=0 D
. S GMTSA=$P($G(^GMT(142.1,+($G(GMTSI)),0)),"^",3),GMTST=$G(GMTSLIM(+GMTSI,"TIM")) S:'$L(GMTST) GMTST=$S(GMTSA="Y ":"1Y ",1:"")
. S GMTSA=$P($G(^GMT(142.1,+($G(GMTSI)),0)),"^",5),GMTSO=$G(GMTSLIM(+GMTSI,"OCC")) S:'$L(GMTSO) GMTSO=$S(GMTSA="Y ":"10 ",1:"")
. D TO^GMTSXPD3(GMTSI,GMTST,GMTSO)
Q
ROK(X) ; Routine OK
S X=$G(X) Q:'$L(X) 0 N GMTSEX,GMTSTXT S GMTSEX="S GMTSTXT=$T(+1^"_X_")" X GMTSEX
Q:'$L(GMTSTXT) 0 Q 1
;
FIX ;
;FIX OCCURANCE AND TIME LIMITS
S $P(^GMT(142.1,248,0),U,3)=1
S $P(^GMT(142.1,248,0),U,5)=1
S $P(^GMT(142.1,249,0),U,3)=1
S $P(^GMT(142.1,248,0),U,5)=1
;FIX SELECTION ITEMS
I $D(GMTSINX) D SEL^GMTSXPD1(.GMTSINX)
Q
;
MHAL ;
;0;;248
;.01;;MHA Administration List
;1;;EN;GMTSYTQL
;2;;YES
;3;;MHAL
;4;;YES
;13;;YS
;9;;MHA Admin List
;3.5;;2
;3.5;1;This component displays all administrations of intruments in
;3.5;2;the mental health package for the specified patient. All administrations from
;3.5;3;MH Administrations (file #601.84) are shown.
;3.5;4;
;3.5;5;Date ranges and maximum occurances apply.
;PDX;;1
;TIM;;1Y
;OCC;;10
;
Q
;
MHAS ;
;0;;249
;.01;;MHA Score
;1;;EN;GMTSYTQS
;2;;YES
;3;;MHAS
;4;;YES
;13;;YS
;9;;MHA Score
;7;;1
;7;1;601.71^99
;3.5;;2
;3.5;1;This component displays the administration and scoring of
;3.5;2;intruments in the mental health package. Tests, interviews and surveys from MH
;3.5;3;TESTS and SURVEYS (file # 601.71) must be selected.
;3.5;4;
;3.5;5;Date ranges and maximum occurances apply.
;PDX;;1
;TIM;;1Y
;OCC;;10
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSP77B 3444 printed Oct 16, 2024@17:59:46 Page 2
GMTSP77B ; CIO/SLC - Post Install GMTS*2.7*77 ; 09/11/2007
+1 ;;2.7;Health Summary;**77**;Oct 20, 1995;Build 47
+2 ;
+3 QUIT
POST ; Post-Install
+1 DO CI
+2 QUIT
CI ; Component Install
+1 NEW GMTSIN,GMTSLIM,GMTSINST,GMTSTL,GMTSINST,GMTSTOT,GMTSBLD,GMTSCPS,GMTSCP,GMTSCI,GMTSINX
+2 SET GMTSCPS="MHAL;MHAS"
+3 FOR GMTSCI=1:1
if '$LENGTH($PIECE(GMTSCPS,";",GMTSCI))
QUIT
Begin DoDot:1
+4 SET GMTSCP=$PIECE(GMTSCPS,";",GMTSCI)
KILL GMTSIN
+5 DO ARRAY
if '$DATA(GMTSIN)
QUIT
+6 IF $LENGTH($GET(GMTSIN("TIM")))
IF +($GET(GMTSIN(0)))>0
SET GMTSLIM(+($GET(GMTSIN(0))),"TIM")=$GET(GMTSIN("TIM"))
+7 IF $LENGTH($GET(GMTSIN("OCC")))
IF +($GET(GMTSIN(0)))>0
SET GMTSLIM(+($GET(GMTSIN(0))),"OCC")=$GET(GMTSIN("OCC"))
+8 IF GMTSIN(0)=249
MERGE GMTSINX=GMTSIN
+9 SET GMTSINST=$$ADD^GMTSXPD1(.GMTSIN)
SET GMTSTOT=+($GET(GMTSTOT))+($GET(GMTSINST))
End DoDot:1
+10 ; Rebuild Ad Hoc Health Summary Type
+11 if +($GET(GMTSTOT))>0
DO BUILD^GMTSXPD3
+12 IF $GET(GMTSTOT)<1
Begin DoDot:1
+13 WRITE !!," Adding missing data for previously installed components."
+14 DO FIX
+15 DO BUILD^GMTSXPD3
End DoDot:1
+16 DO LIM
+17 IF +$$ROK("GMTSXPS1")>0
Begin DoDot:1
+18 NEW GMTSHORT
SET GMTSHORT=1
SET GMTSINST=""
SET GMTSBLD="GMTS*2.7*77"
DO SEND^GMTSXPS1
End DoDot:1
+19 QUIT
ARRAY ; Build Array
+1 KILL GMTSIN
NEW GMTSI,GMTSTXT,GMTSEX,GMTSFLD,GMTSUB,GMTSVAL,GMTSPDX
SET GMTSPDX=1
SET GMTSCP=$GET(GMTSCP)
if '$LENGTH(GMTSCP)
QUIT
+2 FOR GMTSI=1:1
Begin DoDot:1
+3 SET GMTSTXT=""
SET GMTSEX="S GMTSTXT=$T("_GMTSCP_"+"_GMTSI_")"
XECUTE GMTSEX
if $LENGTH(GMTSTXT,";")'>3
SET GMTSTXT=""
if '$LENGTH(GMTSTXT)
QUIT
+4 SET GMTSFLD=$PIECE(GMTSTXT,";",2)
SET GMTSUB=$PIECE(GMTSTXT,";",3)
SET GMTSVAL=$PIECE(GMTSTXT,";",4)
+5 if $EXTRACT(GMTSFLD,1)=1&(+GMTSFLD<2)
SET GMTSVAL=$PIECE(GMTSTXT,";",4,5)
+6 if $EXTRACT(GMTSFLD,1)=" "!('$LENGTH(GMTSFLD))
SET GMTSTXT=""
if GMTSTXT=""
QUIT
+7 if $LENGTH(GMTSFLD)&('$LENGTH(GMTSUB))
SET GMTSIN(GMTSFLD)=GMTSVAL
if $LENGTH(GMTSFLD)&('$LENGTH(GMTSUB))
QUIT
if $LENGTH(GMTSFLD)&($LENGTH(GMTSUB))
SET GMTSIN(GMTSFLD,GMTSUB)=GMTSVAL
+8 if $GET(GMTSFLD)=7&(+($GET(GMTSUB))>0)
SET GMTSPDX=0
End DoDot:1
if '$LENGTH(GMTSTXT)
QUIT
+9 if +($GET(GMTSPDX))=0
KILL GMTSIN("PDX")
+10 QUIT
LIM ; Limits
+1 NEW GMTSI,GMTST,GMTSO,GMTSA
SET GMTSI=0
FOR
SET GMTSI=$ORDER(GMTSLIM(GMTSI))
if +GMTSI=0
QUIT
Begin DoDot:1
+2 SET GMTSA=$PIECE($GET(^GMT(142.1,+($GET(GMTSI)),0)),"^",3)
SET GMTST=$GET(GMTSLIM(+GMTSI,"TIM"))
if '$LENGTH(GMTST)
SET GMTST=$SELECT(GMTSA="Y ":"1Y ",1:"")
+3 SET GMTSA=$PIECE($GET(^GMT(142.1,+($GET(GMTSI)),0)),"^",5)
SET GMTSO=$GET(GMTSLIM(+GMTSI,"OCC"))
if '$LENGTH(GMTSO)
SET GMTSO=$SELECT(GMTSA="Y ":"10 ",1:"")
+4 DO TO^GMTSXPD3(GMTSI,GMTST,GMTSO)
End DoDot:1
+5 QUIT
ROK(X) ; Routine OK
+1 SET X=$GET(X)
if '$LENGTH(X)
QUIT 0
NEW GMTSEX,GMTSTXT
SET GMTSEX="S GMTSTXT=$T(+1^"_X_")"
XECUTE GMTSEX
+2 if '$LENGTH(GMTSTXT)
QUIT 0
QUIT 1
+3 ;
FIX ;
+1 ;FIX OCCURANCE AND TIME LIMITS
+2 SET $PIECE(^GMT(142.1,248,0),U,3)=1
+3 SET $PIECE(^GMT(142.1,248,0),U,5)=1
+4 SET $PIECE(^GMT(142.1,249,0),U,3)=1
+5 SET $PIECE(^GMT(142.1,248,0),U,5)=1
+6 ;FIX SELECTION ITEMS
+7 IF $DATA(GMTSINX)
DO SEL^GMTSXPD1(.GMTSINX)
+8 QUIT
+9 ;
MHAL ;
+1 ;0;;248
+2 ;.01;;MHA Administration List
+3 ;1;;EN;GMTSYTQL
+4 ;2;;YES
+5 ;3;;MHAL
+6 ;4;;YES
+7 ;13;;YS
+8 ;9;;MHA Admin List
+9 ;3.5;;2
+10 ;3.5;1;This component displays all administrations of intruments in
+11 ;3.5;2;the mental health package for the specified patient. All administrations from
+12 ;3.5;3;MH Administrations (file #601.84) are shown.
+13 ;3.5;4;
+14 ;3.5;5;Date ranges and maximum occurances apply.
+15 ;PDX;;1
+16 ;TIM;;1Y
+17 ;OCC;;10
+18 ;
+19 QUIT
+20 ;
MHAS ;
+1 ;0;;249
+2 ;.01;;MHA Score
+3 ;1;;EN;GMTSYTQS
+4 ;2;;YES
+5 ;3;;MHAS
+6 ;4;;YES
+7 ;13;;YS
+8 ;9;;MHA Score
+9 ;7;;1
+10 ;7;1;601.71^99
+11 ;3.5;;2
+12 ;3.5;1;This component displays the administration and scoring of
+13 ;3.5;2;intruments in the mental health package. Tests, interviews and surveys from MH
+14 ;3.5;3;TESTS and SURVEYS (file # 601.71) must be selected.
+15 ;3.5;4;
+16 ;3.5;5;Date ranges and maximum occurances apply.
+17 ;PDX;;1
+18 ;TIM;;1Y
+19 ;OCC;;10
+20 ;
+21 QUIT
