- 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 Feb 18, 2025@23:27:09 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