GMTSXPD2 ;SLC/KER - Health Summary Dist (Component) ;Jul 18, 2019@11:46
;;2.7;Health Summary;**35,56,67**;Oct 20, 1995;Build 538
;
; External References
; DBIA 1340 ^DIC(19.1,
; DBIA 2052 $$GET1^DID
;
Q
; Check Input
NAME(X) ; Check Name (required)
S X=$G(X) K:X[""""!($A(X)=45) X Q:'$D(X) ""
I $D(X) K:$L(X)>30!($L(X)<3)!'(X'?1P.E) X
I $L($G(X)),'$D(^GMT(142.1,+($G(Y)),0)) D
. K:$D(^GMT(142.1,"B",X)) X Q:'$D(X) Q:+($G(Y))'>0 I $P($G(^GMT(142.1,+($G(Y)),0)),"^",1)'=$G(X) K X
S X=$G(X) Q X
ROUT(X) ; Check Routine (required)
S X=$G(X) K:X[""""!($A(X)=45) X Q:'$D(X) ""
K:$L(X)>17!($L(X)<3)!'(X?1U1.7UN1";"1U1.7UN) X Q:'$D(X) ""
I @("$L($T("_$P(X,";")_"^"_$P(X,";",2)_"))'>0") K X
S X=$G(X) Q X
TIML(X) ; Check Time Limits
S X=$G(X) Q:X="1"!(X="Y") "Y" Q ""
ABBR(X) ; Check Abbreviation
S X=$G(X) S:X[""""!($A(X)=45) X="" S:$L(X)>4!($L(X)<2)!'(X?2.4UN) X="" Q X
OCCL(X) ; Check Occurrence Limits
S X=$G(X) Q:X="1"!(X="Y") "Y" Q ""
LOCK(X) ; Check Lock
S X=$G(X) S:X[""""!($A(X)=45) X="" S:$L(X)>30!($L(X)<1) X="" Q:'$L(X) ""
S:'$D(^DIC(19.1,"B",X)) X="" Q X
DHDN(X) ; Check Default Header Name
S X=$G(X) S:X[""""!($A(X)=45) X="" S:$L(X)>20!($L(X)<2) X="" Q X
HOSL(X) ; Check Hospital Locaiton Flag
S X=$G(X) Q:X="1"!(X="Y") "Y" Q ""
ICDT(X) ; Check ICD Text Flag
S X=$G(X) Q:X="1"!(X="Y") "Y" Q ""
PROV(X) ; Check Provider Narrative Flag
S X=$G(X) Q:X="1"!(X="Y") "Y" Q ""
PREF(X) ; Check Prefix
S X=$G(X) N GMTS S GMTS=$$GET1^DID(142.1,13,,"LABEL") Q:'$L(GMTS) ""
S:X[""""!($A(X)=45) X="" S:$L(X)>4!($L(X)<2) X="" S:$E(X,1,2)'?2U X="" S:X'?1U.UN X="" Q X
CPTM(X) ; Check CPT Modifier Flag
S X=$G(X) N GMTS S GMTS=$$GET1^DID(142.1,14,,"LABEL") Q:'$L(GMTS) ""
Q:X="1"!(X="Y") "Y" Q ""
DAF(X) ; Check Disable Flag
S X=$G(X) Q:X="T" "T" Q:X="P" "P" Q ""
OOM(X) ; Check Out of Order Message
S X=$G(X) Q:$L(X)<3 "" Q:$L(X)>78 "" Q X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSXPD2 1974 printed Nov 22, 2024@17:11:03 Page 2
GMTSXPD2 ;SLC/KER - Health Summary Dist (Component) ;Jul 18, 2019@11:46
+1 ;;2.7;Health Summary;**35,56,67**;Oct 20, 1995;Build 538
+2 ;
+3 ; External References
+4 ; DBIA 1340 ^DIC(19.1,
+5 ; DBIA 2052 $$GET1^DID
+6 ;
+7 QUIT
+8 ; Check Input
NAME(X) ; Check Name (required)
+1 SET X=$GET(X)
if X[""""!($ASCII(X)=45)
KILL X
if '$DATA(X)
QUIT ""
+2 IF $DATA(X)
if $LENGTH(X)>30!($LENGTH(X)<3)!'(X'?1P.E)
KILL X
+3 IF $LENGTH($GET(X))
IF '$DATA(^GMT(142.1,+($GET(Y)),0))
Begin DoDot:1
+4 if $DATA(^GMT(142.1,"B",X))
KILL X
if '$DATA(X)
QUIT
if +($GET(Y))'>0
QUIT
IF $PIECE($GET(^GMT(142.1,+($GET(Y)),0)),"^",1)'=$GET(X)
KILL X
End DoDot:1
+5 SET X=$GET(X)
QUIT X
ROUT(X) ; Check Routine (required)
+1 SET X=$GET(X)
if X[""""!($ASCII(X)=45)
KILL X
if '$DATA(X)
QUIT ""
+2 if $LENGTH(X)>17!($LENGTH(X)<3)!'(X?1U1.7UN1";"1U1.7UN)
KILL X
if '$DATA(X)
QUIT ""
+3 IF @("$L($T("_$PIECE(X,";")_"^"_$PIECE(X,";",2)_"))'>0")
KILL X
+4 SET X=$GET(X)
QUIT X
TIML(X) ; Check Time Limits
+1 SET X=$GET(X)
if X="1"!(X="Y")
QUIT "Y"
QUIT ""
ABBR(X) ; Check Abbreviation
+1 SET X=$GET(X)
if X[""""!($ASCII(X)=45)
SET X=""
if $LENGTH(X)>4!($LENGTH(X)<2)!'(X?2.4UN)
SET X=""
QUIT X
OCCL(X) ; Check Occurrence Limits
+1 SET X=$GET(X)
if X="1"!(X="Y")
QUIT "Y"
QUIT ""
LOCK(X) ; Check Lock
+1 SET X=$GET(X)
if X[""""!($ASCII(X)=45)
SET X=""
if $LENGTH(X)>30!($LENGTH(X)<1)
SET X=""
if '$LENGTH(X)
QUIT ""
+2 if '$DATA(^DIC(19.1,"B",X))
SET X=""
QUIT X
DHDN(X) ; Check Default Header Name
+1 SET X=$GET(X)
if X[""""!($ASCII(X)=45)
SET X=""
if $LENGTH(X)>20!($LENGTH(X)<2)
SET X=""
QUIT X
HOSL(X) ; Check Hospital Locaiton Flag
+1 SET X=$GET(X)
if X="1"!(X="Y")
QUIT "Y"
QUIT ""
ICDT(X) ; Check ICD Text Flag
+1 SET X=$GET(X)
if X="1"!(X="Y")
QUIT "Y"
QUIT ""
PROV(X) ; Check Provider Narrative Flag
+1 SET X=$GET(X)
if X="1"!(X="Y")
QUIT "Y"
QUIT ""
PREF(X) ; Check Prefix
+1 SET X=$GET(X)
NEW GMTS
SET GMTS=$$GET1^DID(142.1,13,,"LABEL")
if '$LENGTH(GMTS)
QUIT ""
+2 if X[""""!($ASCII(X)=45)
SET X=""
if $LENGTH(X)>4!($LENGTH(X)<2)
SET X=""
if $EXTRACT(X,1,2)'?2U
SET X=""
if X'?1U.UN
SET X=""
QUIT X
CPTM(X) ; Check CPT Modifier Flag
+1 SET X=$GET(X)
NEW GMTS
SET GMTS=$$GET1^DID(142.1,14,,"LABEL")
if '$LENGTH(GMTS)
QUIT ""
+2 if X="1"!(X="Y")
QUIT "Y"
QUIT ""
DAF(X) ; Check Disable Flag
+1 SET X=$GET(X)
if X="T"
QUIT "T"
if X="P"
QUIT "P"
QUIT ""
OOM(X) ; Check Out of Order Message
+1 SET X=$GET(X)
if $LENGTH(X)<3
QUIT ""
if $LENGTH(X)>78
QUIT ""
QUIT X
+2 QUIT
