- GMPLMGR2 ; ISL/MKB,KER,AJB - Problem List VALM Utilities cont ;08/17/12 16:55
- ;;2.0;Problem List;**26,28,36**;Aug 25, 1994;Build 65
- ;
- ; External References
- ; DBIA 3990 $$ICDDX^ICDCODE
- ; DBIA 872 ^ORD(101
- ; DBIA 10026 ^DIR
- ; DBIA 10116 $$SETFLD^VALM1
- ; DBIA 10116 CLEAR^VALM1
- ; DBIA 10140 EN^XQORM
- ;
- BLDPROB(IFN) ; Build Line for Problem in List
- ; Input INF Pointer to Problem file 9000011
- ; Expects GMPCOUNT
- N GMPL0,GMPL1,GMPL800,RESOLVED,TEXT,I,LINE,STR,SC,SP,ICD,ONSET,PROBLEM,STATUS,SCTC
- Q:'$D(GMPCOUNT) S GMPL0=$G(^AUPNPROB(IFN,0)),GMPL1=$G(^(1)),GMPL800=$G(^(800)) Q:'$L(GMPL0)
- S ICD=$P($$ICDDX^ICDCODE(+GMPL0),U,2),SCTC=$P(GMPL800,U)
- S SC=$P(GMPL1,U,10),SP=$P(GMPL1,U,11,13)_"^"_$P(GMPL1,U,15,16),STATUS=$P(GMPL0,U,12)
- S:$P(GMPL1,U,2)="H" PROBLEM="< DELETED >" I $P(GMPL1,U,2)'="H" D
- . S PROBLEM=$$PROBTEXT^GMPLX(IFN),ONSET=$P(GMPL0,U,13)
- . I ONSET S PROBLEM=PROBLEM_", Onset "_$$EXTDT^GMPLX(ONSET)
- S RESOLVED=$J($$EXTDT^GMPLX($P(GMPL1,U,7)),8)
- S GMPCOUNT=GMPCOUNT+1
- D WRAP^GMPLX(PROBLEM,40,.TEXT)
- S LINE=$$SETFLD^VALM1(GMPCOUNT,"","NUMBER")
- ; added for Code Set Versioning (CSV) - checks ICD code - # if inactive
- I '$$CODESTS^GMPLX(IFN,DT) D
- . I STATUS="A" S LINE=$$SETFLD^VALM1(" #",LINE,"STATUS")
- . I STATUS="I" S LINE=$$SETFLD^VALM1(STATUS_"#",LINE,"STATUS")
- E S:STATUS="I" LINE=$$SETFLD^VALM1(STATUS,LINE,"STATUS")
- ; S:STATUS="I" LINE=$$SETFLD^VALM1(STATUS,LINE,"STATUS")
- S LINE=$$SETFLD^VALM1(TEXT(1),LINE,"PROBLEM")
- S LINE=$$SETFLD^VALM1(ICD,LINE,"ICD")
- I $L(SC) D
- . S STR=$S(+SC:"YES",SC=0:"NO",1:" ")
- . S LINE=$$SETFLD^VALM1(STR,LINE,"SERV CONNECTED")
- I $L(SP) D
- . S STR=$S(+$P(SP,U):"Agent Orange",+$P(SP,U,2):"Radiation",+$P(SP,U,3):"Contaminants",+$P(SP,U,4):"Head/Neck Cancer",+$P(SP,U,5):"Mil Sexual Trauma",1:"")
- . S LINE=$$SETFLD^VALM1(STR,LINE,"EXPOSURE")
- S LINE=$$SETFLD^VALM1(RESOLVED,LINE,"RESOLVED")
- S VALMCNT=VALMCNT+1,^TMP("GMPL",$J,VALMCNT,0)=LINE
- S ^TMP("GMPLIDX",$J,GMPCOUNT)=VALMCNT_U_IFN
- I TEXT>1 F I=2:1:TEXT D
- . S LINE="",LINE=$$SETFLD^VALM1(TEXT(I),LINE,"PROBLEM")
- . S VALMCNT=VALMCNT+1,^TMP("GMPL",$J,VALMCNT,0)=LINE
- Q
- ;
- HELP ; Help Code
- N X W !!?4,"You may take a variety of actions from this prompt. To update"
- W !?4,"the problem list select from Add, Remove, Edit, Inactivate,"
- W !?4,"and Enter Comment; you will then be prompted for the problem"
- W !?4,"number. To see all of this patient's problems, both active and"
- W !?4,"inactive, select Show All Problems; select Print to print the"
- W !?4,"same complete list in a chartable format. To see a listing of"
- W !?4,"actions that facilitate navigating the list, enter '??'."
- W !!,"Press <return> to continue ... " R X:DTIME
- S VALMSG=$$MSG^GMPLX,VALMBCK=$S(VALMCC:"",1:"R")
- Q
- ;
- EXIT ; Exit Code
- I GMPARAM("PRT"),$D(GMPRINT) D AUTO
- K ^TMP("GMPL",$J),^TMP("GMPLIDX",$J)
- K XQORM("KEY","="),XQORM("XLATE")
- K GMPDFN,GMPROV,GMPLVIEW,GMPARAM,VALMBCK,VALMHDR,VALMCNT,GMPCOUNT,GMPLUSER,GMPSC,VALMSG,GMPVAMC,GMPLIST,GMPAGTOR,GMPION,GMPGULF,GMPVA,GMPTOTAL,GMPRINT,AUPNSEX,GMPCLIN
- Q
- ;
- AUTO ; Print Problem List when Exiting Patient?
- ; Called from EXIT,NEWPAT^GMPLMGR1
- N DIR,X,Y,DUOUT,DTOUT Q:'GMPARAM("PRT") Q:'$D(GMPRINT)
- S DIR(0)="YA",DIR("A")="Print a new problem list? ",DIR("B")="YES"
- S DIR("?",1)="Press <return> to generate a new complete problem list for this patient;",DIR("?")="enter NO to continue without printing."
- W $C(7),!!,">>> THIS PATIENT'S PROBLEM LIST HAS CHANGED!"
- D ^DIR I $D(DTOUT)!($D(DTOUT)) S GMPQUIT=1 Q
- Q:'Y D VAF^GMPLPRNT,DEVICE^GMPLPRNT G:$D(GMPQUIT) AUTQ
- D CLEAR^VALM1,PRT^GMPLPRNT
- AUTQ ; Quit Auto-Print
- D KILL^GMPLX
- Q
- ;
- SHOW ; Show Current View of List
- N VIEW,NUM,NAME S VIEW=$E(GMPLVIEW("VIEW")),NUM=$L(GMPLVIEW("VIEW"),"/")
- W !!,"CURRENT VIEW: "_$S(VIEW="S":"Inpatient, ",1:"Outpatient, ")
- I '((NUM>2)!($L(GMPLVIEW("ACT")))!(GMPLVIEW("PROV"))) W "all problems" Q
- W $S(GMPLVIEW("ACT")="A":"active",GMPLVIEW("ACT")="I":"inactive",1:"all")_" problems"
- I NUM>2 W " from "_$S(GMPLVIEW("VIEW")=$$VIEW^GMPLX1(DUZ):"preferred",1:"selected")_$S(VIEW="S":" services",1:" clinics")
- I GMPLVIEW("PROV") S NAME=$$NAME^GMPLX1(GMPLVIEW("PROV")) W:($X+$L(NAME)+4>80) ! W " by "_NAME
- Q
- ;
- ENVIEW ; Entry Action to Display Appropriate View Menu
- N XQORM,X,Y,GMPLX S GMPLX=0 D SHOW S X="GMPL VIEW "_$S($E(GMPLVIEW("VIEW"))="S":"INPAT",1:"OUTPAT")
- S XQORM=+$O(^ORD(101,"B",X,0))_";ORD(101,",XQORM(0)="3AD"
- W !,"You may change your view of this patient's problem list by selecting one or",!,"more of the following attributes to alter:",!
- D EN^XQORM F S GMPLX=$O(Y(GMPLX)) Q:GMPLX'>0 X:$D(^ORD(101,+$P(Y(GMPLX),U,2),20)) ^(20)
- Q
- ;
- EXVIEW ; Exit Action to Rebuild List w/New View
- S VALMBCK=$S(VALMCC:"",1:"R") I '$D(GMPQUIT),$G(GMPREBLD) D
- . S VALMBG=1,VALMBCK="R" D GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW)
- . D BUILD^GMPLMGR(.GMPLIST),HDR^GMPLMGR
- K GMPQUIT,GMPREBLD S VALMSG=$$MSG^GMPLX
- Q
- GMPLMGR2 ; ISL/MKB,KER,AJB - Problem List VALM Utilities cont ;08/17/12 16:55
- +1 ;;2.0;Problem List;**26,28,36**;Aug 25, 1994;Build 65
- +2 ;
- +3 ; External References
- +4 ; DBIA 3990 $$ICDDX^ICDCODE
- +5 ; DBIA 872 ^ORD(101
- +6 ; DBIA 10026 ^DIR
- +7 ; DBIA 10116 $$SETFLD^VALM1
- +8 ; DBIA 10116 CLEAR^VALM1
- +9 ; DBIA 10140 EN^XQORM
- +10 ;
- BLDPROB(IFN) ; Build Line for Problem in List
- +1 ; Input INF Pointer to Problem file 9000011
- +2 ; Expects GMPCOUNT
- +3 NEW GMPL0,GMPL1,GMPL800,RESOLVED,TEXT,I,LINE,STR,SC,SP,ICD,ONSET,PROBLEM,STATUS,SCTC
- +4 IF '$DATA(GMPCOUNT)
- QUIT
- SET GMPL0=$GET(^AUPNPROB(IFN,0))
- SET GMPL1=$GET(^(1))
- SET GMPL800=$GET(^(800))
- IF '$LENGTH(GMPL0)
- QUIT
- +5 SET ICD=$PIECE($$ICDDX^ICDCODE(+GMPL0),U,2)
- SET SCTC=$PIECE(GMPL800,U)
- +6 SET SC=$PIECE(GMPL1,U,10)
- SET SP=$PIECE(GMPL1,U,11,13)_"^"_$PIECE(GMPL1,U,15,16)
- SET STATUS=$PIECE(GMPL0,U,12)
- +7 IF $PIECE(GMPL1,U,2)="H"
- SET PROBLEM="< DELETED >"
- IF $PIECE(GMPL1,U,2)'="H"
- Begin DoDot:1
- +8 SET PROBLEM=$$PROBTEXT^GMPLX(IFN)
- SET ONSET=$PIECE(GMPL0,U,13)
- +9 IF ONSET
- SET PROBLEM=PROBLEM_", Onset "_$$EXTDT^GMPLX(ONSET)
- End DoDot:1
- +10 SET RESOLVED=$JUSTIFY($$EXTDT^GMPLX($PIECE(GMPL1,U,7)),8)
- +11 SET GMPCOUNT=GMPCOUNT+1
- +12 DO WRAP^GMPLX(PROBLEM,40,.TEXT)
- +13 SET LINE=$$SETFLD^VALM1(GMPCOUNT,"","NUMBER")
- +14 ; added for Code Set Versioning (CSV) - checks ICD code - # if inactive
- +15 IF '$$CODESTS^GMPLX(IFN,DT)
- Begin DoDot:1
- +16 IF STATUS="A"
- SET LINE=$$SETFLD^VALM1(" #",LINE,"STATUS")
- +17 IF STATUS="I"
- SET LINE=$$SETFLD^VALM1(STATUS_"#",LINE,"STATUS")
- End DoDot:1
- +18 IF '$TEST
- IF STATUS="I"
- SET LINE=$$SETFLD^VALM1(STATUS,LINE,"STATUS")
- +19 ; S:STATUS="I" LINE=$$SETFLD^VALM1(STATUS,LINE,"STATUS")
- +20 SET LINE=$$SETFLD^VALM1(TEXT(1),LINE,"PROBLEM")
- +21 SET LINE=$$SETFLD^VALM1(ICD,LINE,"ICD")
- +22 IF $LENGTH(SC)
- Begin DoDot:1
- +23 SET STR=$SELECT(+SC:"YES",SC=0:"NO",1:" ")
- +24 SET LINE=$$SETFLD^VALM1(STR,LINE,"SERV CONNECTED")
- End DoDot:1
- +25 IF $LENGTH(SP)
- Begin DoDot:1
- +26 SET STR=$SELECT(+$PIECE(SP,U):"Agent Orange",+$PIECE(SP,U,2):"Radiation",+$PIECE(SP,U,3):"Contaminants",+$PIECE(SP,U,4):"Head/Neck Cancer",+$PIECE(SP,U,5):"Mil Sexual Trauma",1:"")
- +27 SET LINE=$$SETFLD^VALM1(STR,LINE,"EXPOSURE")
- End DoDot:1
- +28 SET LINE=$$SETFLD^VALM1(RESOLVED,LINE,"RESOLVED")
- +29 SET VALMCNT=VALMCNT+1
- SET ^TMP("GMPL",$JOB,VALMCNT,0)=LINE
- +30 SET ^TMP("GMPLIDX",$JOB,GMPCOUNT)=VALMCNT_U_IFN
- +31 IF TEXT>1
- FOR I=2:1:TEXT
- Begin DoDot:1
- +32 SET LINE=""
- SET LINE=$$SETFLD^VALM1(TEXT(I),LINE,"PROBLEM")
- +33 SET VALMCNT=VALMCNT+1
- SET ^TMP("GMPL",$JOB,VALMCNT,0)=LINE
- End DoDot:1
- +34 QUIT
- +35 ;
- HELP ; Help Code
- +1 NEW X
- WRITE !!?4,"You may take a variety of actions from this prompt. To update"
- +2 WRITE !?4,"the problem list select from Add, Remove, Edit, Inactivate,"
- +3 WRITE !?4,"and Enter Comment; you will then be prompted for the problem"
- +4 WRITE !?4,"number. To see all of this patient's problems, both active and"
- +5 WRITE !?4,"inactive, select Show All Problems; select Print to print the"
- +6 WRITE !?4,"same complete list in a chartable format. To see a listing of"
- +7 WRITE !?4,"actions that facilitate navigating the list, enter '??'."
- +8 WRITE !!,"Press <return> to continue ... "
- READ X:DTIME
- +9 SET VALMSG=$$MSG^GMPLX
- SET VALMBCK=$SELECT(VALMCC:"",1:"R")
- +10 QUIT
- +11 ;
- EXIT ; Exit Code
- +1 IF GMPARAM("PRT")
- IF $DATA(GMPRINT)
- DO AUTO
- +2 KILL ^TMP("GMPL",$JOB),^TMP("GMPLIDX",$JOB)
- +3 KILL XQORM("KEY","="),XQORM("XLATE")
- +4 KILL GMPDFN,GMPROV,GMPLVIEW,GMPARAM,VALMBCK,VALMHDR,VALMCNT,GMPCOUNT,GMPLUSER,GMPSC,VALMSG,GMPVAMC,GMPLIST,GMPAGTOR,GMPION,GMPGULF,GMPVA,GMPTOTAL,GMPRINT,AUPNSEX,GMPCLIN
- +5 QUIT
- +6 ;
- AUTO ; Print Problem List when Exiting Patient?
- +1 ; Called from EXIT,NEWPAT^GMPLMGR1
- +2 NEW DIR,X,Y,DUOUT,DTOUT
- IF 'GMPARAM("PRT")
- QUIT
- IF '$DATA(GMPRINT)
- QUIT
- +3 SET DIR(0)="YA"
- SET DIR("A")="Print a new problem list? "
- SET DIR("B")="YES"
- +4 SET DIR("?",1)="Press <return> to generate a new complete problem list for this patient;"
- SET DIR("?")="enter NO to continue without printing."
- +5 WRITE $CHAR(7),!!,">>> THIS PATIENT'S PROBLEM LIST HAS CHANGED!"
- +6 DO ^DIR
- IF $DATA(DTOUT)!($DATA(DTOUT))
- SET GMPQUIT=1
- QUIT
- +7 IF 'Y
- QUIT
- DO VAF^GMPLPRNT
- DO DEVICE^GMPLPRNT
- IF $DATA(GMPQUIT)
- GOTO AUTQ
- +8 DO CLEAR^VALM1
- DO PRT^GMPLPRNT
- AUTQ ; Quit Auto-Print
- +1 DO KILL^GMPLX
- +2 QUIT
- +3 ;
- SHOW ; Show Current View of List
- +1 NEW VIEW,NUM,NAME
- SET VIEW=$EXTRACT(GMPLVIEW("VIEW"))
- SET NUM=$LENGTH(GMPLVIEW("VIEW"),"/")
- +2 WRITE !!,"CURRENT VIEW: "_$SELECT(VIEW="S":"Inpatient, ",1:"Outpatient, ")
- +3 IF '((NUM>2)!($LENGTH(GMPLVIEW("ACT")))!(GMPLVIEW("PROV")))
- WRITE "all problems"
- QUIT
- +4 WRITE $SELECT(GMPLVIEW("ACT")="A":"active",GMPLVIEW("ACT")="I":"inactive",1:"all")_" problems"
- +5 IF NUM>2
- WRITE " from "_$SELECT(GMPLVIEW("VIEW")=$$VIEW^GMPLX1(DUZ):"preferred",1:"selected")_$SELECT(VIEW="S":" services",1:" clinics")
- +6 IF GMPLVIEW("PROV")
- SET NAME=$$NAME^GMPLX1(GMPLVIEW("PROV"))
- IF ($X+$LENGTH(NAME)+4>80)
- WRITE !
- WRITE " by "_NAME
- +7 QUIT
- +8 ;
- ENVIEW ; Entry Action to Display Appropriate View Menu
- +1 NEW XQORM,X,Y,GMPLX
- SET GMPLX=0
- DO SHOW
- SET X="GMPL VIEW "_$SELECT($EXTRACT(GMPLVIEW("VIEW"))="S":"INPAT",1:"OUTPAT")
- +2 SET XQORM=+$ORDER(^ORD(101,"B",X,0))_";ORD(101,"
- SET XQORM(0)="3AD"
- +3 WRITE !,"You may change your view of this patient's problem list by selecting one or",!,"more of the following attributes to alter:",!
- +4 DO EN^XQORM
- FOR
- SET GMPLX=$ORDER(Y(GMPLX))
- IF GMPLX'>0
- QUIT
- IF $DATA(^ORD(101,+$PIECE(Y(GMPLX),U,2),20))
- XECUTE ^(20)
- +5 QUIT
- +6 ;
- EXVIEW ; Exit Action to Rebuild List w/New View
- +1 SET VALMBCK=$SELECT(VALMCC:"",1:"R")
- IF '$DATA(GMPQUIT)
- IF $GET(GMPREBLD)
- Begin DoDot:1
- +2 SET VALMBG=1
- SET VALMBCK="R"
- DO GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW)
- +3 DO BUILD^GMPLMGR(.GMPLIST)
- DO HDR^GMPLMGR
- End DoDot:1
- +4 KILL GMPQUIT,GMPREBLD
- SET VALMSG=$$MSG^GMPLX
- +5 QUIT