GMPLDISP ; ISL/MKB,JER,TC - Problem List detailed display ;08/26/14 11:57
;;2.0;Problem List;**21,26,35,36,42,45**;Aug 25, 1994;Build 53
;
; External References
; DBIA 3106 ^DIC(49
; ICR 5699 $$ICDDATA^ICDXCODE
; ICR 5747 $$CSI/SAB/CODECS^ICDEX
; DBIA 10040 ^SC( file 44
; DBIA 10060 ^VA(200
; DBIA 10116 $$SETSTR^VALM1
; DBIA 10117 CLEAN^VALM10
; DBIA 10117 CNTRL^VALM10
; DBIA 10103 $$FMTE^XLFDT
; DBIA 10103 $$HTFM^XLFDT
; DBIA 10104 $$REPEAT^XLFSTR
;
EN ; Init Variables (need GMPLSEL,GMPLNO) and List Array
G:'$D(GMPLSEL) ERROR G:'$G(GMPLNO) ERROR
S GMPI=+$G(GMPI)+1 I GMPI>GMPLNO D Q
. W !!,"There are no more problems that have been selected to view!",! S VALMBCK="" H 2
S GMPLNUM=$P(GMPLSEL,",",GMPI) G:GMPLNUM'>0 ERROR
S GMPIFN=$P($G(^TMP("GMPLIDX",$J,+GMPLNUM)),U,2) G:GMPIFN'>0 ERROR
W !!,"Retrieving current data for problem #"_GMPLNUM_" ...",!
;
PROB ; Display problem GMPIFN
N LINE,STR,I,J,L,TEXT,NOTE,GMPLDT,GMPL0,GMPL1,GMPL800,GMPL803,X,Y,IDT,FAC,AIFN,SP,LCNT
N NIFN,SCTC,SCTD,SCTT,PROVNAR,ICDDESC,DESCR,ICD,PNTXT,GMPLCSYS,GMICDLBL,GMPL802,GMPLNTDT,GMPLATHR,GMPLTEXT
K ^TMP("GMPLCMT",$J)
G:'$G(GMPIFN) ERROR D CLEAN^VALM10
S GMPL0=$G(^AUPNPROB(GMPIFN,0)),GMPL1=$G(^(1)),GMPL800=$G(^(800)),GMPL802=$G(^(802)),GMPL803=$G(^(803,0)),LCNT=1,SP=""
S GMPLDT=$S(+$P(GMPL802,U,1):$P(GMPL802,U,1),+$P(GMPL1,U,9):$P(GMPL1,U,9),+$P(GMPL0,U,8):$P(GMPL0,U,8),1:DT)
S GMPLCSYS=$S($P(GMPL802,U,2)]"":$P(GMPL802,U,2),1:$$SAB^ICDEX($$CSI^ICDEX(80,+GMPL0),GMPLDT))
F I=11,12,13,15,16,17,18 S:+$P(GMPL1,U,I) SP=SP_$S(I=11:"AGENT ORANGE",I=12:"RADIATION",I=13:"ENV CONTAMINANTS",I=15:"HEAD/NECK CANCER",I=16:"MIL SEXUAL TRAUMA",I=17:"COMBAT VET",1:"SHAD")_U
F Q:$E(SP,$L(SP))'="^" S SP=$E(SP,1,($L(SP)-1))
S ICD=$P($$ICDDATA^ICDXCODE(GMPLCSYS,+GMPL0,GMPLDT,"I"),U,2) ;ICD=ICD-9/10-CM Code
S GMICDLBL=$P($$CODECS^ICDEX(ICD,80,GMPLDT),U,2)
S PROVNAR=$$PROBTEXT^GMPLX(GMPIFN) ;PROVNAR=Provider Narrative
S ICDDESC=$$ICDDESC^GMPLUTL2($G(ICD),GMPLDT,GMPLCSYS) ;ICDDESC=ICD Description
S SCTC=$P(GMPL800,U),SCTD=$P(GMPL800,U,2) ;SCTC=SNOMED-CT Concept Code,SCTD=SNOMED-CT Designation Code
S:(PROVNAR["SCT") PNTXT=$P(PROVNAR," (SCT")
D WRAP^GMPLX($G(PROVNAR),65,.TEXT)
I TEXT=1 S GMPDT(LCNT,0)=" Problem: "_TEXT(1)
E I TEXT>1 D
. S GMPDT(LCNT,0)=" Problem: "_TEXT(1)
. F I=2:1:TEXT S LCNT=LCNT+1,GMPDT(LCNT,0)=$S($L($G(SCTC))!$L($G(SCTD)):" ",1:" ")_TEXT(I)
I $L($G(SCTC)) S SCTT=$P($$SCTTEXT^GMPLUTL2(SCTC,$P(GMPL0,U,8),"SCT"),U) ;SCTT=SNOMED-CT Preferred Text
I $L($G(SCTC))!$L($G(SCTD)) D
. I ($L($G(SCTT))>0)&(PNTXT'=$G(SCTT)) D
. . D WRAP^GMPLX($G(SCTT),65,.SCTTTXT) S LCNT=LCNT+1,GMPDT(LCNT,0)="SNOMED-CT: "_SCTTTXT(1)
. . I SCTTTXT>1 F L=2:1:SCTTTXT S LCNT=LCNT+1,GMPDT(LCNT,0)=" "_SCTTTXT(L)
. I $L($G(ICD)) S LCNT=LCNT+1,GMPDT(LCNT,0)=$S(GMPLCSYS="ICD":" ",1:"")_$G(GMICDLBL)_": "_$G(ICD)_" ["_$G(ICDDESC)_"]"
E D
. D WRAP^GMPLX($G(ICDDESC),65,.DESCR) S LCNT=LCNT+1,GMPDT(LCNT,0)=$G(GMICDLBL)_" TEXT: "_DESCR(1)
. I DESCR>1 F J=2:1:DESCR S LCNT=LCNT+1,GMPDT(LCNT,0)=" "_DESCR(J)
I $L($G(GMPL803))>0 D
. N DA S DA=0 F S DA=$O(^AUPNPROB(GMPIFN,803,DA)) Q:'+DA D
. . N ICDN,ICDNDX,ICDNDT,ICDNCSYS S ICDN=$P($G(^AUPNPROB(GMPIFN,803,DA,0)),U),ICDNDT=$P($G(^AUPNPROB(GMPIFN,803,DA,0)),U,3)
. . S ICDNCSYS=$S($P($G(^AUPNPROB(GMPIFN,803,DA,0)),U,2)="ICD9":"ICD",1:$P($G(^AUPNPROB(GMPIFN,803,DA,0)),U,2))
. . S ICDNDX=$$ICDDESC^GMPLUTL2($G(ICDN),$G(ICDNDT),$G(ICDNCSYS))
. . S LCNT=LCNT+1,GMPDT(LCNT,0)=" : "_$G(ICDN)_$$PAD^GMPLX(ICDN,6)_" ["_$G(ICDNDX)_"]"
S LCNT=LCNT+1,GMPDT(LCNT,0)=" "
PR1 ; Onset
; SC Condition
; Status
; Exposure
; Provider
; Service/Clinic
S LINE=" Onset: "_$S($P(GMPL0,U,13):$$EXTDT^GMPLX($P(GMPL0,U,13)),1:"date unknown"),STR=""
S:GMPVA STR="SC Condition: "_$S(+$P(GMPL1,U,10):"YES",$P(GMPL1,U,10)=0:"NO",1:"unknown")
S LINE=$$SETSTR^VALM1(STR,LINE,49,30),LCNT=LCNT+1,GMPDT(LCNT,0)=LINE
S X=$P(GMPL0,U,12),LINE=" Status: "_$S(X="A":"ACTIVE",1:"INACTIVE")
I X="A",$L($P(GMPL1,U,14)) S LINE=LINE_"/"_$S($P(GMPL1,U,14)="A":"ACUTE",1:"CHRONIC")
I X="I",$P(GMPL1,U,7) S LINE=LINE_", Resolved "_$$EXTDT^GMPLX($P(GMPL1,U,7))
S STR="",LCNT=LCNT+1
S:GMPVA STR=" Exposure: "_$S('$L(SP):"none",1:$P(SP,U))
S LINE=$$SETSTR^VALM1(STR,LINE,49,30),GMPDT(LCNT,0)=LINE
S LINE=" Provider: "_$P($G(^VA(200,+$P(GMPL1,U,5),0)),U),LCNT=LCNT+1,STR=""
I GMPVA,$L(SP,U)>1 S STR=$P(SP,U,2)
S LINE=$$SETSTR^VALM1(STR,LINE,63,16),GMPDT(LCNT,0)=LINE
I $E(GMPLVIEW("VIEW"))="S" S LINE=" Service: "_$P($G(^DIC(49,+$P(GMPL1,U,6),0)),U)
E S LINE=" Clinic: "_$P($G(^SC(+$P(GMPL1,U,8),0)),U)
S LCNT=LCNT+1,STR="" I GMPVA,$L(SP,U)>2 S STR=$P(SP,U,3)
S LINE=$$SETSTR^VALM1(STR,LINE,63,16),GMPDT(LCNT,0)=LINE
S LCNT=LCNT+1,GMPDT(LCNT,0)=" "
PR2 ; Recorded
; Entered
S LINE=" Recorded: "_$S($P(GMPL1,U,9):$$EXTDT^GMPLX($P(GMPL1,U,9)),1:"date unknown")
S:$P(GMPL1,U,4) LINE=LINE_", by "_$P($G(^VA(200,+$P(GMPL1,U,4),0)),U)
S LCNT=LCNT+1,GMPDT(LCNT,0)=LINE
S LINE=" Entered: "_$$EXTDT^GMPLX($P(GMPL0,U,8))
S LINE=LINE_", by "_$P($G(^VA(200,+$P(GMPL1,U,3),0)),U),LCNT=LCNT+1
S:GMPARAM("VER")&($P(GMPL1,U,2)="T") LINE=LINE_" <unconfirmed>"
S GMPDT(LCNT,0)=LINE
S LCNT=LCNT+1,GMPDT(LCNT,0)=" "
PR3 ; Comments
S LCNT=LCNT+1,GMPDT(LCNT,0)="Comments:"
D CNTRL^VALM10(LCNT,1,8,IOUON,IOUOFF)
; By Facility
F FAC=0:0 S FAC=$O(^AUPNPROB(GMPIFN,11,FAC)) Q:+FAC'>0 D
. I 'FAC S LCNT=LCNT+1,GMPDT(LCNT,0)=" <None>" G PR4
. F NIFN=0:0 S NIFN=$O(^AUPNPROB(GMPIFN,11,FAC,11,NIFN)) Q:+NIFN'>0 D
. . S NOTE=$G(^AUPNPROB(GMPIFN,11,FAC,11,NIFN,0)) Q:NOTE=""
. . S GMPLNTDT=$P(NOTE,U,5),GMPLATHR=$P(NOTE,U,6),GMPLTEXT=$P(NOTE,U,3)
. . I $L(NOTE) S ^TMP("GMPLCMT",$J,GMPLNTDT,NIFN)=$$EXTDT^GMPLX(GMPLNTDT)_U_$P($G(^VA(200,+GMPLATHR,0)),U)_U_GMPLTEXT
S (GMPLNTDT,NIFN)=""
F S GMPLNTDT=$O(^TMP("GMPLCMT",$J,GMPLNTDT),-1) Q:GMPLNTDT="" D
. F S NIFN=$O(^TMP("GMPLCMT",$J,GMPLNTDT,NIFN),-1) Q:NIFN="" D
. . S LINE=$J($P($G(^TMP("GMPLCMT",$J,GMPLNTDT,NIFN)),U,1),10)_": "_$P($G(^TMP("GMPLCMT",$J,GMPLNTDT,NIFN)),U,3)
. . S LCNT=LCNT+1,GMPDT(LCNT,0)=LINE
. . I $L($G(^TMP("GMPLCMT",$J,GMPLNTDT,NIFN))) S LINE=" "_$P($G(^TMP("GMPLCMT",$J,GMPLNTDT,NIFN)),U,2),LCNT=LCNT+1,GMPDT(LCNT,0)=LINE
S:'($G(NOTE)) LCNT=LCNT+1,GMPDT(LCNT,0)=" <None>"
K ^TMP("GMPLCMT",$J)
PR4 ; Audit Trail
S LCNT=LCNT+1,GMPDT(LCNT,0)=" "
S LCNT=LCNT+1,GMPDT(LCNT,0)="History:"
D CNTRL^VALM10(LCNT,1,7,IOUON,IOUOFF)
I '$D(^GMPL(125.8,"B",GMPIFN)) S LCNT=LCNT+1,GMPDT(LCNT,0)=" <No changes>" G PRQ
F IDT=0:0 S IDT=$O(^GMPL(125.8,"AD",GMPIFN,IDT)) Q:IDT'>0 D
. F AIFN=0:0 S AIFN=$O(^GMPL(125.8,"AD",GMPIFN,IDT,AIFN)) Q:AIFN'>0 D
. . N FLD,GMPL0 S GMPL0=^GMPL(125.8,AIFN,0),FLD=$P(GMPL0,U,2)
. . Q:(FLD=80201)!(FLD=80202)!(FLD=80002)
. . D DT^GMPLHIST
PRQ ; Header Node
S VALMCNT=LCNT,GMPDT(0)=VALMCNT,VALMSG=$$MSG^GMPLX,VALMBG=1,VALMBCK="R"
Q
;
HDR ; Header Code (uses GMPDFN, GMPIFN)
N LASTMOD,PAT S PAT=$P(GMPDFN,U,2)_" ("_$P(GMPDFN,U,3)_")"
S LASTMOD=$S($G(GMPIFN):$P(^AUPNPROB(GMPIFN,0),U,3),1:$E($$HTFM^XLFDT($H),1,12))
S LASTMOD="Last Updated: "_$$FMTE^XLFDT(LASTMOD)
S VALMHDR(1)=PAT_$$REPEAT^XLFSTR(" ",(79-$L(PAT)-$L(LASTMOD)))_LASTMOD
Q
;
HELP ; Help Code
N X W !!?4,"You may view detailed information here on this problem;"
W !?4,"more data may be available by entering 'Next Screen'."
W !?4,"If you have selected multiple problems to view, you may"
W !?4,"enter 'Continue to Next Selected Problem'; to return to"
W !?4,"the patient's problem list, enter 'Quit to Problem List'."
W !!,"Press <return> to continue ... " R X:DTIME
S VALMSG=$$MSG^GMPLX,VALMBCK=$S(VALMCC:"",1:"R")
Q
;
DEFLT() ; Default Action, using GMPI and GMPLNO
I GMPI<GMPLNO Q "Continue to Next Selected Problem"
Q "Quit to Problem List"
;
ERROR ; Error Message - drop into EXIT
W !!,"ERROR -- Cannot continue ... Returning to Problem List.",!
S VALMBCK="Q" H 1
EXIT ; Exit Code
K GMPDT Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMPLDISP 8164 printed Dec 13, 2024@02:29:55 Page 2
GMPLDISP ; ISL/MKB,JER,TC - Problem List detailed display ;08/26/14 11:57
+1 ;;2.0;Problem List;**21,26,35,36,42,45**;Aug 25, 1994;Build 53
+2 ;
+3 ; External References
+4 ; DBIA 3106 ^DIC(49
+5 ; ICR 5699 $$ICDDATA^ICDXCODE
+6 ; ICR 5747 $$CSI/SAB/CODECS^ICDEX
+7 ; DBIA 10040 ^SC( file 44
+8 ; DBIA 10060 ^VA(200
+9 ; DBIA 10116 $$SETSTR^VALM1
+10 ; DBIA 10117 CLEAN^VALM10
+11 ; DBIA 10117 CNTRL^VALM10
+12 ; DBIA 10103 $$FMTE^XLFDT
+13 ; DBIA 10103 $$HTFM^XLFDT
+14 ; DBIA 10104 $$REPEAT^XLFSTR
+15 ;
EN ; Init Variables (need GMPLSEL,GMPLNO) and List Array
+1 if '$DATA(GMPLSEL)
GOTO ERROR
if '$GET(GMPLNO)
GOTO ERROR
+2 SET GMPI=+$GET(GMPI)+1
IF GMPI>GMPLNO
Begin DoDot:1
+3 WRITE !!,"There are no more problems that have been selected to view!",!
SET VALMBCK=""
HANG 2
End DoDot:1
QUIT
+4 SET GMPLNUM=$PIECE(GMPLSEL,",",GMPI)
if GMPLNUM'>0
GOTO ERROR
+5 SET GMPIFN=$PIECE($GET(^TMP("GMPLIDX",$JOB,+GMPLNUM)),U,2)
if GMPIFN'>0
GOTO ERROR
+6 WRITE !!,"Retrieving current data for problem #"_GMPLNUM_" ...",!
+7 ;
PROB ; Display problem GMPIFN
+1 NEW LINE,STR,I,J,L,TEXT,NOTE,GMPLDT,GMPL0,GMPL1,GMPL800,GMPL803,X,Y,IDT,FAC,AIFN,SP,LCNT
+2 NEW NIFN,SCTC,SCTD,SCTT,PROVNAR,ICDDESC,DESCR,ICD,PNTXT,GMPLCSYS,GMICDLBL,GMPL802,GMPLNTDT,GMPLATHR,GMPLTEXT
+3 KILL ^TMP("GMPLCMT",$JOB)
+4 if '$GET(GMPIFN)
GOTO ERROR
DO CLEAN^VALM10
+5 SET GMPL0=$GET(^AUPNPROB(GMPIFN,0))
SET GMPL1=$GET(^(1))
SET GMPL800=$GET(^(800))
SET GMPL802=$GET(^(802))
SET GMPL803=$GET(^(803,0))
SET LCNT=1
SET SP=""
+6 SET GMPLDT=$SELECT(+$PIECE(GMPL802,U,1):$PIECE(GMPL802,U,1),+$PIECE(GMPL1,U,9):$PIECE(GMPL1,U,9),+$PIECE(GMPL0,U,8):$PIECE(GMPL0,U,8),1:DT)
+7 SET GMPLCSYS=$SELECT($PIECE(GMPL802,U,2)]"":$PIECE(GMPL802,U,2),1:$$SAB^ICDEX($$CSI^ICDEX(80,+GMPL0),GMPLDT))
+8 FOR I=11,12,13,15,16,17,18
if +$PIECE(GMPL1,U,I)
SET SP=SP_$SELECT(I=11:"AGENT ORANGE",I=12:"RADIATION",I=13:"ENV CONTAMINANTS",I=15:"HEAD/NECK CANCER",I=16:"MIL SEXUAL TRAUMA",I=17:"COMBAT VET",1:"SHAD")_U
+9 FOR
if $EXTRACT(SP,$LENGTH(SP))'="^"
QUIT
SET SP=$EXTRACT(SP,1,($LENGTH(SP)-1))
+10 ;ICD=ICD-9/10-CM Code
SET ICD=$PIECE($$ICDDATA^ICDXCODE(GMPLCSYS,+GMPL0,GMPLDT,"I"),U,2)
+11 SET GMICDLBL=$PIECE($$CODECS^ICDEX(ICD,80,GMPLDT),U,2)
+12 ;PROVNAR=Provider Narrative
SET PROVNAR=$$PROBTEXT^GMPLX(GMPIFN)
+13 ;ICDDESC=ICD Description
SET ICDDESC=$$ICDDESC^GMPLUTL2($GET(ICD),GMPLDT,GMPLCSYS)
+14 ;SCTC=SNOMED-CT Concept Code,SCTD=SNOMED-CT Designation Code
SET SCTC=$PIECE(GMPL800,U)
SET SCTD=$PIECE(GMPL800,U,2)
+15 if (PROVNAR["SCT")
SET PNTXT=$PIECE(PROVNAR," (SCT")
+16 DO WRAP^GMPLX($GET(PROVNAR),65,.TEXT)
+17 IF TEXT=1
SET GMPDT(LCNT,0)=" Problem: "_TEXT(1)
+18 IF '$TEST
IF TEXT>1
Begin DoDot:1
+19 SET GMPDT(LCNT,0)=" Problem: "_TEXT(1)
+20 FOR I=2:1:TEXT
SET LCNT=LCNT+1
SET GMPDT(LCNT,0)=$SELECT($LENGTH($GET(SCTC))!$LENGTH($GET(SCTD)):" ",1:" ")_TEXT(I)
End DoDot:1
+21 ;SCTT=SNOMED-CT Preferred Text
IF $LENGTH($GET(SCTC))
SET SCTT=$PIECE($$SCTTEXT^GMPLUTL2(SCTC,$PIECE(GMPL0,U,8),"SCT"),U)
+22 IF $LENGTH($GET(SCTC))!$LENGTH($GET(SCTD))
Begin DoDot:1
+23 IF ($LENGTH($GET(SCTT))>0)&(PNTXT'=$GET(SCTT))
Begin DoDot:2
+24 DO WRAP^GMPLX($GET(SCTT),65,.SCTTTXT)
SET LCNT=LCNT+1
SET GMPDT(LCNT,0)="SNOMED-CT: "_SCTTTXT(1)
+25 IF SCTTTXT>1
FOR L=2:1:SCTTTXT
SET LCNT=LCNT+1
SET GMPDT(LCNT,0)=" "_SCTTTXT(L)
End DoDot:2
+26 IF $LENGTH($GET(ICD))
SET LCNT=LCNT+1
SET GMPDT(LCNT,0)=$SELECT(GMPLCSYS="ICD":" ",1:"")_$GET(GMICDLBL)_": "_$GET(ICD)_" ["_$GET(ICDDESC)_"]"
End DoDot:1
+27 IF '$TEST
Begin DoDot:1
+28 DO WRAP^GMPLX($GET(ICDDESC),65,.DESCR)
SET LCNT=LCNT+1
SET GMPDT(LCNT,0)=$GET(GMICDLBL)_" TEXT: "_DESCR(1)
+29 IF DESCR>1
FOR J=2:1:DESCR
SET LCNT=LCNT+1
SET GMPDT(LCNT,0)=" "_DESCR(J)
End DoDot:1
+30 IF $LENGTH($GET(GMPL803))>0
Begin DoDot:1
+31 NEW DA
SET DA=0
FOR
SET DA=$ORDER(^AUPNPROB(GMPIFN,803,DA))
if '+DA
QUIT
Begin DoDot:2
+32 NEW ICDN,ICDNDX,ICDNDT,ICDNCSYS
SET ICDN=$PIECE($GET(^AUPNPROB(GMPIFN,803,DA,0)),U)
SET ICDNDT=$PIECE($GET(^AUPNPROB(GMPIFN,803,DA,0)),U,3)
+33 SET ICDNCSYS=$SELECT($PIECE($GET(^AUPNPROB(GMPIFN,803,DA,0)),U,2)="ICD9":"ICD",1:$PIECE($GET(^AUPNPROB(GMPIFN,803,DA,0)),U,2))
+34 SET ICDNDX=$$ICDDESC^GMPLUTL2($GET(ICDN),$GET(ICDNDT),$GET(ICDNCSYS))
+35 SET LCNT=LCNT+1
SET GMPDT(LCNT,0)=" : "_$GET(ICDN)_$$PAD^GMPLX(ICDN,6)_" ["_$GET(ICDNDX)_"]"
End DoDot:2
End DoDot:1
+36 SET LCNT=LCNT+1
SET GMPDT(LCNT,0)=" "
PR1 ; Onset
+1 ; SC Condition
+2 ; Status
+3 ; Exposure
+4 ; Provider
+5 ; Service/Clinic
+6 SET LINE=" Onset: "_$SELECT($PIECE(GMPL0,U,13):$$EXTDT^GMPLX($PIECE(GMPL0,U,13)),1:"date unknown")
SET STR=""
+7 if GMPVA
SET STR="SC Condition: "_$SELECT(+$PIECE(GMPL1,U,10):"YES",$PIECE(GMPL1,U,10)=0:"NO",1:"unknown")
+8 SET LINE=$$SETSTR^VALM1(STR,LINE,49,30)
SET LCNT=LCNT+1
SET GMPDT(LCNT,0)=LINE
+9 SET X=$PIECE(GMPL0,U,12)
SET LINE=" Status: "_$SELECT(X="A":"ACTIVE",1:"INACTIVE")
+10 IF X="A"
IF $LENGTH($PIECE(GMPL1,U,14))
SET LINE=LINE_"/"_$SELECT($PIECE(GMPL1,U,14)="A":"ACUTE",1:"CHRONIC")
+11 IF X="I"
IF $PIECE(GMPL1,U,7)
SET LINE=LINE_", Resolved "_$$EXTDT^GMPLX($PIECE(GMPL1,U,7))
+12 SET STR=""
SET LCNT=LCNT+1
+13 if GMPVA
SET STR=" Exposure: "_$SELECT('$LENGTH(SP):"none",1:$PIECE(SP,U))
+14 SET LINE=$$SETSTR^VALM1(STR,LINE,49,30)
SET GMPDT(LCNT,0)=LINE
+15 SET LINE=" Provider: "_$PIECE($GET(^VA(200,+$PIECE(GMPL1,U,5),0)),U)
SET LCNT=LCNT+1
SET STR=""
+16 IF GMPVA
IF $LENGTH(SP,U)>1
SET STR=$PIECE(SP,U,2)
+17 SET LINE=$$SETSTR^VALM1(STR,LINE,63,16)
SET GMPDT(LCNT,0)=LINE
+18 IF $EXTRACT(GMPLVIEW("VIEW"))="S"
SET LINE=" Service: "_$PIECE($GET(^DIC(49,+$PIECE(GMPL1,U,6),0)),U)
+19 IF '$TEST
SET LINE=" Clinic: "_$PIECE($GET(^SC(+$PIECE(GMPL1,U,8),0)),U)
+20 SET LCNT=LCNT+1
SET STR=""
IF GMPVA
IF $LENGTH(SP,U)>2
SET STR=$PIECE(SP,U,3)
+21 SET LINE=$$SETSTR^VALM1(STR,LINE,63,16)
SET GMPDT(LCNT,0)=LINE
+22 SET LCNT=LCNT+1
SET GMPDT(LCNT,0)=" "
PR2 ; Recorded
+1 ; Entered
+2 SET LINE=" Recorded: "_$SELECT($PIECE(GMPL1,U,9):$$EXTDT^GMPLX($PIECE(GMPL1,U,9)),1:"date unknown")
+3 if $PIECE(GMPL1,U,4)
SET LINE=LINE_", by "_$PIECE($GET(^VA(200,+$PIECE(GMPL1,U,4),0)),U)
+4 SET LCNT=LCNT+1
SET GMPDT(LCNT,0)=LINE
+5 SET LINE=" Entered: "_$$EXTDT^GMPLX($PIECE(GMPL0,U,8))
+6 SET LINE=LINE_", by "_$PIECE($GET(^VA(200,+$PIECE(GMPL1,U,3),0)),U)
SET LCNT=LCNT+1
+7 if GMPARAM("VER")&($PIECE(GMPL1,U,2)="T")
SET LINE=LINE_" <unconfirmed>"
+8 SET GMPDT(LCNT,0)=LINE
+9 SET LCNT=LCNT+1
SET GMPDT(LCNT,0)=" "
PR3 ; Comments
+1 SET LCNT=LCNT+1
SET GMPDT(LCNT,0)="Comments:"
+2 DO CNTRL^VALM10(LCNT,1,8,IOUON,IOUOFF)
+3 ; By Facility
+4 FOR FAC=0:0
SET FAC=$ORDER(^AUPNPROB(GMPIFN,11,FAC))
if +FAC'>0
QUIT
Begin DoDot:1
+5 IF 'FAC
SET LCNT=LCNT+1
SET GMPDT(LCNT,0)=" <None>"
GOTO PR4
+6 FOR NIFN=0:0
SET NIFN=$ORDER(^AUPNPROB(GMPIFN,11,FAC,11,NIFN))
if +NIFN'>0
QUIT
Begin DoDot:2
+7 SET NOTE=$GET(^AUPNPROB(GMPIFN,11,FAC,11,NIFN,0))
if NOTE=""
QUIT
+8 SET GMPLNTDT=$PIECE(NOTE,U,5)
SET GMPLATHR=$PIECE(NOTE,U,6)
SET GMPLTEXT=$PIECE(NOTE,U,3)
+9 IF $LENGTH(NOTE)
SET ^TMP("GMPLCMT",$JOB,GMPLNTDT,NIFN)=$$EXTDT^GMPLX(GMPLNTDT)_U_$PIECE($GET(^VA(200,+GMPLATHR,0)),U)_U_GMPLTEXT
End DoDot:2
End DoDot:1
+10 SET (GMPLNTDT,NIFN)=""
+11 FOR
SET GMPLNTDT=$ORDER(^TMP("GMPLCMT",$JOB,GMPLNTDT),-1)
if GMPLNTDT=""
QUIT
Begin DoDot:1
+12 FOR
SET NIFN=$ORDER(^TMP("GMPLCMT",$JOB,GMPLNTDT,NIFN),-1)
if NIFN=""
QUIT
Begin DoDot:2
+13 SET LINE=$JUSTIFY($PIECE($GET(^TMP("GMPLCMT",$JOB,GMPLNTDT,NIFN)),U,1),10)_": "_$PIECE($GET(^TMP("GMPLCMT",$JOB,GMPLNTDT,NIFN)),U,3)
+14 SET LCNT=LCNT+1
SET GMPDT(LCNT,0)=LINE
+15 IF $LENGTH($GET(^TMP("GMPLCMT",$JOB,GMPLNTDT,NIFN)))
SET LINE=" "_$PIECE($GET(^TMP("GMPLCMT",$JOB,GMPLNTDT,NIFN)),U,2)
SET LCNT=LCNT+1
SET GMPDT(LCNT,0)=LINE
End DoDot:2
End DoDot:1
+16 if '($GET(NOTE))
SET LCNT=LCNT+1
SET GMPDT(LCNT,0)=" <None>"
+17 KILL ^TMP("GMPLCMT",$JOB)
PR4 ; Audit Trail
+1 SET LCNT=LCNT+1
SET GMPDT(LCNT,0)=" "
+2 SET LCNT=LCNT+1
SET GMPDT(LCNT,0)="History:"
+3 DO CNTRL^VALM10(LCNT,1,7,IOUON,IOUOFF)
+4 IF '$DATA(^GMPL(125.8,"B",GMPIFN))
SET LCNT=LCNT+1
SET GMPDT(LCNT,0)=" <No changes>"
GOTO PRQ
+5 FOR IDT=0:0
SET IDT=$ORDER(^GMPL(125.8,"AD",GMPIFN,IDT))
if IDT'>0
QUIT
Begin DoDot:1
+6 FOR AIFN=0:0
SET AIFN=$ORDER(^GMPL(125.8,"AD",GMPIFN,IDT,AIFN))
if AIFN'>0
QUIT
Begin DoDot:2
+7 NEW FLD,GMPL0
SET GMPL0=^GMPL(125.8,AIFN,0)
SET FLD=$PIECE(GMPL0,U,2)
+8 if (FLD=80201)!(FLD=80202)!(FLD=80002)
QUIT
+9 DO DT^GMPLHIST
End DoDot:2
End DoDot:1
PRQ ; Header Node
+1 SET VALMCNT=LCNT
SET GMPDT(0)=VALMCNT
SET VALMSG=$$MSG^GMPLX
SET VALMBG=1
SET VALMBCK="R"
+2 QUIT
+3 ;
HDR ; Header Code (uses GMPDFN, GMPIFN)
+1 NEW LASTMOD,PAT
SET PAT=$PIECE(GMPDFN,U,2)_" ("_$PIECE(GMPDFN,U,3)_")"
+2 SET LASTMOD=$SELECT($GET(GMPIFN):$PIECE(^AUPNPROB(GMPIFN,0),U,3),1:$EXTRACT($$HTFM^XLFDT($HOROLOG),1,12))
+3 SET LASTMOD="Last Updated: "_$$FMTE^XLFDT(LASTMOD)
+4 SET VALMHDR(1)=PAT_$$REPEAT^XLFSTR(" ",(79-$LENGTH(PAT)-$LENGTH(LASTMOD)))_LASTMOD
+5 QUIT
+6 ;
HELP ; Help Code
+1 NEW X
WRITE !!?4,"You may view detailed information here on this problem;"
+2 WRITE !?4,"more data may be available by entering 'Next Screen'."
+3 WRITE !?4,"If you have selected multiple problems to view, you may"
+4 WRITE !?4,"enter 'Continue to Next Selected Problem'; to return to"
+5 WRITE !?4,"the patient's problem list, enter 'Quit to Problem List'."
+6 WRITE !!,"Press <return> to continue ... "
READ X:DTIME
+7 SET VALMSG=$$MSG^GMPLX
SET VALMBCK=$SELECT(VALMCC:"",1:"R")
+8 QUIT
+9 ;
DEFLT() ; Default Action, using GMPI and GMPLNO
+1 IF GMPI<GMPLNO
QUIT "Continue to Next Selected Problem"
+2 QUIT "Quit to Problem List"
+3 ;
ERROR ; Error Message - drop into EXIT
+1 WRITE !!,"ERROR -- Cannot continue ... Returning to Problem List.",!
+2 SET VALMBCK="Q"
HANG 1
EXIT ; Exit Code
+1 KILL GMPDT
QUIT
