Routine: GMPLMGR

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

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."

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

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)

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")

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMPLMGR   5523     printed  Mar 13, 2025@21:34:56                                                                                                                                                                                                     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

GMPLMGR.m