- 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 Apr 23, 2025@18:44:25 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
