GMPLDISP ; ISL/MKB,JER,TC - Problem List detailed display ;06/08/12 15:10
;;2.0;Problem List;**21,26,35,36**;Aug 25, 1994;Build 65
;
; External References
; DBIA 3106 ^DIC(49
; DBIA 3990 $$ICDDX^ICDCODE
; 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
G:'$G(GMPIFN) ERROR D CLEAN^VALM10
S GMPL0=$G(^AUPNPROB(GMPIFN,0)),GMPL1=$G(^(1)),GMPL800=$G(^(800)),GMPL803=$G(^(803,0)),LCNT=1,SP=""
S GMPLDT=$S(+$P(GMPL1,U,9):$P(GMPL1,U,9),+$P(GMPL0,U,8):$P(GMPL0,U,8),1:DT)
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($$ICDDX^ICDCODE(+GMPL0),U,2) ;ICD=ICD-9-CM Code
S PROVNAR=$$PROBTEXT^GMPLX(GMPIFN) ;PROVNAR=Provider Narrative
S ICDDESC=$$ICDDESC^GMPLUTL2($G(ICD),$P(GMPL0,U,8)) ;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=$$SCTTEXT^GMPLUTL2(SCTC,$P(GMPL0,U,8)) ;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)=" ICD-9-CM: "_$G(ICD)_" ["_$G(ICDDESC)_"]"
E D
. D WRAP^GMPLX($G(ICDDESC),65,.DESCR) S LCNT=LCNT+1,GMPDT(LCNT,0)="ICD-9-CM 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 S ICDN=$P($G(^AUPNPROB(GMPIFN,803,DA,0)),U),ICDNDX=$$ICDDESC^GMPLUTL2($G(ICDN))
. . 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
; Provider Narrative
; ICD code
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 LINE=$J($$EXTDT^GMPLX($P(NOTE,U,5)),10)_": "_$P(NOTE,U,3)
. . S LCNT=LCNT+1,GMPDT(LCNT,0)=LINE
. . I $P(NOTE,U,6) S LINE=" "_$P($G(^VA(200,+$P(NOTE,U,6),0)),U),LCNT=LCNT+1,GMPDT(LCNT,0)=LINE
S:'($G(NOTE)) LCNT=LCNT+1,GMPDT(LCNT,0)=" <None>"
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 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
GMPLDISP ; ISL/MKB,JER,TC - Problem List detailed display ;06/08/12 15:10
+1 ;;2.0;Problem List;**21,26,35,36**;Aug 25, 1994;Build 65
+2 ;
+3 ; External References
+4 ; DBIA 3106 ^DIC(49
+5 ; DBIA 3990 $$ICDDX^ICDCODE
+6 ; DBIA 10040 ^SC( file 44
+7 ; DBIA 10060 ^VA(200
+8 ; DBIA 10116 $$SETSTR^VALM1
+9 ; DBIA 10117 CLEAN^VALM10
+10 ; DBIA 10117 CNTRL^VALM10
+11 ; DBIA 10103 $$FMTE^XLFDT
+12 ; DBIA 10103 $$HTFM^XLFDT
+13 ; DBIA 10104 $$REPEAT^XLFSTR
+14 ;
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
+3 IF '$GET(GMPIFN)
GOTO ERROR
DO CLEAN^VALM10
+4 SET GMPL0=$GET(^AUPNPROB(GMPIFN,0))
SET GMPL1=$GET(^(1))
SET GMPL800=$GET(^(800))
SET GMPL803=$GET(^(803,0))
SET LCNT=1
SET SP=""
+5 SET GMPLDT=$SELECT(+$PIECE(GMPL1,U,9):$PIECE(GMPL1,U,9),+$PIECE(GMPL0,U,8):$PIECE(GMPL0,U,8),1:DT)
+6 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
+7 FOR
IF $EXTRACT(SP,$LENGTH(SP))'="^"
QUIT
SET SP=$EXTRACT(SP,1,($LENGTH(SP)-1))
+8 ;ICD=ICD-9-CM Code
SET ICD=$PIECE($$ICDDX^ICDCODE(+GMPL0),U,2)
+9 ;PROVNAR=Provider Narrative
SET PROVNAR=$$PROBTEXT^GMPLX(GMPIFN)
+10 ;ICDDESC=ICD Description
SET ICDDESC=$$ICDDESC^GMPLUTL2($GET(ICD),$PIECE(GMPL0,U,8))
+11 ;SCTC=SNOMED-CT Concept Code,SCTD=SNOMED-CT Designation Code
SET SCTC=$PIECE(GMPL800,U)
SET SCTD=$PIECE(GMPL800,U,2)
+12 IF (PROVNAR["SCT")
SET PNTXT=$PIECE(PROVNAR," (SCT")
+13 DO WRAP^GMPLX($GET(PROVNAR),65,.TEXT)
+14 IF TEXT=1
SET GMPDT(LCNT,0)=" Problem: "_TEXT(1)
+15 IF '$TEST
IF TEXT>1
Begin DoDot:1
+16 SET GMPDT(LCNT,0)=" Problem: "_TEXT(1)
+17 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
+18 ;SCTT=SNOMED-CT Preferred Text
IF $LENGTH($GET(SCTC))
SET SCTT=$$SCTTEXT^GMPLUTL2(SCTC,$PIECE(GMPL0,U,8))
+19 IF $LENGTH($GET(SCTC))!$LENGTH($GET(SCTD))
Begin DoDot:1
+20 IF ($LENGTH($GET(SCTT))>0)&(PNTXT'=$GET(SCTT))
Begin DoDot:2
+21 DO WRAP^GMPLX($GET(SCTT),65,.SCTTTXT)
SET LCNT=LCNT+1
SET GMPDT(LCNT,0)="SNOMED-CT: "_SCTTTXT(1)
+22 IF SCTTTXT>1
FOR L=2:1:SCTTTXT
SET LCNT=LCNT+1
SET GMPDT(LCNT,0)=" "_SCTTTXT(L)
End DoDot:2
+23 IF $LENGTH($GET(ICD))
SET LCNT=LCNT+1
SET GMPDT(LCNT,0)=" ICD-9-CM: "_$GET(ICD)_" ["_$GET(ICDDESC)_"]"
End DoDot:1
+24 IF '$TEST
Begin DoDot:1
+25 DO WRAP^GMPLX($GET(ICDDESC),65,.DESCR)
SET LCNT=LCNT+1
SET GMPDT(LCNT,0)="ICD-9-CM TEXT: "_DESCR(1)
+26 IF DESCR>1
FOR J=2:1:DESCR
SET LCNT=LCNT+1
SET GMPDT(LCNT,0)=" "_DESCR(J)
End DoDot:1
+27 IF $LENGTH($GET(GMPL803))>0
Begin DoDot:1
+28 NEW DA
SET DA=0
FOR
SET DA=$ORDER(^AUPNPROB(GMPIFN,803,DA))
IF '+DA
QUIT
Begin DoDot:2
+29 NEW ICDN,ICDNDX
SET ICDN=$PIECE($GET(^AUPNPROB(GMPIFN,803,DA,0)),U)
SET ICDNDX=$$ICDDESC^GMPLUTL2($GET(ICDN))
+30 SET LCNT=LCNT+1
SET GMPDT(LCNT,0)=" : "_$GET(ICDN)_$$PAD^GMPLX(ICDN,6)_" ["_$GET(ICDNDX)_"]"
End DoDot:2
End DoDot:1
+31 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 ; Provider Narrative
+3 ; ICD code
+4 SET LINE=" Recorded: "_$SELECT($PIECE(GMPL1,U,9):$$EXTDT^GMPLX($PIECE(GMPL1,U,9)),1:"date unknown")
+5 IF $PIECE(GMPL1,U,4)
SET LINE=LINE_", by "_$PIECE($GET(^VA(200,+$PIECE(GMPL1,U,4),0)),U)
+6 SET LCNT=LCNT+1
SET GMPDT(LCNT,0)=LINE
+7 SET LINE=" Entered: "_$$EXTDT^GMPLX($PIECE(GMPL0,U,8))
+8 SET LINE=LINE_", by "_$PIECE($GET(^VA(200,+$PIECE(GMPL1,U,3),0)),U)
SET LCNT=LCNT+1
+9 IF GMPARAM("VER")&($PIECE(GMPL1,U,2)="T")
SET LINE=LINE_" <unconfirmed>"
+10 SET GMPDT(LCNT,0)=LINE
+11 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 LINE=$JUSTIFY($$EXTDT^GMPLX($PIECE(NOTE,U,5)),10)_": "_$PIECE(NOTE,U,3)
+9 SET LCNT=LCNT+1
SET GMPDT(LCNT,0)=LINE
+10 IF $PIECE(NOTE,U,6)
SET LINE=" "_$PIECE($GET(^VA(200,+$PIECE(NOTE,U,6),0)),U)
SET LCNT=LCNT+1
SET GMPDT(LCNT,0)=LINE
End DoDot:2
End DoDot:1
+11 IF '($GET(NOTE))
SET LCNT=LCNT+1
SET GMPDT(LCNT,0)=" <None>"
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
DO DT^GMPLHIST
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
