GMTSPLST ; SLC/JER,KER,TC - Problem List ;23-Jan-2014 10:31;DU
;;2.7;Health Summary;**28,35,52,86,1006**;Oct 20, 1995;Build 3
;
; 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
;
; ^TMP("GMPLHS",$J,#,#,"ICD9") Other multiple mapped ICD-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,EXT,SNO
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
. N RESDT,NARR,GMICD,GMDSM,GMDSMS,CODE,LEXI,LEX,PLIFN,ADDINFO,EXP,GMTSX,X,GMDIAC,GMDIAT
. 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 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)) 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 SNO=$G(^TMP("GMPLHS",$J,GMREC,"S"))
. 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="(ICD-CM "_GMDIAC_")"
. S:$L(GMDSM) GMDSMS="(DSM "_GMDSM_")"
. S:$L(GMDIAC)&($L(GMDSM))&(GMDIAC=GMDSM) GMDIAS="(ICD/DSM "_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_") (ICD-9-CM "_GMDIAC_")"
. E I $L(GMDIAC)&$S($L(GMSCT):1,$L(GMVHAT):1,1:0) D
. . S GMDIAS=$S($L(GMSCT):"(SCT ",1:"(VHAT ")_GMSCT_") (ICD-CM "_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(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=GMICD_"; "_NARR S NARR=""
. . I +SNO S GMICD=GMICD_" ("_SNO_")"
. 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
. D QUAL
. 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
QUAL ;Qualifiers ae displayed if there are any
N GMR,NODE,DATE,X,UCNT,CNT,CMT,T,I S LOC="",CNT=0
S (CNT,UCNT)=0
S GMR=0 F S GMR=$O(^TMP("GMPLHS",$J,GMREC,"Q",GMR)) Q:+GMR'>0 D Q:$D(GMTSQIT)
. S UCNT=1
. S NODE=$G(^TMP("GMPLHS",$J,GMREC,"Q",GMR)) Q:NODE']""
. S CMT=$P(NODE,U) I $L($G(CMT)) D LC2
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
LC2 ; List Comments (unnumbered and numbered)
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")
GMTSPLST ; SLC/JER,KER,TC - Problem List ;23-Jan-2014 10:31;DU
+1 ;;2.7;Health Summary;**28,35,52,86,1006**;Oct 20, 1995;Build 3
+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 ;
+24 ; ^TMP("GMPLHS",$J,#,#,"ICD9") Other multiple mapped ICD-CM codes
+25 ; ^TMP("GMPLHS",$J,#,"L") Lexicon Term
+26 ; ^TMP("GMPLHS",$J,#,"N") Provider Narrative
+27 ; ^TMP("GMPLHS",$J,#,"C",LOC,#,0)) Comments
+28 ;
+29 NEW GMREC,GMTSICL,GMTAB,LINE1,DIWL,GMTSTXTF,EXT,SNO
+30 SET GMTSICL=32
SET DIWL=0
SET GMTAB=0
SET GMREC=0
SET GMTSTXTF=0
+31 FOR
SET GMREC=$ORDER(^TMP("GMPLHS",$JOB,GMREC))
IF GMREC'>0
QUIT
Begin DoDot:1
+32 NEW GMNODE,GMDIAG,GMDIAC,GMDIAT,GMDIAS,LASTMDT,STAT,ONSETDT,PROV,SERV,GMSCT,GMVHAT
+33 NEW RESDT,NARR,GMICD,GMDSM,GMDSMS,CODE,LEXI,LEX,PLIFN,ADDINFO,EXP,GMTSX,X,GMDIAC,GMDIAT
+34 SET (GMDIAC,GMDIAT)=""
+35 SET GMNODE=$GET(^TMP("GMPLHS",$JOB,GMREC,0))
+36 IF GMNODE']""
QUIT
+37 SET GMDIAG=$PIECE(GMNODE,U)
SET LASTMDT=$PIECE(GMNODE,U,2)
SET STAT=$PIECE(GMNODE,U,5)
+38 SET X=LASTMDT
DO REGDT4^GMTSU
SET LASTMDT=X
+39 SET ONSETDT=$PIECE(GMNODE,U,6)
SET PROV=$PIECE(GMNODE,U,7)
+40 SET RESDT=$PIECE(GMNODE,U,10)
SET GMICD=""
SET GMSCT=$PIECE(GMNODE,U,15)
SET GMVHAT=$PIECE(GMNODE,U,19)
+41 SET EXP=$PIECE(GMNODE,U,14)
IF $LENGTH(EXP)
SET EXP=" ("_EXP_")"
+42 IF STAT="A"
IF +ONSETDT
SET X=ONSETDT
DO REGDT4^GMTSU
SET ADDINFO="Onset "_X
+43 IF STAT="I"
IF +RESDT
SET X=RESDT
DO REGDT4^GMTSU
SET ADDINFO="Resolved "_X
+44 SET GMPXICDF=$$UP($GET(GMPXICDF))
+45 SET GMTSTXTF=$SELECT(($GET(GMPXICDF)="T")!($GET(GMPXICDF)["TEXT ONLY"):1,1:0)
+46 IF $GET(GMPXICDF)]""
IF ($GET(GMPXICDF)'="N")!($GET(GMPXICDF)["NONE")
IF GMDIAG]""
Begin DoDot:2
+47 DO GETICDDX^GMTSPXU1(.GMDIAG,$GET(GMPXICDF))
SET GMICD=GMDIAG
End DoDot:2
+48 IF $GET(GMTSTXTF)=0
SET GMDIAC=$PIECE($GET(GMICD),"-",1)
SET GMDIAT=$PIECE($GET(GMICD),"-",2,299)
+49 SET LEX=$GET(^TMP("GMPLHS",$JOB,GMREC,"L"))
+50 SET SNO=$GET(^TMP("GMPLHS",$JOB,GMREC,"S"))
+51 SET NARR=""
+52 IF $GET(GMPXNARR)'="N"!(LEX["Unresolved")
SET NARR=$GET(^TMP("GMPLHS",$JOB,GMREC,"N"))
+53 SET LEXI=+LEX
SET LEX=$PIECE(LEX,"^",2)
IF $$UP(LEX)["UNRESOLVED"!(+LEXI'>1)
SET (LEXI,LEX)=""
+54 SET (CODE,GMDIAS,GMDSMS,GMDSM)=""
IF +LEXI>0
SET GMDSM=$$DSMONE^LEXU(+LEXI)
+55 IF GMDIAC["799.9"
SET GMDSM=""
+56 IF $LENGTH(GMDSM)>2&(GMDSM'[".")
SET GMDSM=GMDSM_"."
+57 IF $LENGTH(GMDIAC)
SET GMDIAS="(ICD-CM "_GMDIAC_")"
+58 IF $LENGTH(GMDSM)
SET GMDSMS="(DSM "_GMDSM_")"
+59 IF $LENGTH(GMDIAC)&($LENGTH(GMDSM))&(GMDIAC=GMDSM)
SET GMDIAS="(ICD/DSM "_GMDIAC_")"
SET GMDSMS=""
+60 IF $GET(^TMP("GMPLHS",$JOB,GMREC,0,"ICD9"))=""
Begin DoDot:2
+61 IF $LENGTH(GMDIAC)&$SELECT($LENGTH(GMSCT)
SET GMDIAS=$SELECT($LENGTH(GMSCT):"(SCT ",1:"(VHAT ")_GMSCT_") (ICD-9-CM "_GMDIAC_")"
End DoDot:2
+62 IF '$TEST
IF $LENGTH(GMDIAC)&$SELECT($LENGTH(GMSCT):1,$LENGTH(GMVHAT):1,1:0)
Begin DoDot:2
+63 SET GMDIAS=$SELECT($LENGTH(GMSCT):"(SCT ",1:"(VHAT ")_GMSCT_") (ICD-CM "_GMDIAC
+64 NEW T
SET T=0
FOR
SET T=$ORDER(^TMP("GMPLHS",$JOB,GMREC,T))
IF '+T
QUIT
Begin DoDot:3
+65 SET GMDIAS=GMDIAS_"/"_$PIECE($GET(^TMP("GMPLHS",$JOB,GMREC,T,"ICD9")),U,1)
End DoDot:3
+66 SET GMDIAS=GMDIAS_")"
End DoDot:2
+67 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))
+68 ;S:$L(GMDIAT)&($L(CODE)) GMICD=GMDIAT_" "_CODE
+69 ; Unresolved or Unspecified
+70 IF GMDIAC["799.9"
IF $LENGTH($GET(NARR))
Begin DoDot:2
+71 NEW UNARR
SET UNARR=$$UP(NARR)
+72 IF UNARR["UNKNOWN AND UNSPECIFIED"!(UNARR["UNKNOWN OR UNSPECIFIED")!(UNARR["MORBIDITY OR MORTALITY")
Begin DoDot:3
+73 SET GMICD=GMDIAT_" "_CODE
SET NARR=""
End DoDot:3
QUIT
+74 SET GMICD=$$UP($EXTRACT(NARR,1))_$EXTRACT(NARR,2,$LENGTH(NARR))_" "_CODE
+75 IF $LENGTH(LEX)
SET GMICD=LEX
SET NARR=""
End DoDot:2
+76 ; Specified by Lexicon
+77 ;I GMDIAC'["799.9",$L($G(LEX)) D
+78 ;. S GMICD=LEX,NARR=""
+79 ; Specified by Provider Narrative
+80 IF GMDIAC'["799.9"
IF '$LENGTH($GET(LEX))
Begin DoDot:2
+81 IF $LENGTH(NARR)&($$UP(GMDIAT)'=$$UP(NARR))
SET GMICD=GMICD_"; "_NARR
SET NARR=""
+82 IF +SNO
SET GMICD=GMICD_" ("_SNO_")"
End DoDot:2
+83 IF $GET(IOST)["P-"&(EXP["MST")
SET EXT=$$RM(EXP)
+84 IF $LENGTH(GMICD)&($LENGTH(EXP))
SET GMICD=GMICD_EXP
+85 IF $LENGTH(GMICD)
SET GMICD=GMICD_$SELECT($GET(ADDINFO)]"":", "_ADDINFO,1:"")
SET NARR=""
+86 SET GMICD=$$RF(GMICD)
+87 DO TXTFMT^GMTSPXU1(GMICD,$GET(NARR),GMTSICL,GMTAB,DIWL)
+88 IF '$DATA(^UTILITY($JOB,"W"))
QUIT
+89 SET GMTSX=0
SET LINE1=1
+90 FOR
SET GMTSX=$ORDER(^UTILITY($JOB,"W",DIWL,GMTSX))
IF GMTSX'>0!$DATA(GMTSQIT)
QUIT
Begin DoDot:2
+91 IF LINE1
DO L1
IF 'LINE1
DO LN
SET LINE1=0
End DoDot:2
+92 DO DC
+93 DO QUAL
+94 KILL ^UTILITY($JOB,"W")
+95 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
IF GMTSNPG
DO SUBHDR2
WRITE !
End DoDot:1
IF $DATA(GMTSQIT)
QUIT
+96 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
QUAL ;Qualifiers ae displayed if there are any
+1 NEW GMR,NODE,DATE,X,UCNT,CNT,CMT,T,I
SET LOC=""
SET CNT=0
+2 SET (CNT,UCNT)=0
+3 SET GMR=0
FOR
SET GMR=$ORDER(^TMP("GMPLHS",$JOB,GMREC,"Q",GMR))
IF +GMR'>0
QUIT
Begin DoDot:1
+4 SET UCNT=1
+5 SET NODE=$GET(^TMP("GMPLHS",$JOB,GMREC,"Q",GMR))
IF NODE']""
QUIT
+6 SET CMT=$PIECE(NODE,U)
IF $LENGTH($GET(CMT))
DO LC2
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
LC2 ; List Comments (unnumbered and numbered)
+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")
