GMTSXAL ; SLC/KER - List Parameters/Get List ; 02/27/2002
;;2.7;Health Summary;**47,49,66**;Oct 20, 1995
Q
;
; External References in GMTSXAL
; DBIA 2992 ^XTV(8989.5,
; DBIA 2056 $$GET1^DIQ
; DBIA 2263 GETLST^XPAR
;
GETLIST(GMTSL,GMTSUSR,GBL,ERR) ; Get Health Summary Type Parameter List
N GMTSCP,GMTSCPL,GMTSPRE,GMTSDEF,ROOT
I '$G(GBL) K GMTSL S ROOT=$NA(GMTSL)
I $G(GBL) D Q:$G(ERR)
. I $E($G(GMTSL),1)'="^" S ERR="19^"_$$EZBLD^DIALOG(19) Q
. S ROOT=GMTSL
S @ROOT=0
S GMTSUSR=+($G(GMTSUSR)) Q:+GMTSUSR'>0 Q:'$L($$UNM^GMTSXAW3(GMTSUSR))
S GMTSCPL=$$CPL(GMTSUSR),GMTSPRE=$$PRE(GMTSUSR)
D GETLST(.ROOT,GMTSUSR,GMTSCPL,GMTSPRE)
I $D(GMTSIDX) D
. S @ROOT@("AC","PRE")=GMTSPRE,@ROOT@("AC","CPL")=GMTSCPL_"^"_$S(+($G(GMTSCPL))'>0:"Overwrite",1:"Append")
. N GMTSI,GMTST,GMTSTO,GMTSTC,GMTSTCT,GMTSV,GMTSC
. S GMTSTO="",(GMTSC,GMTSTC,GMTSTCT,GMTSI)=0
. F S GMTSI=$O(@ROOT@(GMTSI)) Q:+GMTSI=0 D
. . S GMTSV=$G(@ROOT@(GMTSI)),GMTST=$G(@ROOT@("C",GMTSI)) Q:'$L(GMTST)
. . S GMTSC=GMTSC+1,@ROOT@("A",GMTST,0)=GMTSC,@ROOT@("A",GMTST,GMTSC)=GMTSV
. . S:GMTST'=GMTSTO GMTSTC=GMTSTC+1,GMTSTCT=0
. . S GMTSTCT=GMTSTCT+1
. . S @ROOT@("AB",0)=GMTSTC,@ROOT@("AB",+GMTSTC,0)=GMTSTCT,@ROOT@("AB",+GMTSTC,GMTSTCT)=GMTST_"^"_GMTSV,GMTSTO=GMTST
. K @ROOT@("B"),@ROOT@("C") S GMTST="" F S GMTST=$O(@ROOT@("A",GMTST)) Q:GMTST="" D
. . S GMTSI=0 F S GMTSI=$O(@ROOT@("A",GMTST,GMTSI)) Q:+GMTSI=0 D
. . . S GMTSC=+($G(@ROOT@("A",GMTST,GMTSI)))
. . . S GMTSV=$P($G(@ROOT@("A",GMTST,GMTSI)),"^",2)
. . . S:+GMTSC>0 @ROOT@("B",+GMTSC,GMTSI)=""
. . . S:$L(GMTSV)>0 @ROOT@("BA",GMTSV,GMTSI)=""
Q
;
GETILIST(GMTSL,GMTSUSR) ; Get Indexed Health Summary Types Parameter List
S GMTSUSR=+($G(GMTSUSR)) Q:GMTSUSR=0 Q:'$L($$UNM^GMTSXAW3(GMTSUSR))
N GMTSIDX S GMTSIDX=1 D GETLIST(.GMTSL,GMTSUSR)
Q
;
GETLST(ROOT,GMTSUSR,GMTSCPL,GMTSPRE) ; Get List
;
; Health Summary Version of call in GETHS^ORWRP:
;
; D GETLST^XPAR(.ORHSPARM,"ALL",
; "ORWRP HEALTH SUMMARY TYPE LIST","N")
;
; Merges Health Summary Parameters for display in the
; Health Summary Types on the Reports Tab. National
; Health Summary Types (remote data views) are grouped
; together and added to the list separately. For a
; National Health Summary Type to be included on the list,
; it must first be defined in the parameters file.
; The merge of parameters is accomplished by either
; appending or over-writing the parameters to the list.
;
; Input Variables
;
; GMTSL Local Array of Health Summary Parameters
;
; GMTSCPL Compile Method
;
; GMTSCPL=1 <DEFAULT> Append Parameters to List
; GMTSCPL=0 Overwrite Parameters (by entity)
;
; GMTSPRE Precedence of Entities
;
; Having defined how the list is to be created using
; GMTSCPL (Append or Overwrite), this variable
; defines the order that each entity will be
; referenced (first, second, etc.)
;
; FORMAT Series of 3 Characters, Uppercase taken
; from the PARAMETER ENTITY file delimited
; by semi-colons
;
; Default value: $$DEF^GMTSXAW
;
LST ; Create List
;
N DIC,DTOUT,DUOUT,GMTSE,GMTSENT,GMTSER,GMTSI,GMTSLI,GMTSLL,GMTSLN
N GMTSPAR,GMTSYS,GMTSAD,GMTSAR,GMTST,GMTSV,GMTSVAL,GMTSII
N GMTSUP,GMTSEI,GMTSIV,GMTSEV,GMTSN,GMTSCHK,X,Y
K ^TMP($J,"GMTSLL"),^TMP($J,"GMTSLN"),^TMP($J,"GMTSTYP")
S GMTSUSR=+($G(GMTSUSR)) Q:GMTSUSR=0 Q:'$L($$UNM^GMTSXAW3(GMTSUSR))
S GMTSCPL=$G(GMTSCPL),GMTSPRE=$G(GMTSPRE)
S:'$L(GMTSCPL) GMTSCPL=0 S:'$L(GMTSPRE) GMTSPRE=$$DEF^GMTSXAW
S (GMTSPAR,X)="ORWRP HEALTH SUMMARY TYPE LIST"
S GMTSAD="GMTS HS ADHOC OPTION",GMTSAR="GMTS HS REMOTE ADHOC OPTION"
S GMTSYS=$$SYSV^GMTSXAW3,GMTSUP=$$UVP^GMTSXAW3(+GMTSUSR),GMTSPAR=+($$PDI^GMTSXAW3(GMTSPAR)) Q:GMTSPAR'>0 S GMTSENT="",U="^"
D CHK^GMTSXAW(.GMTSCHK,GMTSUSR,"GMTS")
F S GMTSENT=$O(^XTV(8989.5,"AC",GMTSPAR,GMTSENT)) Q:GMTSENT="" D BYE
K @ROOT D BUILD^GMTSXAB
K:'$D(GMTSIDX) @ROOT@("B"),@ROOT@("C") S (GMTSI,GMTSN)=0
F S GMTSI=$O(@ROOT@(GMTSI)) Q:+GMTSI=0 S GMTSN=GMTSN+1
S:+GMTSN>0 GMTSL=GMTSN
K ^TMP($J,"GMTSLL"),^TMP($J,"GMTSLN"),^TMP($J,"GMTSTYP")
Q
BYE ; By Entity
Q:'$L(GMTSENT) Q:GMTSENT'[";" Q:+GMTSENT=0 Q:'$L($P(GMTSENT,";",2)) Q:'$D(GMTSCHK("CHK",GMTSENT))
S GMTSVAL=$P($G(@(U_$P(GMTSENT,";",2)_+($P(GMTSENT,";",1))_",0)")),U,1)
Q:'$L(GMTSVAL) K GMTSL,GMTSER Q:'$L($G(GMTSPAR)) Q:'$L($G(GMTSENT))
D GETLST^XPAR(.GMTSL,GMTSENT,GMTSPAR,"B",.GMTSER) Q:+($G(GMTSER))>0
S GMTSLI=0 F S GMTSLI=$O(GMTSL(GMTSLI)) Q:+GMTSLI=0 D BYP
Q
BYP ; By Parameter
S GMTST=$$ABR^GMTSXAW3(GMTSENT) N GMTSII,GMTSEI,GMTSIV,GMTSEV,GMTSIEN,GMTSVAL,GMTSND,GMTSNM,GMTSHT
S GMTSII=$P($G(GMTSL(GMTSLI,"N")),"^",1) Q:'$L(GMTSII)
S GMTSEI=$P($G(GMTSL(GMTSLI,"N")),"^",2) Q:'$L(GMTSEI)
S GMTSIV=$P($G(GMTSL(GMTSLI,"V")),"^",1) Q:'$L(GMTSIV)
S GMTSEV=$P($G(GMTSL(GMTSLI,"V")),"^",2) Q:'$L(GMTSEV)
S GMTST=$S(GMTSPRE["NAT"&(+($G(^GMT(142,+GMTSIV,"VA")))>0):"NAT",1:$G(GMTST))
S GMTSND=$S(GMTSPRE["NAT"&(+($G(^GMT(142,+GMTSIV,"VA")))>0):"^TMP($J,""GMTSLN"")",1:"^TMP($J,""GMTSLL"")")
D SAV
Q
SAV ; Save Parameters
N GMTSI Q:'$L($G(GMTSL(GMTSLI,"V"))) S GMTSVAL=GMTSL(GMTSLI,"V"),GMTSHT=+GMTSVAL,GMTSNM=$P(GMTSVAL,"^",2)
S GMTSI=(+($O(@GMTSND@(" "),-1)+1))
I GMTSNM=GMTSAD!(GMTSNM=GMTSAR) D SAVD Q
S @GMTSND@(GMTSI,"N")=$G(GMTSL(GMTSLI,"N"))
S @GMTSND@(GMTSI,"V")=$G(GMTSVAL)
S @GMTSND@(GMTSI,"E")=$G(GMTSENT)
S ^TMP($J,"GMTSTYP",GMTST,GMTSI)=$G(GMTSVAL)
S:$L(GMTSNM) ^TMP($J,"GMTSTYP",GMTST,"B",GMTSNM,GMTSI)=""
S:GMTSHT>0 ^TMP($J,"GMTSTYP",GMTST,"C",GMTSHT,GMTSI)=""
Q
SAVD ; Save Adhoc and Remote Adhoc Parameters
N GMTSAT,GMTSC,GMTSI S GMTSND=$G(GMTSND) Q:'$L(GMTSND) Q:GMTSND="^TMP($J,""GMTSLN"")"
I GMTSNM=GMTSAD S GMTSI=(+($O(@GMTSND@("ADH"," "),-1)+1)),GMTSAT="ADH"
I GMTSNM=GMTSAR S GMTSI=(+($O(@GMTSND@("RAD"," "),-1)+1)),GMTSAT="RAD"
Q:'$L($G(GMTST)) Q:'$L($G(GMTSAT)) Q:'$L($G(GMTSNM)) Q:'$L($G(GMTSVAL)) Q:'$L($G(GMTSHT)) Q:$D(^TMP($J,"GMTSTYP",GMTST,GMTSAT,"B",GMTSNM))
S @GMTSND@("GMTSAT",GMTSI,"N")=$G(GMTSL(GMTSLI,"N"))
S @GMTSND@("GMTSAT",GMTSI,"V")=$G(GMTSL(GMTSLI,"V"))
S @GMTSND@("GMTSAT",GMTSI,"E")=$G(GMTSENT)
S @GMTSND@("GMTSAT","B",GMTSVAL,GMTSI)=""
S @GMTSND@("GMTSAT","C",GMTSEI_"^"_GMTSVAL,GMTSI)=""
S GMTSC=+($O(@GMTSND@("GMTST",GMTSAT," "),-1))+1
S ^TMP($J,"GMTSTYP",GMTST,GMTSAT,GMTSC)=$G(GMTSVAL)
S:$L(GMTSNM) ^TMP($J,"GMTSTYP",GMTST,GMTSAT,"B",GMTSNM,GMTSC)=""
S:GMTSHT>0 ^TMP($J,"GMTSTYP",GMTST,GMTSAT,"C",GMTSHT,GMTSC)=""
Q
;
; Miscellaneous
NUM(X) ; Number of Types for User X
N GMTSUSR,GMTSL,GMTSI,GMTSN S GMTSUSR=+($G(X)),(GMTSI,GMTSN)=0 Q:GMTSUSR=0 0 Q:'$L($$UNM^GMTSXAW3(GMTSUSR)) 0
D GETLIST(.GMTSL,GMTSUSR) Q:+($G(GMTSL))>0 +($G(GMTSL))
F S GMTSI=$O(GMTSL(GMTSI)) Q:+GMTSI=0 S GMTSN=GMTSN+1
S X=GMTSN Q X
DEF(X) ; Defaults <compile> ^ <precedence>
N DIERR,GMTSUSR,GMTSSIC,GMTSSIP,GMTSSCPL,GMTSPRE
S GMTSSIC=1,GMTSSIP=$$DEF^GMTSXAW
S GMTSUSR=+($G(X)),X=""
Q:+GMTSUSR=0 (GMTSSIC_"^"_GMTSSIP)
Q:'$L($$UNM^GMTSXAW3(+GMTSUSR)) (GMTSSIC_"^"_GMTSSIP)
S GMTSCPL=$$GET1^DIQ(142.98,(GMTSUSR_","),10,"I")
S:GMTSCPL="" GMTSCPL=GMTSSIC
S GMTSPRE=$$GET1^DIQ(142.98,(GMTSUSR_","),11)
S:GMTSPRE="" GMTSPRE=GMTSSIP
S X=GMTSCPL_"^"_GMTSPRE
Q X
CPL(X) ; Compile Method
N DIERR,GMTSITE,GMTSUSR,GMTSCPL S GMTSUSR=+($G(X))
S GMTSITE=$P($G(^GMT(142.98,"ASITE")),"^",1)
S GMTSITE=$S($L(GMTSITE):+GMTSITE,1:1) I GMTSUSR=.5 S X=GMTSITE Q X
S GMTSCPL=$$GET1^DIQ(142.98,(GMTSUSR_","),10,"I")
S:'$L(GMTSCPL) GMTSCPL=GMTSITE
S X=GMTSCPL
Q X
PRE(X) ; Precedence
N GMTSUSR,GMTSPRE,GMTSDEF,GMTSC,GMTSI,GMTSA,GMTS S GMTSUSR=+($G(X))
S (GMTSDEF,X)=$$DEF^GMTSXAW Q:+GMTSUSR=0 X S GMTSPRE=$$GET1^DIQ(142.98,(GMTSUSR_","),11),GMTSC="^"_$TR($$DEF^GMTSXAW,";","^")_"^"
S GMTS="" F GMTSI=1:1 Q:GMTSI>$L(GMTSPRE,";") D
. S GMTSA=$P($G(GMTSPRE),";",GMTSI) Q:$L(GMTSA)'=3 Q:GMTSA'="NAT"&(GMTSC'[("^"_GMTSA_"^")) Q:GMTS[(";"_GMTSA) S GMTS=GMTS_";"_GMTSA
S GMTSPRE=$$TRIM^GMTSXA(GMTS,";") S:'$L(GMTSPRE) GMTSPRE=GMTSDEF
S X=GMTSPRE
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSXAL 8650 printed Dec 13, 2024@02:00:47 Page 2
GMTSXAL ; SLC/KER - List Parameters/Get List ; 02/27/2002
+1 ;;2.7;Health Summary;**47,49,66**;Oct 20, 1995
+2 QUIT
+3 ;
+4 ; External References in GMTSXAL
+5 ; DBIA 2992 ^XTV(8989.5,
+6 ; DBIA 2056 $$GET1^DIQ
+7 ; DBIA 2263 GETLST^XPAR
+8 ;
GETLIST(GMTSL,GMTSUSR,GBL,ERR) ; Get Health Summary Type Parameter List
+1 NEW GMTSCP,GMTSCPL,GMTSPRE,GMTSDEF,ROOT
+2 IF '$GET(GBL)
KILL GMTSL
SET ROOT=$NAME(GMTSL)
+3 IF $GET(GBL)
Begin DoDot:1
+4 IF $EXTRACT($GET(GMTSL),1)'="^"
SET ERR="19^"_$$EZBLD^DIALOG(19)
QUIT
+5 SET ROOT=GMTSL
End DoDot:1
if $GET(ERR)
QUIT
+6 SET @ROOT=0
+7 SET GMTSUSR=+($GET(GMTSUSR))
if +GMTSUSR'>0
QUIT
if '$LENGTH($$UNM^GMTSXAW3(GMTSUSR))
QUIT
+8 SET GMTSCPL=$$CPL(GMTSUSR)
SET GMTSPRE=$$PRE(GMTSUSR)
+9 DO GETLST(.ROOT,GMTSUSR,GMTSCPL,GMTSPRE)
+10 IF $DATA(GMTSIDX)
Begin DoDot:1
+11 SET @ROOT@("AC","PRE")=GMTSPRE
SET @ROOT@("AC","CPL")=GMTSCPL_"^"_$SELECT(+($GET(GMTSCPL))'>0:"Overwrite",1:"Append")
+12 NEW GMTSI,GMTST,GMTSTO,GMTSTC,GMTSTCT,GMTSV,GMTSC
+13 SET GMTSTO=""
SET (GMTSC,GMTSTC,GMTSTCT,GMTSI)=0
+14 FOR
SET GMTSI=$ORDER(@ROOT@(GMTSI))
if +GMTSI=0
QUIT
Begin DoDot:2
+15 SET GMTSV=$GET(@ROOT@(GMTSI))
SET GMTST=$GET(@ROOT@("C",GMTSI))
if '$LENGTH(GMTST)
QUIT
+16 SET GMTSC=GMTSC+1
SET @ROOT@("A",GMTST,0)=GMTSC
SET @ROOT@("A",GMTST,GMTSC)=GMTSV
+17 if GMTST'=GMTSTO
SET GMTSTC=GMTSTC+1
SET GMTSTCT=0
+18 SET GMTSTCT=GMTSTCT+1
+19 SET @ROOT@("AB",0)=GMTSTC
SET @ROOT@("AB",+GMTSTC,0)=GMTSTCT
SET @ROOT@("AB",+GMTSTC,GMTSTCT)=GMTST_"^"_GMTSV
SET GMTSTO=GMTST
End DoDot:2
+20 KILL @ROOT@("B"),@ROOT@("C")
SET GMTST=""
FOR
SET GMTST=$ORDER(@ROOT@("A",GMTST))
if GMTST=""
QUIT
Begin DoDot:2
+21 SET GMTSI=0
FOR
SET GMTSI=$ORDER(@ROOT@("A",GMTST,GMTSI))
if +GMTSI=0
QUIT
Begin DoDot:3
+22 SET GMTSC=+($GET(@ROOT@("A",GMTST,GMTSI)))
+23 SET GMTSV=$PIECE($GET(@ROOT@("A",GMTST,GMTSI)),"^",2)
+24 if +GMTSC>0
SET @ROOT@("B",+GMTSC,GMTSI)=""
+25 if $LENGTH(GMTSV)>0
SET @ROOT@("BA",GMTSV,GMTSI)=""
End DoDot:3
End DoDot:2
End DoDot:1
+26 QUIT
+27 ;
GETILIST(GMTSL,GMTSUSR) ; Get Indexed Health Summary Types Parameter List
+1 SET GMTSUSR=+($GET(GMTSUSR))
if GMTSUSR=0
QUIT
if '$LENGTH($$UNM^GMTSXAW3(GMTSUSR))
QUIT
+2 NEW GMTSIDX
SET GMTSIDX=1
DO GETLIST(.GMTSL,GMTSUSR)
+3 QUIT
+4 ;
GETLST(ROOT,GMTSUSR,GMTSCPL,GMTSPRE) ; Get List
+1 ;
+2 ; Health Summary Version of call in GETHS^ORWRP:
+3 ;
+4 ; D GETLST^XPAR(.ORHSPARM,"ALL",
+5 ; "ORWRP HEALTH SUMMARY TYPE LIST","N")
+6 ;
+7 ; Merges Health Summary Parameters for display in the
+8 ; Health Summary Types on the Reports Tab. National
+9 ; Health Summary Types (remote data views) are grouped
+10 ; together and added to the list separately. For a
+11 ; National Health Summary Type to be included on the list,
+12 ; it must first be defined in the parameters file.
+13 ; The merge of parameters is accomplished by either
+14 ; appending or over-writing the parameters to the list.
+15 ;
+16 ; Input Variables
+17 ;
+18 ; GMTSL Local Array of Health Summary Parameters
+19 ;
+20 ; GMTSCPL Compile Method
+21 ;
+22 ; GMTSCPL=1 <DEFAULT> Append Parameters to List
+23 ; GMTSCPL=0 Overwrite Parameters (by entity)
+24 ;
+25 ; GMTSPRE Precedence of Entities
+26 ;
+27 ; Having defined how the list is to be created using
+28 ; GMTSCPL (Append or Overwrite), this variable
+29 ; defines the order that each entity will be
+30 ; referenced (first, second, etc.)
+31 ;
+32 ; FORMAT Series of 3 Characters, Uppercase taken
+33 ; from the PARAMETER ENTITY file delimited
+34 ; by semi-colons
+35 ;
+36 ; Default value: $$DEF^GMTSXAW
+37 ;
LST ; Create List
+1 ;
+2 NEW DIC,DTOUT,DUOUT,GMTSE,GMTSENT,GMTSER,GMTSI,GMTSLI,GMTSLL,GMTSLN
+3 NEW GMTSPAR,GMTSYS,GMTSAD,GMTSAR,GMTST,GMTSV,GMTSVAL,GMTSII
+4 NEW GMTSUP,GMTSEI,GMTSIV,GMTSEV,GMTSN,GMTSCHK,X,Y
+5 KILL ^TMP($JOB,"GMTSLL"),^TMP($JOB,"GMTSLN"),^TMP($JOB,"GMTSTYP")
+6 SET GMTSUSR=+($GET(GMTSUSR))
if GMTSUSR=0
QUIT
if '$LENGTH($$UNM^GMTSXAW3(GMTSUSR))
QUIT
+7 SET GMTSCPL=$GET(GMTSCPL)
SET GMTSPRE=$GET(GMTSPRE)
+8 if '$LENGTH(GMTSCPL)
SET GMTSCPL=0
if '$LENGTH(GMTSPRE)
SET GMTSPRE=$$DEF^GMTSXAW
+9 SET (GMTSPAR,X)="ORWRP HEALTH SUMMARY TYPE LIST"
+10 SET GMTSAD="GMTS HS ADHOC OPTION"
SET GMTSAR="GMTS HS REMOTE ADHOC OPTION"
+11 SET GMTSYS=$$SYSV^GMTSXAW3
SET GMTSUP=$$UVP^GMTSXAW3(+GMTSUSR)
SET GMTSPAR=+($$PDI^GMTSXAW3(GMTSPAR))
if GMTSPAR'>0
QUIT
SET GMTSENT=""
SET U="^"
+12 DO CHK^GMTSXAW(.GMTSCHK,GMTSUSR,"GMTS")
+13 FOR
SET GMTSENT=$ORDER(^XTV(8989.5,"AC",GMTSPAR,GMTSENT))
if GMTSENT=""
QUIT
DO BYE
+14 KILL @ROOT
DO BUILD^GMTSXAB
+15 if '$DATA(GMTSIDX)
KILL @ROOT@("B"),@ROOT@("C")
SET (GMTSI,GMTSN)=0
+16 FOR
SET GMTSI=$ORDER(@ROOT@(GMTSI))
if +GMTSI=0
QUIT
SET GMTSN=GMTSN+1
+17 if +GMTSN>0
SET GMTSL=GMTSN
+18 KILL ^TMP($JOB,"GMTSLL"),^TMP($JOB,"GMTSLN"),^TMP($JOB,"GMTSTYP")
+19 QUIT
BYE ; By Entity
+1 if '$LENGTH(GMTSENT)
QUIT
if GMTSENT'[";"
QUIT
if +GMTSENT=0
QUIT
if '$LENGTH($PIECE(GMTSENT,";",2))
QUIT
if '$DATA(GMTSCHK("CHK",GMTSENT))
QUIT
+2 SET GMTSVAL=$PIECE($GET(@(U_$PIECE(GMTSENT,";",2)_+($PIECE(GMTSENT,";",1))_",0)")),U,1)
+3 if '$LENGTH(GMTSVAL)
QUIT
KILL GMTSL,GMTSER
if '$LENGTH($GET(GMTSPAR))
QUIT
if '$LENGTH($GET(GMTSENT))
QUIT
+4 DO GETLST^XPAR(.GMTSL,GMTSENT,GMTSPAR,"B",.GMTSER)
if +($GET(GMTSER))>0
QUIT
+5 SET GMTSLI=0
FOR
SET GMTSLI=$ORDER(GMTSL(GMTSLI))
if +GMTSLI=0
QUIT
DO BYP
+6 QUIT
BYP ; By Parameter
+1 SET GMTST=$$ABR^GMTSXAW3(GMTSENT)
NEW GMTSII,GMTSEI,GMTSIV,GMTSEV,GMTSIEN,GMTSVAL,GMTSND,GMTSNM,GMTSHT
+2 SET GMTSII=$PIECE($GET(GMTSL(GMTSLI,"N")),"^",1)
if '$LENGTH(GMTSII)
QUIT
+3 SET GMTSEI=$PIECE($GET(GMTSL(GMTSLI,"N")),"^",2)
if '$LENGTH(GMTSEI)
QUIT
+4 SET GMTSIV=$PIECE($GET(GMTSL(GMTSLI,"V")),"^",1)
if '$LENGTH(GMTSIV)
QUIT
+5 SET GMTSEV=$PIECE($GET(GMTSL(GMTSLI,"V")),"^",2)
if '$LENGTH(GMTSEV)
QUIT
+6 SET GMTST=$SELECT(GMTSPRE["NAT"&(+($GET(^GMT(142,+GMTSIV,"VA")))>0):"NAT",1:$GET(GMTST))
+7 SET GMTSND=$SELECT(GMTSPRE["NAT"&(+($GET(^GMT(142,+GMTSIV,"VA")))>0):"^TMP($J,""GMTSLN"")",1:"^TMP($J,""GMTSLL"")")
+8 DO SAV
+9 QUIT
SAV ; Save Parameters
+1 NEW GMTSI
if '$LENGTH($GET(GMTSL(GMTSLI,"V")))
QUIT
SET GMTSVAL=GMTSL(GMTSLI,"V")
SET GMTSHT=+GMTSVAL
SET GMTSNM=$PIECE(GMTSVAL,"^",2)
+2 SET GMTSI=(+($ORDER(@GMTSND@(" "),-1)+1))
+3 IF GMTSNM=GMTSAD!(GMTSNM=GMTSAR)
DO SAVD
QUIT
+4 SET @GMTSND@(GMTSI,"N")=$GET(GMTSL(GMTSLI,"N"))
+5 SET @GMTSND@(GMTSI,"V")=$GET(GMTSVAL)
+6 SET @GMTSND@(GMTSI,"E")=$GET(GMTSENT)
+7 SET ^TMP($JOB,"GMTSTYP",GMTST,GMTSI)=$GET(GMTSVAL)
+8 if $LENGTH(GMTSNM)
SET ^TMP($JOB,"GMTSTYP",GMTST,"B",GMTSNM,GMTSI)=""
+9 if GMTSHT>0
SET ^TMP($JOB,"GMTSTYP",GMTST,"C",GMTSHT,GMTSI)=""
+10 QUIT
SAVD ; Save Adhoc and Remote Adhoc Parameters
+1 NEW GMTSAT,GMTSC,GMTSI
SET GMTSND=$GET(GMTSND)
if '$LENGTH(GMTSND)
QUIT
if GMTSND="^TMP($J,""GMTSLN"")"
QUIT
+2 IF GMTSNM=GMTSAD
SET GMTSI=(+($ORDER(@GMTSND@("ADH"," "),-1)+1))
SET GMTSAT="ADH"
+3 IF GMTSNM=GMTSAR
SET GMTSI=(+($ORDER(@GMTSND@("RAD"," "),-1)+1))
SET GMTSAT="RAD"
+4 if '$LENGTH($GET(GMTST))
QUIT
if '$LENGTH($GET(GMTSAT))
QUIT
if '$LENGTH($GET(GMTSNM))
QUIT
if '$LENGTH($GET(GMTSVAL))
QUIT
if '$LENGTH($GET(GMTSHT))
QUIT
if $DATA(^TMP($JOB,"GMTSTYP",GMTST,GMTSAT,"B",GMTSNM))
QUIT
+5 SET @GMTSND@("GMTSAT",GMTSI,"N")=$GET(GMTSL(GMTSLI,"N"))
+6 SET @GMTSND@("GMTSAT",GMTSI,"V")=$GET(GMTSL(GMTSLI,"V"))
+7 SET @GMTSND@("GMTSAT",GMTSI,"E")=$GET(GMTSENT)
+8 SET @GMTSND@("GMTSAT","B",GMTSVAL,GMTSI)=""
+9 SET @GMTSND@("GMTSAT","C",GMTSEI_"^"_GMTSVAL,GMTSI)=""
+10 SET GMTSC=+($ORDER(@GMTSND@("GMTST",GMTSAT," "),-1))+1
+11 SET ^TMP($JOB,"GMTSTYP",GMTST,GMTSAT,GMTSC)=$GET(GMTSVAL)
+12 if $LENGTH(GMTSNM)
SET ^TMP($JOB,"GMTSTYP",GMTST,GMTSAT,"B",GMTSNM,GMTSC)=""
+13 if GMTSHT>0
SET ^TMP($JOB,"GMTSTYP",GMTST,GMTSAT,"C",GMTSHT,GMTSC)=""
+14 QUIT
+15 ;
+16 ; Miscellaneous
NUM(X) ; Number of Types for User X
+1 NEW GMTSUSR,GMTSL,GMTSI,GMTSN
SET GMTSUSR=+($GET(X))
SET (GMTSI,GMTSN)=0
if GMTSUSR=0
QUIT 0
if '$LENGTH($$UNM^GMTSXAW3(GMTSUSR))
QUIT 0
+2 DO GETLIST(.GMTSL,GMTSUSR)
if +($GET(GMTSL))>0
QUIT +($GET(GMTSL))
+3 FOR
SET GMTSI=$ORDER(GMTSL(GMTSI))
if +GMTSI=0
QUIT
SET GMTSN=GMTSN+1
+4 SET X=GMTSN
QUIT X
DEF(X) ; Defaults <compile> ^ <precedence>
+1 NEW DIERR,GMTSUSR,GMTSSIC,GMTSSIP,GMTSSCPL,GMTSPRE
+2 SET GMTSSIC=1
SET GMTSSIP=$$DEF^GMTSXAW
+3 SET GMTSUSR=+($GET(X))
SET X=""
+4 if +GMTSUSR=0
QUIT (GMTSSIC_"^"_GMTSSIP)
+5 if '$LENGTH($$UNM^GMTSXAW3(+GMTSUSR))
QUIT (GMTSSIC_"^"_GMTSSIP)
+6 SET GMTSCPL=$$GET1^DIQ(142.98,(GMTSUSR_","),10,"I")
+7 if GMTSCPL=""
SET GMTSCPL=GMTSSIC
+8 SET GMTSPRE=$$GET1^DIQ(142.98,(GMTSUSR_","),11)
+9 if GMTSPRE=""
SET GMTSPRE=GMTSSIP
+10 SET X=GMTSCPL_"^"_GMTSPRE
+11 QUIT X
CPL(X) ; Compile Method
+1 NEW DIERR,GMTSITE,GMTSUSR,GMTSCPL
SET GMTSUSR=+($GET(X))
+2 SET GMTSITE=$PIECE($GET(^GMT(142.98,"ASITE")),"^",1)
+3 SET GMTSITE=$SELECT($LENGTH(GMTSITE):+GMTSITE,1:1)
IF GMTSUSR=.5
SET X=GMTSITE
QUIT X
+4 SET GMTSCPL=$$GET1^DIQ(142.98,(GMTSUSR_","),10,"I")
+5 if '$LENGTH(GMTSCPL)
SET GMTSCPL=GMTSITE
+6 SET X=GMTSCPL
+7 QUIT X
PRE(X) ; Precedence
+1 NEW GMTSUSR,GMTSPRE,GMTSDEF,GMTSC,GMTSI,GMTSA,GMTS
SET GMTSUSR=+($GET(X))
+2 SET (GMTSDEF,X)=$$DEF^GMTSXAW
if +GMTSUSR=0
QUIT X
SET GMTSPRE=$$GET1^DIQ(142.98,(GMTSUSR_","),11)
SET GMTSC="^"_$TRANSLATE($$DEF^GMTSXAW,";","^")_"^"
+3 SET GMTS=""
FOR GMTSI=1:1
if GMTSI>$LENGTH(GMTSPRE,";")
QUIT
Begin DoDot:1
+4 SET GMTSA=$PIECE($GET(GMTSPRE),";",GMTSI)
if $LENGTH(GMTSA)'=3
QUIT
if GMTSA'="NAT"&(GMTSC'[("^"_GMTSA_"^"))
QUIT
if GMTS[(";"_GMTSA)
QUIT
SET GMTS=GMTS_";"_GMTSA
End DoDot:1
+5 SET GMTSPRE=$$TRIM^GMTSXA(GMTS,";")
if '$LENGTH(GMTSPRE)
SET GMTSPRE=GMTSDEF
+6 SET X=GMTSPRE
+7 QUIT X
