GMPLMGR ; ISL/MKB,AJB,JER,TC - Problem List VALM Utilities ;01/17/2019
;;2.0;Problem List;**21,28,36,42,53**;Aug 25, 1994;Build 159
; 28 Feb 00 - MA added view comments accross Divisions
;
; External References
; ICR 5699 $$ICDDATA^ICDXCODE
; ICR 5747 $$CSI/SAB^ICDEX
;
INIT ; -- init variables, list array
S:'$G(GMPDFN) GMPDFN=$$PAT^GMPLX1 I +GMPDFN'>0 K GMPDFN S VALMQUIT=1 Q
S GMPROV=$$REQPROV^GMPLX1 I +GMPROV'>0 K GMPDFN,GMPROV S VALMQUIT=1 Q
IN1 S GMPVA=$S($G(DUZ("AG"))="V":1,1:0),GMPVAMC=+$G(DUZ(2))
S (GMPSC,GMPAGTOR,GMPION,GMPGULF,GMPMST,GMPHNC,GMPCV,GMPSHD)=0
D:GMPVA VADPT^GMPLX1(+GMPDFN) ;reset
S GMPLVIEW("ACT")="A",GMPLVIEW("PROV")=0
S GMPLVIEW("VIEW")=$$VIEW^GMPLX1(DUZ)
S X=$G(^GMPL(125.99,1,0)),GMPARAM("VER")=+$P(X,U,2),GMPARAM("PRT")=+$P(X,U,3),GMPARAM("CLU")=+$P(X,U,4),GMPARAM("REV")=$S($P(X,U,5)="R":1,1:0) K X
D GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW),BUILD(.GMPLIST)
D:$E(GMPLVIEW("VIEW"))="S" CHGCAP^VALM("CLINIC","Service/Provider")
S VALMSG=$$MSG^GMPLX
Q
;
BUILD(PLIST) ; -- build list array
N I D CLEAN^VALM10 K ^TMP("GMPLIDX",$J) S (I,GMPCOUNT,VALMCNT)=0
D:$D(XRTL) T0^%ZOSV ; Start RT Monitor
F S I=$O(PLIST(I)) Q:I'>0 D:$D(GMPLUSER) BLDPROB(+PLIST(I)) D:'$D(GMPLUSER) BLDPROB^GMPLMGR2(+PLIST(I))
S ^TMP("GMPL",$J,0)=+$G(GMPCOUNT)_U_+$G(VALMCNT) ; # entries^# lines
S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV ; Stop RT Monitor
I $G(GMPCOUNT)'>0 S ^TMP("GMPL",$J,1,0)=" ",^TMP("GMPL",$J,2,0)=" No data available meeting criteria."
Q
BLDPROB(IFN) ; Add problem line
N GMPL0,GMPL1,GMPL800,GMPL802,GMPDT,GMPCSYS,DATE,TEXT,NAME,LINE,ACTIVE,I,NOTE,FAC,PROBLEM,NIFN,DELETED,ICD,SCTC
S GMPL0=$G(^AUPNPROB(IFN,0)),GMPL1=$G(^(1)),GMPL800=$G(^(800)),GMPL802=$G(^(802)) Q:'$L(GMPL0)
S GMPDT=$S(+$P(GMPL802,U,1):$P(GMPL802,U,1),1:$P(GMPL0,U,8)),GMPCSYS=$S($P(GMPL802,U,2)]"":$P(GMPL802,U,2),1:$$SAB^ICDEX($$CSI^ICDEX(80,+GMPL0),GMPDT))
S ICD=$P($$ICDDATA^ICDXCODE(GMPCSYS,+GMPL0,GMPDT,"I"),U,2),SCTC=$P(GMPL800,U)
S DELETED=$S($P(GMPL1,U,2)="H":1,1:0) ; flag if prob was deleted
S ACTIVE=$P(GMPL0,U,12),DATE=$J($$EXTDT^GMPLX($P(GMPL0,U,3)),8)
S PROBLEM=$S(DELETED:"< DELETED >",1:$$PROBTEXT^GMPLX(IFN))
I ACTIVE="A",$P(GMPL0,U,13),'DELETED S PROBLEM=PROBLEM_", Onset "_$$EXTDT^GMPLX($P(GMPL0,U,13))
I ACTIVE="I",$P(GMPL1,U,7),'DELETED S PROBLEM=PROBLEM_", Resolved "_$$EXTDT^GMPLX($P(GMPL1,U,7))
D WRAP^GMPLX(PROBLEM,39,.TEXT) ; format text to 40 chr
I $E(GMPLVIEW("VIEW"))="S" S NAME=$$SERV^GMPLX1($P(GMPL1,U,6))_$$NAME^GMPLX1($P(GMPL1,U,5))
E S NAME=$P($G(^SC(+$P(GMPL1,U,8),0)),U)
BLD1 S GMPCOUNT=+$G(GMPCOUNT)+1
S LINE=$$SETFLD^VALM1(GMPCOUNT,"","NUMBER")
S:ACTIVE="A" ACTIVE=$S($P(GMPL1,U,14)="A":"*",1:"") ; reset for priority
S LINE=$$SETFLD^VALM1(ACTIVE,LINE,"STATUS")
S LINE=$$SETFLD^VALM1(TEXT(1),LINE,"PROBLEM")
S LINE=$$SETFLD^VALM1(DATE,LINE,"DATE")
S LINE=$$SETFLD^VALM1(NAME,LINE,"CLINIC"),VALMCNT=+$G(VALMCNT)+1
S ^TMP("GMPL",$J,VALMCNT,0)=LINE,^TMP("GMPL",$J,"IDX",VALMCNT,GMPCOUNT)=""
S ^TMP("GMPLIDX",$J,GMPCOUNT)=VALMCNT_U_IFN
I GMPARAM("VER"),$P(GMPL1,U,2)="T",'DELETED S LINE=$E(LINE,1,4)_"$"_$E(LINE,6,79),^TMP("GMPL",$J,VALMCNT,0)=LINE D CNTRL^VALM10(VALMCNT,5,1,IOINHI,IOINORM)
; added for Code Set Versioning (CSV) - annotates inactive ICD code with #
I '$$CODESTS^GMPLX(IFN,DT) S LINE=$E(LINE,1,4)_"#"_$E(LINE,6,79),^TMP("GMPL",$J,VALMCNT,0)=LINE D CNTRL^VALM10(VALMCNT,5,1,IOINHI,IOINORM)
Q:DELETED
BLD2 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
. S ^TMP("GMPL",$J,"IDX",VALMCNT,GMPCOUNT)=""
;Q:'$D(^AUPNPROB(IFN,11,"B",+GMPVAMC)) ; display current user's notes
; Routine has been changed to show all Problem List Comments for
; Divisions per Clinical Workgroup decision 26 Jan 2000
F FAC=0:0 S FAC=$O(^AUPNPROB(IFN,11,FAC)) Q:+FAC'>0 D
. F NIFN=0:0 S NIFN=$O(^AUPNPROB(IFN,11,FAC,11,NIFN)) Q:+NIFN'>0 D
. . S NOTE=$P($G(^AUPNPROB(IFN,11,FAC,11,NIFN,0)),U,3)
. . S VALMCNT=VALMCNT+1,^TMP("GMPL",$J,"IDX",VALMCNT,GMPCOUNT)=""
. . S ^TMP("GMPL",$J,VALMCNT,0)=" "_NOTE
Q
;
HDR ; -- header code
N HDR,LNM,FNM,PAT,NUM
S PAT=$P(GMPDFN,U,2)_" ("_$P(GMPDFN,U,3)_")"
S NUM=GMPCOUNT S:GMPTOTAL>GMPCOUNT NUM=NUM_" of "_GMPTOTAL
S NUM=NUM_$S(GMPLVIEW("ACT")="A":" active",GMPLVIEW("ACT")="I":" inactive",1:"")_" problems"
S VALMHDR(1)=PAT_$J(NUM,79-$L(PAT))
S HDR=$S(GMPLVIEW("ACT")="I":"INACTIVE",GMPLVIEW("ACT")="A":"ACTIVE",1:"ALL")
I $L(GMPLVIEW("VIEW"))>2 S HDR=HDR_$S($E(GMPLVIEW("VIEW"))="S":" SERVICE",1:" CLINIC") ; screened
S HDR=HDR_" PROBLEMS"
S:GMPLVIEW("PROV") LNM=$P($P(GMPLVIEW("PROV"),U,2),","),FNM=$P($P(GMPLVIEW("PROV"),U,2),",",2),HDR=HDR_" BY "_FNM_" "_LNM
S VALMHDR(2)=$J(HDR,$L(HDR)\2+41)
Q
;
HELP ; -- help code
N X
W !!?4,"To update the problem list first select from Add, Remove, Edit,"
W !?4 W:GMPARAM("VER") "Verify, "
W "Inactivate, or Comment, then enter the problem number(s)."
W !?4,"If you need more information on a problem, select Detailed"
W !?4,"Display; to change whether all or only selected problems for this"
W !?4,"patient are listed, choose Select View. Enter ?? to see more"
W !?4,"actions for facilitating navigation of the list."
W !?4,"Problem statuses: *-Acute I-Inactive #-Inactive ICD Code"
W:GMPARAM("VER") " $-Unverified"
W !!,"Press <return> to continue ... " R X:DTIME
S VALMSG=$$MSG^GMPLX,VALMBCK=$S(VALMCC:"",1:"R")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMPLMGR 5523 printed Oct 16, 2024@18:30:49 Page 2
GMPLMGR ; ISL/MKB,AJB,JER,TC - Problem List VALM Utilities ;01/17/2019
+1 ;;2.0;Problem List;**21,28,36,42,53**;Aug 25, 1994;Build 159
+2 ; 28 Feb 00 - MA added view comments accross Divisions
+3 ;
+4 ; External References
+5 ; ICR 5699 $$ICDDATA^ICDXCODE
+6 ; ICR 5747 $$CSI/SAB^ICDEX
+7 ;
INIT ; -- init variables, list array
+1 if '$GET(GMPDFN)
SET GMPDFN=$$PAT^GMPLX1
IF +GMPDFN'>0
KILL GMPDFN
SET VALMQUIT=1
QUIT
+2 SET GMPROV=$$REQPROV^GMPLX1
IF +GMPROV'>0
KILL GMPDFN,GMPROV
SET VALMQUIT=1
QUIT
IN1 SET GMPVA=$SELECT($GET(DUZ("AG"))="V":1,1:0)
SET GMPVAMC=+$GET(DUZ(2))
+1 SET (GMPSC,GMPAGTOR,GMPION,GMPGULF,GMPMST,GMPHNC,GMPCV,GMPSHD)=0
+2 ;reset
if GMPVA
DO VADPT^GMPLX1(+GMPDFN)
+3 SET GMPLVIEW("ACT")="A"
SET GMPLVIEW("PROV")=0
+4 SET GMPLVIEW("VIEW")=$$VIEW^GMPLX1(DUZ)
+5 SET X=$GET(^GMPL(125.99,1,0))
SET GMPARAM("VER")=+$PIECE(X,U,2)
SET GMPARAM("PRT")=+$PIECE(X,U,3)
SET GMPARAM("CLU")=+$PIECE(X,U,4)
SET GMPARAM("REV")=$SELECT($PIECE(X,U,5)="R":1,1:0)
KILL X
+6 DO GETPLIST^GMPLMGR1(.GMPLIST,.GMPTOTAL,.GMPLVIEW)
DO BUILD(.GMPLIST)
+7 if $EXTRACT(GMPLVIEW("VIEW"))="S"
DO CHGCAP^VALM("CLINIC","Service/Provider")
+8 SET VALMSG=$$MSG^GMPLX
+9 QUIT
+10 ;
BUILD(PLIST) ; -- build list array
+1 NEW I
DO CLEAN^VALM10
KILL ^TMP("GMPLIDX",$JOB)
SET (I,GMPCOUNT,VALMCNT)=0
+2 ; Start RT Monitor
if $DATA(XRTL)
DO T0^%ZOSV
+3 FOR
SET I=$ORDER(PLIST(I))
if I'>0
QUIT
if $DATA(GMPLUSER)
DO BLDPROB(+PLIST(I))
if '$DATA(GMPLUSER)
DO BLDPROB^GMPLMGR2(+PLIST(I))
+4 ; # entries^# lines
SET ^TMP("GMPL",$JOB,0)=+$GET(GMPCOUNT)_U_+$GET(VALMCNT)
+5 ; Stop RT Monitor
if $DATA(XRT0)
SET XRTN=$TEXT(+0)
if $DATA(XRT0)
DO T1^%ZOSV
+6 IF $GET(GMPCOUNT)'>0
SET ^TMP("GMPL",$JOB,1,0)=" "
SET ^TMP("GMPL",$JOB,2,0)=" No data available meeting criteria."
+7 QUIT
BLDPROB(IFN) ; Add problem line
+1 NEW GMPL0,GMPL1,GMPL800,GMPL802,GMPDT,GMPCSYS,DATE,TEXT,NAME,LINE,ACTIVE,I,NOTE,FAC,PROBLEM,NIFN,DELETED,ICD,SCTC
+2 SET GMPL0=$GET(^AUPNPROB(IFN,0))
SET GMPL1=$GET(^(1))
SET GMPL800=$GET(^(800))
SET GMPL802=$GET(^(802))
if '$LENGTH(GMPL0)
QUIT
+3 SET GMPDT=$SELECT(+$PIECE(GMPL802,U,1):$PIECE(GMPL802,U,1),1:$PIECE(GMPL0,U,8))
SET GMPCSYS=$SELECT($PIECE(GMPL802,U,2)]"":$PIECE(GMPL802,U,2),1:$$SAB^ICDEX($$CSI^ICDEX(80,+GMPL0),GMPDT))
+4 SET ICD=$PIECE($$ICDDATA^ICDXCODE(GMPCSYS,+GMPL0,GMPDT,"I"),U,2)
SET SCTC=$PIECE(GMPL800,U)
+5 ; flag if prob was deleted
SET DELETED=$SELECT($PIECE(GMPL1,U,2)="H":1,1:0)
+6 SET ACTIVE=$PIECE(GMPL0,U,12)
SET DATE=$JUSTIFY($$EXTDT^GMPLX($PIECE(GMPL0,U,3)),8)
+7 SET PROBLEM=$SELECT(DELETED:"< DELETED >",1:$$PROBTEXT^GMPLX(IFN))
+8 IF ACTIVE="A"
IF $PIECE(GMPL0,U,13)
IF 'DELETED
SET PROBLEM=PROBLEM_", Onset "_$$EXTDT^GMPLX($PIECE(GMPL0,U,13))
+9 IF ACTIVE="I"
IF $PIECE(GMPL1,U,7)
IF 'DELETED
SET PROBLEM=PROBLEM_", Resolved "_$$EXTDT^GMPLX($PIECE(GMPL1,U,7))
+10 ; format text to 40 chr
DO WRAP^GMPLX(PROBLEM,39,.TEXT)
+11 IF $EXTRACT(GMPLVIEW("VIEW"))="S"
SET NAME=$$SERV^GMPLX1($PIECE(GMPL1,U,6))_$$NAME^GMPLX1($PIECE(GMPL1,U,5))
+12 IF '$TEST
SET NAME=$PIECE($GET(^SC(+$PIECE(GMPL1,U,8),0)),U)
BLD1 SET GMPCOUNT=+$GET(GMPCOUNT)+1
+1 SET LINE=$$SETFLD^VALM1(GMPCOUNT,"","NUMBER")
+2 ; reset for priority
if ACTIVE="A"
SET ACTIVE=$SELECT($PIECE(GMPL1,U,14)="A":"*",1:"")
+3 SET LINE=$$SETFLD^VALM1(ACTIVE,LINE,"STATUS")
+4 SET LINE=$$SETFLD^VALM1(TEXT(1),LINE,"PROBLEM")
+5 SET LINE=$$SETFLD^VALM1(DATE,LINE,"DATE")
+6 SET LINE=$$SETFLD^VALM1(NAME,LINE,"CLINIC")
SET VALMCNT=+$GET(VALMCNT)+1
+7 SET ^TMP("GMPL",$JOB,VALMCNT,0)=LINE
SET ^TMP("GMPL",$JOB,"IDX",VALMCNT,GMPCOUNT)=""
+8 SET ^TMP("GMPLIDX",$JOB,GMPCOUNT)=VALMCNT_U_IFN
+9 IF GMPARAM("VER")
IF $PIECE(GMPL1,U,2)="T"
IF 'DELETED
SET LINE=$EXTRACT(LINE,1,4)_"$"_$EXTRACT(LINE,6,79)
SET ^TMP("GMPL",$JOB,VALMCNT,0)=LINE
DO CNTRL^VALM10(VALMCNT,5,1,IOINHI,IOINORM)
+10 ; added for Code Set Versioning (CSV) - annotates inactive ICD code with #
+11 IF '$$CODESTS^GMPLX(IFN,DT)
SET LINE=$EXTRACT(LINE,1,4)_"#"_$EXTRACT(LINE,6,79)
SET ^TMP("GMPL",$JOB,VALMCNT,0)=LINE
DO CNTRL^VALM10(VALMCNT,5,1,IOINHI,IOINORM)
+12 if DELETED
QUIT
BLD2 IF TEXT>1
FOR I=2:1:TEXT
Begin DoDot:1
+1 SET LINE=""
SET LINE=$$SETFLD^VALM1(TEXT(I),LINE,"PROBLEM")
+2 SET VALMCNT=VALMCNT+1
SET ^TMP("GMPL",$JOB,VALMCNT,0)=LINE
+3 SET ^TMP("GMPL",$JOB,"IDX",VALMCNT,GMPCOUNT)=""
End DoDot:1
+4 ;Q:'$D(^AUPNPROB(IFN,11,"B",+GMPVAMC)) ; display current user's notes
+5 ; Routine has been changed to show all Problem List Comments for
+6 ; Divisions per Clinical Workgroup decision 26 Jan 2000
+7 FOR FAC=0:0
SET FAC=$ORDER(^AUPNPROB(IFN,11,FAC))
if +FAC'>0
QUIT
Begin DoDot:1
+8 FOR NIFN=0:0
SET NIFN=$ORDER(^AUPNPROB(IFN,11,FAC,11,NIFN))
if +NIFN'>0
QUIT
Begin DoDot:2
+9 SET NOTE=$PIECE($GET(^AUPNPROB(IFN,11,FAC,11,NIFN,0)),U,3)
+10 SET VALMCNT=VALMCNT+1
SET ^TMP("GMPL",$JOB,"IDX",VALMCNT,GMPCOUNT)=""
+11 SET ^TMP("GMPL",$JOB,VALMCNT,0)=" "_NOTE
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
HDR ; -- header code
+1 NEW HDR,LNM,FNM,PAT,NUM
+2 SET PAT=$PIECE(GMPDFN,U,2)_" ("_$PIECE(GMPDFN,U,3)_")"
+3 SET NUM=GMPCOUNT
if GMPTOTAL>GMPCOUNT
SET NUM=NUM_" of "_GMPTOTAL
+4 SET NUM=NUM_$SELECT(GMPLVIEW("ACT")="A":" active",GMPLVIEW("ACT")="I":" inactive",1:"")_" problems"
+5 SET VALMHDR(1)=PAT_$JUSTIFY(NUM,79-$LENGTH(PAT))
+6 SET HDR=$SELECT(GMPLVIEW("ACT")="I":"INACTIVE",GMPLVIEW("ACT")="A":"ACTIVE",1:"ALL")
+7 ; screened
IF $LENGTH(GMPLVIEW("VIEW"))>2
SET HDR=HDR_$SELECT($EXTRACT(GMPLVIEW("VIEW"))="S":" SERVICE",1:" CLINIC")
+8 SET HDR=HDR_" PROBLEMS"
+9 if GMPLVIEW("PROV")
SET LNM=$PIECE($PIECE(GMPLVIEW("PROV"),U,2),",")
SET FNM=$PIECE($PIECE(GMPLVIEW("PROV"),U,2),",",2)
SET HDR=HDR_" BY "_FNM_" "_LNM
+10 SET VALMHDR(2)=$JUSTIFY(HDR,$LENGTH(HDR)\2+41)
+11 QUIT
+12 ;
HELP ; -- help code
+1 NEW X
+2 WRITE !!?4,"To update the problem list first select from Add, Remove, Edit,"
+3 WRITE !?4
if GMPARAM("VER")
WRITE "Verify, "
+4 WRITE "Inactivate, or Comment, then enter the problem number(s)."
+5 WRITE !?4,"If you need more information on a problem, select Detailed"
+6 WRITE !?4,"Display; to change whether all or only selected problems for this"
+7 WRITE !?4,"patient are listed, choose Select View. Enter ?? to see more"
+8 WRITE !?4,"actions for facilitating navigation of the list."
+9 WRITE !?4,"Problem statuses: *-Acute I-Inactive #-Inactive ICD Code"
+10 if GMPARAM("VER")
WRITE " $-Unverified"
+11 WRITE !!,"Press <return> to continue ... "
READ X:DTIME
+12 SET VALMSG=$$MSG^GMPLX
SET VALMBCK=$SELECT(VALMCC:"",1:"R")
+13 QUIT
