GMTSPLST ; SLC/JER,KER,TC - Problem List ;07/02/13 09:56
;;2.7;Health Summary;**28,35,52,86,101**;Oct 20, 1995;Build 12
;
; External References
; DBIA 10011 ^DIWP
; DBIA 1183 GETLIST^GMPLHS
; DBIA 1573 $$DSMONE^LEXU
;
; Variable NEWed/KILLed Elsewhere
; DFN, GMPXICDF, GMPXNARR, GMTSNPG, GMTSQIT
;
ACTIVE ; Get Active Problems
N STATUS S STATUS="A" D MAIN Q
INACT ; Get Inactive Problems
N STATUS S STATUS="I" D MAIN Q
ALL ; Get All Problems (Active and Inactive)
N STATUS S STATUS="ALL" D MAIN Q
MAIN ; Driver
D GETLIST^GMPLHS(DFN,STATUS) Q:'$D(^TMP("GMPLHS",$J)) D SUBHDR D WRT K ^TMP("GMPLHS",$J) Q
;
WRT ; Writes Problem List Component,X
;
; ^TMP("GMPLHS",$J,#,0)=
; Piece 1: Diagnosis
; 2: Date Last Modified
; 3: Site
; 4: Date Entered
; 5: Status
; 6: Date of Onset
; 7: Responsible Provider
; 8: Service
; 9: Service Abbreviation
; 10: Date Resolved
; 11: Clinic
; 12: Date Recorded
; 13: Problem - Lexicon Term
; 14: Exposure Combined String
; 15: SNOMED-CT Concept Code
; 16: SNOMED-CT Preferred Text
; 17: ICD-9-CM Code
; 18: ICD-9-CM Description
; 19: VHAT Concept Code
; 20: VHAT Preferred Text
; 21: Date of Interest
; 22: Coding System (of Primary diagnosis)
;
; ^TMP("GMPLHS",$J,#,#,"ICD9") Other multiple mapped ICD-9-CM codes
; ^TMP("GMPLHS",$J,#,"L") Lexicon Term
; ^TMP("GMPLHS",$J,#,"N") Provider Narrative
; ^TMP("GMPLHS",$J,#,"C",LOC,#,0)) Comments
;
N GMREC,GMTSICL,GMTAB,LINE1,DIWL,GMTSTXTF
S GMTSICL=32,DIWL=0,GMTAB=0,GMREC=0,GMTSTXTF=0
F S GMREC=$O(^TMP("GMPLHS",$J,GMREC)) Q:GMREC'>0 D Q:$D(GMTSQIT)
. N GMNODE,GMDIAG,GMDIAC,GMDIAT,GMDIAS,LASTMDT,STAT,ONSETDT,PROV,SERV,GMSCT,GMVHAT,GMTSDINT,GMTSCSYS
. N RESDT,NARR,GMICD,GMDSM,GMDSMS,CODE,LEXI,LEX,PLIFN,ADDINFO,EXP,GMTSX,X,GMDIAC,GMDIAT,GMTSILBL
. S (GMDIAC,GMDIAT)=""
. S GMNODE=$G(^TMP("GMPLHS",$J,GMREC,0))
. Q:GMNODE']""
. S GMDIAG=$P(GMNODE,U),LASTMDT=$P(GMNODE,U,2),STAT=$P(GMNODE,U,5)
. S GMTSDINT=$P(GMNODE,U,21),GMTSCSYS=$P(GMNODE,U,22),GMTSILBL=$S($G(GMTSCSYS)="ICD":"ICD-9-CM ",1:"ICD-10-CM ")
. S X=LASTMDT D REGDT4^GMTSU S LASTMDT=X
. S ONSETDT=$P(GMNODE,U,6),PROV=$P(GMNODE,U,7)
. S RESDT=$P(GMNODE,U,10),GMICD="",GMSCT=$P(GMNODE,U,15),GMVHAT=$P(GMNODE,U,19)
. S EXP=$P(GMNODE,U,14) S:$L(EXP) EXP=" ("_EXP_")"
. I STAT="A",+ONSETDT S X=ONSETDT D REGDT4^GMTSU S ADDINFO="Onset "_X
. I STAT="I",+RESDT S X=RESDT D REGDT4^GMTSU S ADDINFO="Resolved "_X
. S GMPXICDF=$$UP($G(GMPXICDF))
. S GMTSTXTF=$S(($G(GMPXICDF)="T")!($G(GMPXICDF)["TEXT ONLY"):1,1:0)
. I $G(GMPXICDF)]"",($G(GMPXICDF)'="N")!($G(GMPXICDF)["NONE"),GMDIAG]"" D
. . D GETICDDX^GMTSPXU1(.GMDIAG,$G(GMPXICDF),"",GMTSDINT,GMTSCSYS) S GMICD=GMDIAG
. I $G(GMTSTXTF)=0 S GMDIAC=$P($G(GMICD),"-",1),GMDIAT=$P($G(GMICD),"-",2,299)
. S LEX=$G(^TMP("GMPLHS",$J,GMREC,"L"))
. S NARR=""
. S:$G(GMPXNARR)'="N"!(LEX["Unresolved") NARR=$G(^TMP("GMPLHS",$J,GMREC,"N"))
. S LEXI=+LEX,LEX=$P(LEX,"^",2) S:$$UP(LEX)["UNRESOLVED"!(+LEXI'>1) (LEXI,LEX)=""
. S (CODE,GMDIAS,GMDSMS,GMDSM)="" S:+LEXI>0 GMDSM=$$DSMONE^LEXU(+LEXI)
. S:GMDIAC["799.9" GMDSM=""
. S:$L(GMDSM)>2&(GMDSM'[".") GMDSM=GMDSM_"."
. S:$L(GMDIAC) GMDIAS="("_GMTSILBL_GMDIAC_")"
. S:$L(GMDSM) GMDSMS="(DSM "_GMDSM_")"
. S:$L(GMDIAC)&($L(GMDSM))&(GMDIAC=GMDSM) GMDIAS=GMDIAC,GMDSMS=""
. I $G(^TMP("GMPLHS",$J,GMREC,0,"ICD9"))="" D
. . S:$L(GMDIAC)&$S($L(GMSCT):1,$L(GMVHAT):1,1:0) GMDIAS=$S($L(GMSCT):"(SCT ",1:"(VHAT ")_GMSCT_") ("_GMTSILBL_GMDIAC_")"
. E I $L(GMDIAC)&$S($L(GMSCT):1,$L(GMVHAT):1,1:0) D
. . S GMDIAS=$S($L(GMSCT):"(SCT ",1:"(VHAT ")_GMSCT_") ("_GMTSILBL_GMDIAC
. . N T S T=0 F S T=$O(^TMP("GMPLHS",$J,GMREC,T)) Q:'+T D
. . . S GMDIAS=GMDIAS_"/"_$P($G(^TMP("GMPLHS",$J,GMREC,T,"ICD9")),U,1)
. . S GMDIAS=GMDIAS_")"
. S:$L(GMDIAS) CODE=GMDIAS S:$L(GMDSMS) CODE=CODE_" "_GMDSMS F Q:$E(CODE,1)'=" " S CODE=$E(CODE,2,$L(CODE))
. S:$L(LEX)&($L(CODE)) LEX=LEX_" "_CODE
. S:$L(GMDIAT)&($L(CODE)) GMICD=GMDIAT_" "_CODE
. ; Unresolved or Unspecified
. I GMDIAC["799.9",$L($G(NARR)) D
. . N UNARR S UNARR=$$UP(NARR)
. . I UNARR["UNKNOWN AND UNSPECIFIED"!(UNARR["UNKNOWN OR UNSPECIFIED")!(UNARR["MORBIDITY OR MORTALITY") D Q
. . . S GMICD=GMDIAT_" "_CODE,NARR=""
. . S GMICD=$$UP($E(NARR,1))_$E(NARR,2,$L(NARR))_" "_CODE
. . S:$L(LEX) GMICD=LEX S NARR=""
. ; Specified by Lexicon
. I GMDIAC'["799.9",$L($G(LEX)) D
. . S GMICD=LEX,NARR=""
. ; Specified by Provider Narrative
. I GMDIAC'["799.9",'$L($G(LEX)) D
. . S:$L(NARR)&($$UP(GMDIAT)'=$$UP(NARR)) GMICD=$S($$UP($G(GMPXICDF))="C"!($$UP($G(GMPXICDF))="CODE ONLY"):"("_GMTSILBL_GMICD_"); ",$L($G(GMDIAT))<1:"",1:GMICD_"; ")_NARR S NARR=""
. S:$G(IOST)["P-"&(EXP["MST") EXT=$$RM(EXP)
. S:$L(GMICD)&($L(EXP)) GMICD=GMICD_EXP
. S:$L(GMICD) GMICD=GMICD_$S($G(ADDINFO)]"":", "_ADDINFO,1:""),NARR=""
. S GMICD=$$RF(GMICD)
. D TXTFMT^GMTSPXU1(GMICD,$G(NARR),GMTSICL,GMTAB,DIWL)
. I '$D(^UTILITY($J,"W")) Q
. S GMTSX=0,LINE1=1
. F S GMTSX=$O(^UTILITY($J,"W",DIWL,GMTSX)) Q:GMTSX'>0!$D(GMTSQIT) D
. . D:LINE1 L1 D:'LINE1 LN S LINE1=0
. D DC
. K ^UTILITY($J,"W")
. D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG SUBHDR2 W !
Q
L1 ; Line #1 Problem, date, provider
D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG SUBHDR2 W:STATUS="ALL" STAT W ?3,$G(^UTILITY($J,"W",DIWL,GMTSX,0)),?53,LASTMDT,?65,$E(PROV,1,15),! Q
LN ; Line >1 Problem (other)
D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG SUBHDR2 W ?3,$G(^UTILITY($J,"W",DIWL,GMTSX,0)),! Q
;
DC ; Comments are displayed if there are any
N LOC,GMR,NODE,DATE,X,UCNT,CNT,CMT,T,I S LOC="",CNT=0
F S LOC=$O(^TMP("GMPLHS",$J,GMREC,"C",LOC)) Q:LOC']"" D Q:$D(GMTSQIT)
. S (CNT,UCNT)=0 S:+($O(^TMP("GMPLHS",$J,GMREC,"C",LOC," "),-1))>1 UCNT=1
. S GMR=0 F S GMR=$O(^TMP("GMPLHS",$J,GMREC,"C",LOC,GMR)) Q:+GMR'>0 D Q:$D(GMTSQIT)
. . S NODE=$G(^TMP("GMPLHS",$J,GMREC,"C",LOC,GMR,0)) Q:NODE']""
. . S CMT=$P(NODE,U) I $L($G(CMT)) D LC
Q
LC ; List Comments (unnumbered and numbered)
S CNT=CNT+1 K ^UTILITY($J,"W") D:UCNT CF(CNT,CMT) D:'UCNT CF(0,CMT)
I $D(^UTILITY($J,"W",0)) N I,T S I=0 F S I=$O(^UTILITY($J,"W",0,I)) Q:+I=0 D
. S T=$$RT($G(^UTILITY($J,"W",0,I,0))) Q:'$L(T) D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG SUBHDR2 W:I=1 ?3 W:I>1 ?7 W $G(T),!
Q
CF(GMC,GMT) ; Formats GMC (count) and GMT (text) together
S GMC=+($G(GMC)),GMT=$G(GMT) Q:'$L(GMT) S GMT=$$LD(GMT)
N GMCOL,DIWL,DIWR,DIWF,X S GMCOL=34,DIWL=0,DIWR=80-(GMCOL) K ^UTILITY($J,"W")
S:+($G(GMC))=0 X=" "_GMT S:+($G(GMC))>0 X=$J(GMC,2)_". "_GMT D:$G(X)]"" ^DIWP
Q
;
SUBHDR ; Subheader for Problem List Component
N NUM,TOT,NODE S NODE=$G(^TMP("GMPLHS",$J,STATUS,0)) S NUM=$P(NODE,U),TOT=$P(NODE,U,2)
D CKP^GMTSUP Q:$D(GMTSQIT) S:TOT>NUM NUM=NUM_" of "_TOT W ?50,NUM_$S(STATUS="A":" Active",STATUS="I":" Inactive",1:"")_" Problems",!
SUBHDR2 ; Will be written on new pages
D CKP^GMTSUP Q:$D(GMTSQIT) W:STATUS="ALL" "ST" W ?3,"PROBLEM",?53,"LAST MOD",?65,"PROVIDER",! Q
;
RM(X) ; Remove MST
S X=$G(X) F Q:X'["MST" S X=$P(X,"MST",1)_$P(X,"MST",2)
F Q:X'["//" S X=$P(X,"//",1)_"/"_$P(X,"//",2)
F Q:$E(X,$L(X))'="/" S X=$E(X,1,($L(X)-1))
F Q:$E(X,1)'="/" S X=$E(X,2,$L(X))
Q X
RF(X) ; Remove Leading Spaces/Punctuation
F Q:$E(X,1)'=" " S X=$E(X,2,$L(X))
F Q:$E(X,1)'=";" S X=$E(X,2,$L(X))
F Q:$E(X,1)'=" " S X=$E(X,2,$L(X))
S X=$$LD(X) Q X
LD(X) ; Uppercase Leading Character
Q $TR($E(X,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$E(X,2,$L(X))
RT(X) ; Right Trim Spaces
S X=$G(X) F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1))
Q X
UP(X) ; Uppercase
Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSPLST 8084 printed Sep 23, 2025@19:35:21 Page 2
GMTSPLST ; SLC/JER,KER,TC - Problem List ;07/02/13 09:56
+1 ;;2.7;Health Summary;**28,35,52,86,101**;Oct 20, 1995;Build 12
+2 ;
+3 ; External References
+4 ; DBIA 10011 ^DIWP
+5 ; DBIA 1183 GETLIST^GMPLHS
+6 ; DBIA 1573 $$DSMONE^LEXU
+7 ;
+8 ; Variable NEWed/KILLed Elsewhere
+9 ; DFN, GMPXICDF, GMPXNARR, GMTSNPG, GMTSQIT
+10 ;
ACTIVE ; Get Active Problems
+1 NEW STATUS
SET STATUS="A"
DO MAIN
QUIT
INACT ; Get Inactive Problems
+1 NEW STATUS
SET STATUS="I"
DO MAIN
QUIT
ALL ; Get All Problems (Active and Inactive)
+1 NEW STATUS
SET STATUS="ALL"
DO MAIN
QUIT
MAIN ; Driver
+1 DO GETLIST^GMPLHS(DFN,STATUS)
if '$DATA(^TMP("GMPLHS",$JOB))
QUIT
DO SUBHDR
DO WRT
KILL ^TMP("GMPLHS",$JOB)
QUIT
+2 ;
WRT ; Writes Problem List Component,X
+1 ;
+2 ; ^TMP("GMPLHS",$J,#,0)=
+3 ; Piece 1: Diagnosis
+4 ; 2: Date Last Modified
+5 ; 3: Site
+6 ; 4: Date Entered
+7 ; 5: Status
+8 ; 6: Date of Onset
+9 ; 7: Responsible Provider
+10 ; 8: Service
+11 ; 9: Service Abbreviation
+12 ; 10: Date Resolved
+13 ; 11: Clinic
+14 ; 12: Date Recorded
+15 ; 13: Problem - Lexicon Term
+16 ; 14: Exposure Combined String
+17 ; 15: SNOMED-CT Concept Code
+18 ; 16: SNOMED-CT Preferred Text
+19 ; 17: ICD-9-CM Code
+20 ; 18: ICD-9-CM Description
+21 ; 19: VHAT Concept Code
+22 ; 20: VHAT Preferred Text
+23 ; 21: Date of Interest
+24 ; 22: Coding System (of Primary diagnosis)
+25 ;
+26 ; ^TMP("GMPLHS",$J,#,#,"ICD9") Other multiple mapped ICD-9-CM codes
+27 ; ^TMP("GMPLHS",$J,#,"L") Lexicon Term
+28 ; ^TMP("GMPLHS",$J,#,"N") Provider Narrative
+29 ; ^TMP("GMPLHS",$J,#,"C",LOC,#,0)) Comments
+30 ;
+31 NEW GMREC,GMTSICL,GMTAB,LINE1,DIWL,GMTSTXTF
+32 SET GMTSICL=32
SET DIWL=0
SET GMTAB=0
SET GMREC=0
SET GMTSTXTF=0
+33 FOR
SET GMREC=$ORDER(^TMP("GMPLHS",$JOB,GMREC))
if GMREC'>0
QUIT
Begin DoDot:1
+34 NEW GMNODE,GMDIAG,GMDIAC,GMDIAT,GMDIAS,LASTMDT,STAT,ONSETDT,PROV,SERV,GMSCT,GMVHAT,GMTSDINT,GMTSCSYS
+35 NEW RESDT,NARR,GMICD,GMDSM,GMDSMS,CODE,LEXI,LEX,PLIFN,ADDINFO,EXP,GMTSX,X,GMDIAC,GMDIAT,GMTSILBL
+36 SET (GMDIAC,GMDIAT)=""
+37 SET GMNODE=$GET(^TMP("GMPLHS",$JOB,GMREC,0))
+38 if GMNODE']""
QUIT
+39 SET GMDIAG=$PIECE(GMNODE,U)
SET LASTMDT=$PIECE(GMNODE,U,2)
SET STAT=$PIECE(GMNODE,U,5)
+40 SET GMTSDINT=$PIECE(GMNODE,U,21)
SET GMTSCSYS=$PIECE(GMNODE,U,22)
SET GMTSILBL=$SELECT($GET(GMTSCSYS)="ICD":"ICD-9-CM ",1:"ICD-10-CM ")
+41 SET X=LASTMDT
DO REGDT4^GMTSU
SET LASTMDT=X
+42 SET ONSETDT=$PIECE(GMNODE,U,6)
SET PROV=$PIECE(GMNODE,U,7)
+43 SET RESDT=$PIECE(GMNODE,U,10)
SET GMICD=""
SET GMSCT=$PIECE(GMNODE,U,15)
SET GMVHAT=$PIECE(GMNODE,U,19)
+44 SET EXP=$PIECE(GMNODE,U,14)
if $LENGTH(EXP)
SET EXP=" ("_EXP_")"
+45 IF STAT="A"
IF +ONSETDT
SET X=ONSETDT
DO REGDT4^GMTSU
SET ADDINFO="Onset "_X
+46 IF STAT="I"
IF +RESDT
SET X=RESDT
DO REGDT4^GMTSU
SET ADDINFO="Resolved "_X
+47 SET GMPXICDF=$$UP($GET(GMPXICDF))
+48 SET GMTSTXTF=$SELECT(($GET(GMPXICDF)="T")!($GET(GMPXICDF)["TEXT ONLY"):1,1:0)
+49 IF $GET(GMPXICDF)]""
IF ($GET(GMPXICDF)'="N")!($GET(GMPXICDF)["NONE")
IF GMDIAG]""
Begin DoDot:2
+50 DO GETICDDX^GMTSPXU1(.GMDIAG,$GET(GMPXICDF),"",GMTSDINT,GMTSCSYS)
SET GMICD=GMDIAG
End DoDot:2
+51 IF $GET(GMTSTXTF)=0
SET GMDIAC=$PIECE($GET(GMICD),"-",1)
SET GMDIAT=$PIECE($GET(GMICD),"-",2,299)
+52 SET LEX=$GET(^TMP("GMPLHS",$JOB,GMREC,"L"))
+53 SET NARR=""
+54 if $GET(GMPXNARR)'="N"!(LEX["Unresolved")
SET NARR=$GET(^TMP("GMPLHS",$JOB,GMREC,"N"))
+55 SET LEXI=+LEX
SET LEX=$PIECE(LEX,"^",2)
if $$UP(LEX)["UNRESOLVED"!(+LEXI'>1)
SET (LEXI,LEX)=""
+56 SET (CODE,GMDIAS,GMDSMS,GMDSM)=""
if +LEXI>0
SET GMDSM=$$DSMONE^LEXU(+LEXI)
+57 if GMDIAC["799.9"
SET GMDSM=""
+58 if $LENGTH(GMDSM)>2&(GMDSM'[".")
SET GMDSM=GMDSM_"."
+59 if $LENGTH(GMDIAC)
SET GMDIAS="("_GMTSILBL_GMDIAC_")"
+60 if $LENGTH(GMDSM)
SET GMDSMS="(DSM "_GMDSM_")"
+61 if $LENGTH(GMDIAC)&($LENGTH(GMDSM))&(GMDIAC=GMDSM)
SET GMDIAS=GMDIAC
SET GMDSMS=""
+62 IF $GET(^TMP("GMPLHS",$JOB,GMREC,0,"ICD9"))=""
Begin DoDot:2
+63 if $LENGTH(GMDIAC)&$SELECT($LENGTH(GMSCT)
SET GMDIAS=$SELECT($LENGTH(GMSCT):"(SCT ",1:"(VHAT ")_GMSCT_") ("_GMTSILBL_GMDIAC_")"
End DoDot:2
+64 IF '$TEST
IF $LENGTH(GMDIAC)&$SELECT($LENGTH(GMSCT):1,$LENGTH(GMVHAT):1,1:0)
Begin DoDot:2
+65 SET GMDIAS=$SELECT($LENGTH(GMSCT):"(SCT ",1:"(VHAT ")_GMSCT_") ("_GMTSILBL_GMDIAC
+66 NEW T
SET T=0
FOR
SET T=$ORDER(^TMP("GMPLHS",$JOB,GMREC,T))
if '+T
QUIT
Begin DoDot:3
+67 SET GMDIAS=GMDIAS_"/"_$PIECE($GET(^TMP("GMPLHS",$JOB,GMREC,T,"ICD9")),U,1)
End DoDot:3
+68 SET GMDIAS=GMDIAS_")"
End DoDot:2
+69 if $LENGTH(GMDIAS)
SET CODE=GMDIAS
if $LENGTH(GMDSMS)
SET CODE=CODE_" "_GMDSMS
FOR
if $EXTRACT(CODE,1)'=" "
QUIT
SET CODE=$EXTRACT(CODE,2,$LENGTH(CODE))
+70 if $LENGTH(LEX)&($LENGTH(CODE))
SET LEX=LEX_" "_CODE
+71 if $LENGTH(GMDIAT)&($LENGTH(CODE))
SET GMICD=GMDIAT_" "_CODE
+72 ; Unresolved or Unspecified
+73 IF GMDIAC["799.9"
IF $LENGTH($GET(NARR))
Begin DoDot:2
+74 NEW UNARR
SET UNARR=$$UP(NARR)
+75 IF UNARR["UNKNOWN AND UNSPECIFIED"!(UNARR["UNKNOWN OR UNSPECIFIED")!(UNARR["MORBIDITY OR MORTALITY")
Begin DoDot:3
+76 SET GMICD=GMDIAT_" "_CODE
SET NARR=""
End DoDot:3
QUIT
+77 SET GMICD=$$UP($EXTRACT(NARR,1))_$EXTRACT(NARR,2,$LENGTH(NARR))_" "_CODE
+78 if $LENGTH(LEX)
SET GMICD=LEX
SET NARR=""
End DoDot:2
+79 ; Specified by Lexicon
+80 IF GMDIAC'["799.9"
IF $LENGTH($GET(LEX))
Begin DoDot:2
+81 SET GMICD=LEX
SET NARR=""
End DoDot:2
+82 ; Specified by Provider Narrative
+83 IF GMDIAC'["799.9"
IF '$LENGTH($GET(LEX))
Begin DoDot:2
+84 if $LENGTH(NARR)&($$UP(GMDIAT)'=$$UP(NARR))
SET GMICD=$SELECT($$UP($GET(GMPXICDF))="C"!($$UP($GET(GMPXICDF))="CODE ONLY"):"("_GMTSILBL_GMICD_"); ",$LENGTH($GET(GMDIAT))<1:"",1:GMICD_"; ")_NARR
SET NARR=""
End DoDot:2
+85 if $GET(IOST)["P-"&(EXP["MST")
SET EXT=$$RM(EXP)
+86 if $LENGTH(GMICD)&($LENGTH(EXP))
SET GMICD=GMICD_EXP
+87 if $LENGTH(GMICD)
SET GMICD=GMICD_$SELECT($GET(ADDINFO)]"":", "_ADDINFO,1:"")
SET NARR=""
+88 SET GMICD=$$RF(GMICD)
+89 DO TXTFMT^GMTSPXU1(GMICD,$GET(NARR),GMTSICL,GMTAB,DIWL)
+90 IF '$DATA(^UTILITY($JOB,"W"))
QUIT
+91 SET GMTSX=0
SET LINE1=1
+92 FOR
SET GMTSX=$ORDER(^UTILITY($JOB,"W",DIWL,GMTSX))
if GMTSX'>0!$DATA(GMTSQIT)
QUIT
Begin DoDot:2
+93 if LINE1
DO L1
if 'LINE1
DO LN
SET LINE1=0
End DoDot:2
+94 DO DC
+95 KILL ^UTILITY($JOB,"W")
+96 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
if GMTSNPG
DO SUBHDR2
WRITE !
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+97 QUIT
L1 ; Line #1 Problem, date, provider
+1 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
if GMTSNPG
DO SUBHDR2
if STATUS="ALL"
WRITE STAT
WRITE ?3,$GET(^UTILITY($JOB,"W",DIWL,GMTSX,0)),?53,LASTMDT,?65,$EXTRACT(PROV,1,15),!
QUIT
LN ; Line >1 Problem (other)
+1 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
if GMTSNPG
DO SUBHDR2
WRITE ?3,$GET(^UTILITY($JOB,"W",DIWL,GMTSX,0)),!
QUIT
+2 ;
DC ; Comments are displayed if there are any
+1 NEW LOC,GMR,NODE,DATE,X,UCNT,CNT,CMT,T,I
SET LOC=""
SET CNT=0
+2 FOR
SET LOC=$ORDER(^TMP("GMPLHS",$JOB,GMREC,"C",LOC))
if LOC']""
QUIT
Begin DoDot:1
+3 SET (CNT,UCNT)=0
if +($ORDER(^TMP("GMPLHS",$JOB,GMREC,"C",LOC," "),-1))>1
SET UCNT=1
+4 SET GMR=0
FOR
SET GMR=$ORDER(^TMP("GMPLHS",$JOB,GMREC,"C",LOC,GMR))
if +GMR'>0
QUIT
Begin DoDot:2
+5 SET NODE=$GET(^TMP("GMPLHS",$JOB,GMREC,"C",LOC,GMR,0))
if NODE']""
QUIT
+6 SET CMT=$PIECE(NODE,U)
IF $LENGTH($GET(CMT))
DO LC
End DoDot:2
if $DATA(GMTSQIT)
QUIT
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+7 QUIT
LC ; List Comments (unnumbered and numbered)
+1 SET CNT=CNT+1
KILL ^UTILITY($JOB,"W")
if UCNT
DO CF(CNT,CMT)
if 'UCNT
DO CF(0,CMT)
+2 IF $DATA(^UTILITY($JOB,"W",0))
NEW I,T
SET I=0
FOR
SET I=$ORDER(^UTILITY($JOB,"W",0,I))
if +I=0
QUIT
Begin DoDot:1
+3 SET T=$$RT($GET(^UTILITY($JOB,"W",0,I,0)))
if '$LENGTH(T)
QUIT
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
if GMTSNPG
DO SUBHDR2
if I=1
WRITE ?3
if I>1
WRITE ?7
WRITE $GET(T),!
End DoDot:1
+4 QUIT
CF(GMC,GMT) ; Formats GMC (count) and GMT (text) together
+1 SET GMC=+($GET(GMC))
SET GMT=$GET(GMT)
if '$LENGTH(GMT)
QUIT
SET GMT=$$LD(GMT)
+2 NEW GMCOL,DIWL,DIWR,DIWF,X
SET GMCOL=34
SET DIWL=0
SET DIWR=80-(GMCOL)
KILL ^UTILITY($JOB,"W")
+3 if +($GET(GMC))=0
SET X=" "_GMT
if +($GET(GMC))>0
SET X=$JUSTIFY(GMC,2)_". "_GMT
if $GET(X)]""
DO ^DIWP
+4 QUIT
+5 ;
SUBHDR ; Subheader for Problem List Component
+1 NEW NUM,TOT,NODE
SET NODE=$GET(^TMP("GMPLHS",$JOB,STATUS,0))
SET NUM=$PIECE(NODE,U)
SET TOT=$PIECE(NODE,U,2)
+2 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
if TOT>NUM
SET NUM=NUM_" of "_TOT
WRITE ?50,NUM_$SELECT(STATUS="A":" Active",STATUS="I":" Inactive",1:"")_" Problems",!
SUBHDR2 ; Will be written on new pages
+1 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
if STATUS="ALL"
WRITE "ST"
WRITE ?3,"PROBLEM",?53,"LAST MOD",?65,"PROVIDER",!
QUIT
+2 ;
RM(X) ; Remove MST
+1 SET X=$GET(X)
FOR
if X'["MST"
QUIT
SET X=$PIECE(X,"MST",1)_$PIECE(X,"MST",2)
+2 FOR
if X'["//"
QUIT
SET X=$PIECE(X,"//",1)_"/"_$PIECE(X,"//",2)
+3 FOR
if $EXTRACT(X,$LENGTH(X))'="/"
QUIT
SET X=$EXTRACT(X,1,($LENGTH(X)-1))
+4 FOR
if $EXTRACT(X,1)'="/"
QUIT
SET X=$EXTRACT(X,2,$LENGTH(X))
+5 QUIT X
RF(X) ; Remove Leading Spaces/Punctuation
+1 FOR
if $EXTRACT(X,1)'=" "
QUIT
SET X=$EXTRACT(X,2,$LENGTH(X))
+2 FOR
if $EXTRACT(X,1)'=";"
QUIT
SET X=$EXTRACT(X,2,$LENGTH(X))
+3 FOR
if $EXTRACT(X,1)'=" "
QUIT
SET X=$EXTRACT(X,2,$LENGTH(X))
+4 SET X=$$LD(X)
QUIT X
LD(X) ; Uppercase Leading Character
+1 QUIT $TRANSLATE($EXTRACT(X,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$EXTRACT(X,2,$LENGTH(X))
RT(X) ; Right Trim Spaces
+1 SET X=$GET(X)
FOR
if $EXTRACT(X,$LENGTH(X))'=" "
QUIT
SET X=$EXTRACT(X,1,($LENGTH(X)-1))
+2 QUIT X
UP(X) ; Uppercase
+1 QUIT $TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
