GMPLBLCK ;SLC/JFR/TC - check selection list ICD codes ;Oct 29, 2018@08:17
;;2.0;Problem List;**28,42,49,53**;Aug 25, 1994;Build 159
;
; External References:
; ICR 2056 $$GET1^DIQ
; ICR 5747 $$CODECS^ICDEX,$$STATCHK^ICDEX,$$HIST^ICDEX
; ICR 10026 ^DIR
; ICR 10063 ^%ZTLOAD
; ICR 10070 ^XMD
; ICR 10086 %ZIS,HOME^%ZIS
; ICR 10089 %ZISC
; ICR 10103 $$DT^XLFDT,$$FMTE^XLFDT
; ICR 10104 $$REPEAT^XLFSTR
Q
CSVPEP ;called from protocol GMPL SELECTION LIST CSV EVENT
N CAT,LN,GMPLST,LIST,SUB,GMPXMSUB,GMPLTO,GMPLFROM,GMPLCAT,GMPLI
D CKLISTS,CKCODES
S SUB="GMPLMSG",LN=1
K ^TMP(SUB,$J)
I '$D(^TMP("GMPLSL",$J)) D ; no problems found
. S ^TMP(SUB,$J,LN,0)="No Problems Selection List corrections/review required"
;
I $D(^TMP("GMPLSL",$J,"I")) D ; some inactive problem codes
. S ^TMP(SUB,$J,LN,0)="The following Problem Selection List(s) contain one or more problems that have",LN=LN+1
. S ^TMP(SUB,$J,LN,0)="inactive SNOMED and/or ICD codes attached to them. Any current users or clinics",LN=LN+1
. S ^TMP(SUB,$J,LN,0)="using these Selection Lists, will not be able to add the problems with inactive",LN=LN+1
. S ^TMP(SUB,$J,LN,0)="codes, until the list and the inactive codes are updated. The list may not be",LN=LN+1
. S ^TMP(SUB,$J,LN,0)="assigned to any additional users or clinics until updated.",LN=LN+1
. S (GMPLST,GMPLCAT,GMPLI)=0
. F S GMPLST=$O(^TMP("GMPLSL",$J,"I",GMPLST)) Q:GMPLST="" D
. . S ^TMP(SUB,$J,LN,0)="",LN=LN+1
. . S ^TMP(SUB,$J,LN,0)=" "_GMPLST_":",LN=LN+1
. . F S GMPLCAT=$O(^TMP("GMPLSL",$J,"I",GMPLST,GMPLCAT)) Q:GMPLCAT="" D
. . . S ^TMP(SUB,$J,LN,0)=" "_GMPLCAT_":",LN=LN+1
. . . F S GMPLI=$O(^TMP("GMPLSL",$J,"I",GMPLST,GMPLCAT,GMPLI)) Q:GMPLI="" D
. . . . N GMPLREC,GMPLDTXT,GMPLICD,GMPLCSYS,GMPLPROB,GMPLTEXT,GMPLK
. . . . S GMPLREC=$G(^TMP("GMPLSL",$J,"I",GMPLST,GMPLCAT,GMPLI)),GMPLK=0
. . . . S GMPLDTXT=$P(GMPLREC,U),GMPLICD=$P(GMPLREC,U,2),GMPLCSYS=$P(GMPLREC,U,3)
. . . . S GMPLPROB=" "_GMPLDTXT_" "_GMPLICD_" <INACTIVE "_GMPLCSYS_" CODE>"
. . . . D WRAP^GMPLX(GMPLPROB,79,.GMPLTEXT)
. . . . F S GMPLK=$O(GMPLTEXT(GMPLK)) Q:GMPLK="" D
. . . . . S ^TMP(SUB,$J,LN,0)=$S(GMPLK>1:" "_GMPLTEXT(GMPLK),1:GMPLTEXT(GMPLK)),LN=LN+1
;
I $D(^TMP("GMPLSL",$J,"F")) D ;no future inact. dates
. S ^TMP(SUB,$J,LN,0)="",LN=LN+1
. S ^TMP(SUB,$J,LN,0)="",LN=LN+1
. S ^TMP(SUB,$J,LN,0)="The following Problem Selection List categories contain problems with ICD",LN=LN+1
. S ^TMP(SUB,$J,LN,0)="codes that have a future inactivation date. These Categories should be updated",LN=LN+1
. S ^TMP(SUB,$J,LN,0)="as soon as possible after the inactivation date to reduce the interruption of",LN=LN+1
. S ^TMP(SUB,$J,LN,0)="use of the selection list(s) by users or clinics.",LN=LN+1
. S ^TMP(SUB,$J,LN,0)="",LN=LN+1
. S CAT=0
. F S CAT=$O(^TMP("GMPLSL",$J,"F",CAT)) Q:'CAT D
. . S ^TMP(SUB,$J,LN,0)=" Category name: "_$$GET1^DIQ(125.11,CAT,.01),LN=LN+1
. . S ^TMP(SUB,$J,LN,0)="",LN=LN+1
. . S ^TMP(SUB,$J,LN,0)=" Problems with ICD codes due to be inactivated:",LN=LN+1
. . S ^TMP(SUB,$J,LN,0)="",LN=LN+1
. . N PROB,TXT
. . S PROB=0
. . F S PROB=$O(^TMP("GMPLSL",$J,"F",CAT,PROB)) Q:'PROB D
. . . S TXT=^TMP("GMPLSL",$J,"F",CAT,PROB)
. . . S ^TMP(SUB,$J,LN,0)=" Problem text: "_$P(TXT,U),LN=LN+1
. . . S ^TMP(SUB,$J,LN,0)=" Display text: "_$P(TXT,U,2),LN=LN+1
. . . S ^TMP(SUB,$J,LN,0)=" Code: "_$P(TXT,U,3),LN=LN+1
. . . S ^TMP(SUB,$J,LN,0)=" Inactive Date: "_$$FMTE^XLFDT($P(TXT,U,4),2),LN=LN+1
. . . S ^TMP(SUB,$J,LN,0)="",LN=LN+1
. . I '$D(^TMP("GMPLSL",$J,"F",CAT,"L")) Q ; category not part of lists
. . S ^TMP(SUB,$J,LN,0)="",LN=LN+1
. . S ^TMP(SUB,$J,LN,0)=" This Category is part of the following Problem Selection Lists:",LN=LN+1
. . S ^TMP(SUB,$J,LN,0)="",LN=LN+1
. . S LIST=0
. . F S LIST=$O(^TMP("GMPLSL",$J,"F",CAT,"L",LIST)) Q:'LIST D
. . . S ^TMP(SUB,$J,LN,0)=" "_^TMP("GMPLSL",$J,"F",CAT,"L",LIST),LN=LN+1
. . S ^TMP(SUB,$J,LN,0)="",LN=LN+1
. . S ^TMP(SUB,$J,LN,0)="",LN=LN+1
. . Q
S GMPXMSUB="Problem Selection List Code Set Version review"
S GMPLFROM="Code Set Version Install"
S GMPLTO("G.GMPL CODE SET VERSION UPDATES")=""
D SEND^GMPLUTL4(SUB,GMPXMSUB,.GMPLTO,GMPLFROM)
K ^TMP("GMPLSL",$J)
Q
;
CSVOPT ; called from option GMPL SELECTION LIST CSV CHECK
;
N %ZIS,POP
S %ZIS="QM" D ^%ZIS Q:POP
I $D(IO("Q")) D D ^%ZISC,HOME^%ZIS Q
. N ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK
. S ZTDESC="Review of GMPL SEL LISTS for CSV"
. S ZTRTN="QUEUE^GMPLBLCK",ZTIO=ION,ZTDTH=$H
. D ^%ZTLOAD
. I '$G(ZTSK) W !,"Unable to task report"
. Q
;
QUEUE ; entry point for tasked report
I $D(ZTQUEUED) S ZTREQ="@"
U IO
N CAT,LN,GMPLST,LIST,PAGE,GMPLCAT,GMPLI,GMPLTITL
D CKLISTS,CKCODES
S GMPLTITL="Code Set Version Review of Problem Selection Lists"
S PAGE=1 D PAGE^GMPLSLRP(.PAGE,GMPLTITL)
I '$D(^TMP("GMPLSL",$J)) D ; no problems found
. W !,"No Problems Selection List corrections/review required"
. I $E(IOST,1,2)="C-" D
.. N DIR,DTOUT,DIRUT,DUOUT,X,Y
.. S DIR(0)="E" D ^DIR
. Q
;
I $D(^TMP("GMPLSL",$J,"I")) D ; some inactive problem codes
. W !,"The following Problem Selection List(s) contain one or more problems that have"
. W !,"inactive SNOMED and/or ICD codes attached to them. Any current users or clinics"
. W !,"using these Selection Lists, will not be able to add the problems with inactive"
. W !,"codes, until the list and the inactive codes are updated. The list may not be"
. W !,"assigned to any additional users or clinics until updated.",!
. S (GMPLST,GMPLCAT,GMPLI)=0
. F S GMPLST=$O(^TMP("GMPLSL",$J,"I",GMPLST)) Q:GMPLST=""!(PAGE<1) D
. . W !!," "_GMPLST_":"
. . F S GMPLCAT=$O(^TMP("GMPLSL",$J,"I",GMPLST,GMPLCAT)) Q:GMPLCAT=""!(PAGE<1) D
. . . W !," "_GMPLCAT_":"
. . . F S GMPLI=$O(^TMP("GMPLSL",$J,"I",GMPLST,GMPLCAT,GMPLI)) Q:GMPLI=""!(PAGE<1) D
. . . . I IOSL-$Y<3 D PAGE^GMPLSLRP(.PAGE,GMPLTITL) Q:'PAGE
. . . . N GMPLREC,GMPLDTXT,GMPLICD,GMPLCSYS,GMPLPROB,GMPLTEXT,GMPLK
. . . . S GMPLREC=$G(^TMP("GMPLSL",$J,"I",GMPLST,GMPLCAT,GMPLI)),GMPLK=0
. . . . S GMPLDTXT=$P(GMPLREC,U),GMPLICD=$P(GMPLREC,U,2),GMPLCSYS=$P(GMPLREC,U,3)
. . . . S GMPLPROB=" "_GMPLDTXT_" "_GMPLICD_" <INACTIVE "_GMPLCSYS_" CODE>"
. . . . D WRAP^GMPLX(GMPLPROB,79,.GMPLTEXT)
. . . . F S GMPLK=$O(GMPLTEXT(GMPLK)) Q:GMPLK="" D
. . . . . W !,$S(GMPLK>1:" "_GMPLTEXT(GMPLK),1:GMPLTEXT(GMPLK))
;
I $D(^TMP("GMPLSL",$J,"F")) D ; future inact. dates
. D PAGE^GMPLSLRP(.PAGE,GMPLTITL) Q:'PAGE
. W !,"The following Problem Selection List categories contain problems with ICD"
. W !,"codes that have a future inactivation date. These Categories should be updated"
. W !,"as soon as possible after the inactivation date to reduce the interruption of"
. W !,"use of the selection list(s) by users or clinics.",!
. S CAT=0
. F S CAT=$O(^TMP("GMPLSL",$J,"F",CAT)) Q:'CAT D
.. I IOSL-$Y<8 D PAGE^GMPLSLRP(.PAGE,GMPLTITL) Q:'PAGE
.. W !!!," Category name: "_$$GET1^DIQ(125.11,CAT,.01),!
.. W !," Problems with ICD codes due to be inactivated:",!
.. N PROB,TXT
.. S PROB=0
.. F S PROB=$O(^TMP("GMPLSL",$J,"F",CAT,PROB)) Q:'PROB!(PAGE<1) D
... S TXT=^TMP("GMPLSL",$J,"F",CAT,PROB)
... I IOSL-$Y<5 D PAGE^GMPLSLRP(.PAGE,GMPLTITL) Q:'PAGE
... W !," Problem text: "_$P(TXT,U)
... W !," Display text: "_$P(TXT,U,2)
... W !," Code: "_$P(TXT,U,3)
... W !," Inactive Date: "_$P(TXT,U,4),!
.. I '$D(^TMP("GMPLSL",$J,"F",CAT,"L")) Q ; category not part of lists
.. I IOSL-$Y<3 D PAGE^GMPLSLRP(.PAGE,GMPLTITL) Q:'PAGE
.. W !!," This Category is part of the following Problem Selection Lists:",!
.. S LIST=0
.. F S LIST=$O(^TMP("GMPLSL",$J,"F",CAT,"L",LIST)) Q:'LIST!(PAGE<1) D
... I IOSL-$Y<3 D PAGE^GMPLSLRP(.PAGE,GMPLTITL) Q:'PAGE
... W !," "_^TMP("GMPLSL",$J,"F",CAT,"L",LIST)
.. Q
. Q
D:$E(IOST,1,2)'="C-" ^%ZISC
D HOME^%ZIS
K ^TMP("GMPLSL",$J)
Q
;
CKLISTS ; loop lists and see if any inactive problems
;
; returns ^TMP("GMPLSL",$J,"I"
;
K ^TMP("GMPLSL",$J,"I")
N LST,GMPLCNME,GMPLSEQ,GMPLREC,GMPLCNT
S (LST,GMPLCNME,GMPLSEQ)=0
F S LST=$O(^GMPL(125,LST)) Q:'LST D
. N GMPLCLST
. I '$$VALLIST^GMPLBLD2(LST,"GMPLCLST") D
. . S GMPLCNT=0
. . I $D(GMPLCLST) D
. . . F S GMPLCNME=$O(GMPLCLST(GMPLCNME)) Q:GMPLCNME="" D
. . . . F S GMPLSEQ=$O(GMPLCLST(GMPLCNME,GMPLSEQ)) Q:GMPLSEQ="" D
. . . . . S GMPLREC=GMPLCLST(GMPLCNME,GMPLSEQ),GMPLCNT=GMPLCNT+1
. . . . . S ^TMP("GMPLSL",$J,"I",$P(^GMPL(125,LST,0),U),GMPLCNME,GMPLCNT)=$P(GMPLREC,U)_U_$P(GMPLREC,U,2)_U_$P(GMPLREC,U,3)
. Q
Q
;
CKCODES ; check probs on lists for future inactivation dates
;
; returns:
; ^TMP("GMPLSL",$J,"F",category,problem)
; ^TMP("GMPLSL",$J,"F",category,"L",list)
;
K ^TMP("GMPLSL",$J,"F")
N CAT,LIST,GMPCAT,GMPPSQ,GMPDA,GMPDT
S (GMPCAT,GMPPSQ,GMPDA)=0,GMPDT=$$DT^XLFDT
F S GMPCAT=$O(^GMPL(125.11,"C",GMPCAT)) Q:'GMPCAT D
. F S GMPPSQ=$O(^GMPL(125.11,"C",GMPCAT,GMPPSQ)) Q:'GMPPSQ D
. . F S GMPDA=$O(^GMPL(125.11,"C",GMPCAT,GMPPSQ,GMPDA)) Q:'GMPDA D
. . . I $L($P(^GMPL(125.11,GMPCAT,1,GMPDA,0),U,4)) D
. . . . N GMPL0,GMPPROB,GMPARY,GMPADT,GMPCSPTR,GMPICD
. . . . S GMPL0=$G(^GMPL(125.11,GMPCAT,1,GMPDA,0)),GMPICD=$P(GMPL0,U,4)
. . . . S GMPCSPTR=+$$CODECS^ICDEX(GMPICD,80,GMPDT)
. . . . I '$$STATCHK^ICDEX(GMPICD,GMPDT,GMPCSPTR) Q ;already inactive
. . . . S GMPARY=$$HIST^ICDEX(GMPICD,.GMPARY,GMPCSPTR)
. . . . S GMPADT=+$O(GMPARY(GMPDT))
. . . . Q:'GMPADT ; no future activity
. . . . I $G(GMPARY(GMPADT)) Q ; no future inactivation = OK
. . . . S GMPPROB=$$GET1^DIQ(125.111,""_GMPDA_","_GMPCAT_",",.01)
. . . . S ^TMP("GMPLSL",$J,"F",GMPCAT,GMPDA)=GMPPROB_U_$P(GMPL0,U,3)_U_GMPICD_U_$$FMTE^XLFDT(GMPADT)
. . . . Q
;
; find lists that contain the categories
S CAT=0
F S CAT=$O(^TMP("GMPLSL",$J,"F",CAT)) Q:'CAT D
. I '$D(^GMPL(125,"AC",CAT)) Q ; category not part of any lists
. N LIST S LIST=0
. F S LIST=$O(^GMPL(125,"AC",CAT,LIST)) Q:'LIST D
.. S ^TMP("GMPLSL",$J,"F",CAT,"L",LIST)=$$GET1^DIQ(125,LIST,.01)
.. Q
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMPLBLCK 10297 printed Dec 13, 2024@02:29:44 Page 2
GMPLBLCK ;SLC/JFR/TC - check selection list ICD codes ;Oct 29, 2018@08:17
+1 ;;2.0;Problem List;**28,42,49,53**;Aug 25, 1994;Build 159
+2 ;
+3 ; External References:
+4 ; ICR 2056 $$GET1^DIQ
+5 ; ICR 5747 $$CODECS^ICDEX,$$STATCHK^ICDEX,$$HIST^ICDEX
+6 ; ICR 10026 ^DIR
+7 ; ICR 10063 ^%ZTLOAD
+8 ; ICR 10070 ^XMD
+9 ; ICR 10086 %ZIS,HOME^%ZIS
+10 ; ICR 10089 %ZISC
+11 ; ICR 10103 $$DT^XLFDT,$$FMTE^XLFDT
+12 ; ICR 10104 $$REPEAT^XLFSTR
+13 QUIT
CSVPEP ;called from protocol GMPL SELECTION LIST CSV EVENT
+1 NEW CAT,LN,GMPLST,LIST,SUB,GMPXMSUB,GMPLTO,GMPLFROM,GMPLCAT,GMPLI
+2 DO CKLISTS
DO CKCODES
+3 SET SUB="GMPLMSG"
SET LN=1
+4 KILL ^TMP(SUB,$JOB)
+5 ; no problems found
IF '$DATA(^TMP("GMPLSL",$JOB))
Begin DoDot:1
+6 SET ^TMP(SUB,$JOB,LN,0)="No Problems Selection List corrections/review required"
End DoDot:1
+7 ;
+8 ; some inactive problem codes
IF $DATA(^TMP("GMPLSL",$JOB,"I"))
Begin DoDot:1
+9 SET ^TMP(SUB,$JOB,LN,0)="The following Problem Selection List(s) contain one or more problems that have"
SET LN=LN+1
+10 SET ^TMP(SUB,$JOB,LN,0)="inactive SNOMED and/or ICD codes attached to them. Any current users or clinics"
SET LN=LN+1
+11 SET ^TMP(SUB,$JOB,LN,0)="using these Selection Lists, will not be able to add the problems with inactive"
SET LN=LN+1
+12 SET ^TMP(SUB,$JOB,LN,0)="codes, until the list and the inactive codes are updated. The list may not be"
SET LN=LN+1
+13 SET ^TMP(SUB,$JOB,LN,0)="assigned to any additional users or clinics until updated."
SET LN=LN+1
+14 SET (GMPLST,GMPLCAT,GMPLI)=0
+15 FOR
SET GMPLST=$ORDER(^TMP("GMPLSL",$JOB,"I",GMPLST))
if GMPLST=""
QUIT
Begin DoDot:2
+16 SET ^TMP(SUB,$JOB,LN,0)=""
SET LN=LN+1
+17 SET ^TMP(SUB,$JOB,LN,0)=" "_GMPLST_":"
SET LN=LN+1
+18 FOR
SET GMPLCAT=$ORDER(^TMP("GMPLSL",$JOB,"I",GMPLST,GMPLCAT))
if GMPLCAT=""
QUIT
Begin DoDot:3
+19 SET ^TMP(SUB,$JOB,LN,0)=" "_GMPLCAT_":"
SET LN=LN+1
+20 FOR
SET GMPLI=$ORDER(^TMP("GMPLSL",$JOB,"I",GMPLST,GMPLCAT,GMPLI))
if GMPLI=""
QUIT
Begin DoDot:4
+21 NEW GMPLREC,GMPLDTXT,GMPLICD,GMPLCSYS,GMPLPROB,GMPLTEXT,GMPLK
+22 SET GMPLREC=$GET(^TMP("GMPLSL",$JOB,"I",GMPLST,GMPLCAT,GMPLI))
SET GMPLK=0
+23 SET GMPLDTXT=$PIECE(GMPLREC,U)
SET GMPLICD=$PIECE(GMPLREC,U,2)
SET GMPLCSYS=$PIECE(GMPLREC,U,3)
+24 SET GMPLPROB=" "_GMPLDTXT_" "_GMPLICD_" <INACTIVE "_GMPLCSYS_" CODE>"
+25 DO WRAP^GMPLX(GMPLPROB,79,.GMPLTEXT)
+26 FOR
SET GMPLK=$ORDER(GMPLTEXT(GMPLK))
if GMPLK=""
QUIT
Begin DoDot:5
+27 SET ^TMP(SUB,$JOB,LN,0)=$SELECT(GMPLK>1:" "_GMPLTEXT(GMPLK),1:GMPLTEXT(GMPLK))
SET LN=LN+1
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+28 ;
+29 ;no future inact. dates
IF $DATA(^TMP("GMPLSL",$JOB,"F"))
Begin DoDot:1
+30 SET ^TMP(SUB,$JOB,LN,0)=""
SET LN=LN+1
+31 SET ^TMP(SUB,$JOB,LN,0)=""
SET LN=LN+1
+32 SET ^TMP(SUB,$JOB,LN,0)="The following Problem Selection List categories contain problems with ICD"
SET LN=LN+1
+33 SET ^TMP(SUB,$JOB,LN,0)="codes that have a future inactivation date. These Categories should be updated"
SET LN=LN+1
+34 SET ^TMP(SUB,$JOB,LN,0)="as soon as possible after the inactivation date to reduce the interruption of"
SET LN=LN+1
+35 SET ^TMP(SUB,$JOB,LN,0)="use of the selection list(s) by users or clinics."
SET LN=LN+1
+36 SET ^TMP(SUB,$JOB,LN,0)=""
SET LN=LN+1
+37 SET CAT=0
+38 FOR
SET CAT=$ORDER(^TMP("GMPLSL",$JOB,"F",CAT))
if 'CAT
QUIT
Begin DoDot:2
+39 SET ^TMP(SUB,$JOB,LN,0)=" Category name: "_$$GET1^DIQ(125.11,CAT,.01)
SET LN=LN+1
+40 SET ^TMP(SUB,$JOB,LN,0)=""
SET LN=LN+1
+41 SET ^TMP(SUB,$JOB,LN,0)=" Problems with ICD codes due to be inactivated:"
SET LN=LN+1
+42 SET ^TMP(SUB,$JOB,LN,0)=""
SET LN=LN+1
+43 NEW PROB,TXT
+44 SET PROB=0
+45 FOR
SET PROB=$ORDER(^TMP("GMPLSL",$JOB,"F",CAT,PROB))
if 'PROB
QUIT
Begin DoDot:3
+46 SET TXT=^TMP("GMPLSL",$JOB,"F",CAT,PROB)
+47 SET ^TMP(SUB,$JOB,LN,0)=" Problem text: "_$PIECE(TXT,U)
SET LN=LN+1
+48 SET ^TMP(SUB,$JOB,LN,0)=" Display text: "_$PIECE(TXT,U,2)
SET LN=LN+1
+49 SET ^TMP(SUB,$JOB,LN,0)=" Code: "_$PIECE(TXT,U,3)
SET LN=LN+1
+50 SET ^TMP(SUB,$JOB,LN,0)=" Inactive Date: "_$$FMTE^XLFDT($PIECE(TXT,U,4),2)
SET LN=LN+1
+51 SET ^TMP(SUB,$JOB,LN,0)=""
SET LN=LN+1
End DoDot:3
+52 ; category not part of lists
IF '$DATA(^TMP("GMPLSL",$JOB,"F",CAT,"L"))
QUIT
+53 SET ^TMP(SUB,$JOB,LN,0)=""
SET LN=LN+1
+54 SET ^TMP(SUB,$JOB,LN,0)=" This Category is part of the following Problem Selection Lists:"
SET LN=LN+1
+55 SET ^TMP(SUB,$JOB,LN,0)=""
SET LN=LN+1
+56 SET LIST=0
+57 FOR
SET LIST=$ORDER(^TMP("GMPLSL",$JOB,"F",CAT,"L",LIST))
if 'LIST
QUIT
Begin DoDot:3
+58 SET ^TMP(SUB,$JOB,LN,0)=" "_^TMP("GMPLSL",$JOB,"F",CAT,"L",LIST)
SET LN=LN+1
End DoDot:3
+59 SET ^TMP(SUB,$JOB,LN,0)=""
SET LN=LN+1
+60 SET ^TMP(SUB,$JOB,LN,0)=""
SET LN=LN+1
+61 QUIT
End DoDot:2
End DoDot:1
+62 SET GMPXMSUB="Problem Selection List Code Set Version review"
+63 SET GMPLFROM="Code Set Version Install"
+64 SET GMPLTO("G.GMPL CODE SET VERSION UPDATES")=""
+65 DO SEND^GMPLUTL4(SUB,GMPXMSUB,.GMPLTO,GMPLFROM)
+66 KILL ^TMP("GMPLSL",$JOB)
+67 QUIT
+68 ;
CSVOPT ; called from option GMPL SELECTION LIST CSV CHECK
+1 ;
+2 NEW %ZIS,POP
+3 SET %ZIS="QM"
DO ^%ZIS
if POP
QUIT
+4 IF $DATA(IO("Q"))
Begin DoDot:1
+5 NEW ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK
+6 SET ZTDESC="Review of GMPL SEL LISTS for CSV"
+7 SET ZTRTN="QUEUE^GMPLBLCK"
SET ZTIO=ION
SET ZTDTH=$HOROLOG
+8 DO ^%ZTLOAD
+9 IF '$GET(ZTSK)
WRITE !,"Unable to task report"
+10 QUIT
End DoDot:1
DO ^%ZISC
DO HOME^%ZIS
QUIT
+11 ;
QUEUE ; entry point for tasked report
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 USE IO
+3 NEW CAT,LN,GMPLST,LIST,PAGE,GMPLCAT,GMPLI,GMPLTITL
+4 DO CKLISTS
DO CKCODES
+5 SET GMPLTITL="Code Set Version Review of Problem Selection Lists"
+6 SET PAGE=1
DO PAGE^GMPLSLRP(.PAGE,GMPLTITL)
+7 ; no problems found
IF '$DATA(^TMP("GMPLSL",$JOB))
Begin DoDot:1
+8 WRITE !,"No Problems Selection List corrections/review required"
+9 IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:2
+10 NEW DIR,DTOUT,DIRUT,DUOUT,X,Y
+11 SET DIR(0)="E"
DO ^DIR
End DoDot:2
+12 QUIT
End DoDot:1
+13 ;
+14 ; some inactive problem codes
IF $DATA(^TMP("GMPLSL",$JOB,"I"))
Begin DoDot:1
+15 WRITE !,"The following Problem Selection List(s) contain one or more problems that have"
+16 WRITE !,"inactive SNOMED and/or ICD codes attached to them. Any current users or clinics"
+17 WRITE !,"using these Selection Lists, will not be able to add the problems with inactive"
+18 WRITE !,"codes, until the list and the inactive codes are updated. The list may not be"
+19 WRITE !,"assigned to any additional users or clinics until updated.",!
+20 SET (GMPLST,GMPLCAT,GMPLI)=0
+21 FOR
SET GMPLST=$ORDER(^TMP("GMPLSL",$JOB,"I",GMPLST))
if GMPLST=""!(PAGE<1)
QUIT
Begin DoDot:2
+22 WRITE !!," "_GMPLST_":"
+23 FOR
SET GMPLCAT=$ORDER(^TMP("GMPLSL",$JOB,"I",GMPLST,GMPLCAT))
if GMPLCAT=""!(PAGE<1)
QUIT
Begin DoDot:3
+24 WRITE !," "_GMPLCAT_":"
+25 FOR
SET GMPLI=$ORDER(^TMP("GMPLSL",$JOB,"I",GMPLST,GMPLCAT,GMPLI))
if GMPLI=""!(PAGE<1)
QUIT
Begin DoDot:4
+26 IF IOSL-$Y<3
DO PAGE^GMPLSLRP(.PAGE,GMPLTITL)
if 'PAGE
QUIT
+27 NEW GMPLREC,GMPLDTXT,GMPLICD,GMPLCSYS,GMPLPROB,GMPLTEXT,GMPLK
+28 SET GMPLREC=$GET(^TMP("GMPLSL",$JOB,"I",GMPLST,GMPLCAT,GMPLI))
SET GMPLK=0
+29 SET GMPLDTXT=$PIECE(GMPLREC,U)
SET GMPLICD=$PIECE(GMPLREC,U,2)
SET GMPLCSYS=$PIECE(GMPLREC,U,3)
+30 SET GMPLPROB=" "_GMPLDTXT_" "_GMPLICD_" <INACTIVE "_GMPLCSYS_" CODE>"
+31 DO WRAP^GMPLX(GMPLPROB,79,.GMPLTEXT)
+32 FOR
SET GMPLK=$ORDER(GMPLTEXT(GMPLK))
if GMPLK=""
QUIT
Begin DoDot:5
+33 WRITE !,$SELECT(GMPLK>1:" "_GMPLTEXT(GMPLK),1:GMPLTEXT(GMPLK))
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+34 ;
+35 ; future inact. dates
IF $DATA(^TMP("GMPLSL",$JOB,"F"))
Begin DoDot:1
+36 DO PAGE^GMPLSLRP(.PAGE,GMPLTITL)
if 'PAGE
QUIT
+37 WRITE !,"The following Problem Selection List categories contain problems with ICD"
+38 WRITE !,"codes that have a future inactivation date. These Categories should be updated"
+39 WRITE !,"as soon as possible after the inactivation date to reduce the interruption of"
+40 WRITE !,"use of the selection list(s) by users or clinics.",!
+41 SET CAT=0
+42 FOR
SET CAT=$ORDER(^TMP("GMPLSL",$JOB,"F",CAT))
if 'CAT
QUIT
Begin DoDot:2
+43 IF IOSL-$Y<8
DO PAGE^GMPLSLRP(.PAGE,GMPLTITL)
if 'PAGE
QUIT
+44 WRITE !!!," Category name: "_$$GET1^DIQ(125.11,CAT,.01),!
+45 WRITE !," Problems with ICD codes due to be inactivated:",!
+46 NEW PROB,TXT
+47 SET PROB=0
+48 FOR
SET PROB=$ORDER(^TMP("GMPLSL",$JOB,"F",CAT,PROB))
if 'PROB!(PAGE<1)
QUIT
Begin DoDot:3
+49 SET TXT=^TMP("GMPLSL",$JOB,"F",CAT,PROB)
+50 IF IOSL-$Y<5
DO PAGE^GMPLSLRP(.PAGE,GMPLTITL)
if 'PAGE
QUIT
+51 WRITE !," Problem text: "_$PIECE(TXT,U)
+52 WRITE !," Display text: "_$PIECE(TXT,U,2)
+53 WRITE !," Code: "_$PIECE(TXT,U,3)
+54 WRITE !," Inactive Date: "_$PIECE(TXT,U,4),!
End DoDot:3
+55 ; category not part of lists
IF '$DATA(^TMP("GMPLSL",$JOB,"F",CAT,"L"))
QUIT
+56 IF IOSL-$Y<3
DO PAGE^GMPLSLRP(.PAGE,GMPLTITL)
if 'PAGE
QUIT
+57 WRITE !!," This Category is part of the following Problem Selection Lists:",!
+58 SET LIST=0
+59 FOR
SET LIST=$ORDER(^TMP("GMPLSL",$JOB,"F",CAT,"L",LIST))
if 'LIST!(PAGE<1)
QUIT
Begin DoDot:3
+60 IF IOSL-$Y<3
DO PAGE^GMPLSLRP(.PAGE,GMPLTITL)
if 'PAGE
QUIT
+61 WRITE !," "_^TMP("GMPLSL",$JOB,"F",CAT,"L",LIST)
End DoDot:3
+62 QUIT
End DoDot:2
+63 QUIT
End DoDot:1
+64 if $EXTRACT(IOST,1,2)'="C-"
DO ^%ZISC
+65 DO HOME^%ZIS
+66 KILL ^TMP("GMPLSL",$JOB)
+67 QUIT
+68 ;
CKLISTS ; loop lists and see if any inactive problems
+1 ;
+2 ; returns ^TMP("GMPLSL",$J,"I"
+3 ;
+4 KILL ^TMP("GMPLSL",$JOB,"I")
+5 NEW LST,GMPLCNME,GMPLSEQ,GMPLREC,GMPLCNT
+6 SET (LST,GMPLCNME,GMPLSEQ)=0
+7 FOR
SET LST=$ORDER(^GMPL(125,LST))
if 'LST
QUIT
Begin DoDot:1
+8 NEW GMPLCLST
+9 IF '$$VALLIST^GMPLBLD2(LST,"GMPLCLST")
Begin DoDot:2
+10 SET GMPLCNT=0
+11 IF $DATA(GMPLCLST)
Begin DoDot:3
+12 FOR
SET GMPLCNME=$ORDER(GMPLCLST(GMPLCNME))
if GMPLCNME=""
QUIT
Begin DoDot:4
+13 FOR
SET GMPLSEQ=$ORDER(GMPLCLST(GMPLCNME,GMPLSEQ))
if GMPLSEQ=""
QUIT
Begin DoDot:5
+14 SET GMPLREC=GMPLCLST(GMPLCNME,GMPLSEQ)
SET GMPLCNT=GMPLCNT+1
+15 SET ^TMP("GMPLSL",$JOB,"I",$PIECE(^GMPL(125,LST,0),U),GMPLCNME,GMPLCNT)=$PIECE(GMPLREC,U)_U_$PIECE(GMPLREC,U,2)_U_$PIECE(GMPLREC,U,3)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+16 QUIT
End DoDot:1
+17 QUIT
+18 ;
CKCODES ; check probs on lists for future inactivation dates
+1 ;
+2 ; returns:
+3 ; ^TMP("GMPLSL",$J,"F",category,problem)
+4 ; ^TMP("GMPLSL",$J,"F",category,"L",list)
+5 ;
+6 KILL ^TMP("GMPLSL",$JOB,"F")
+7 NEW CAT,LIST,GMPCAT,GMPPSQ,GMPDA,GMPDT
+8 SET (GMPCAT,GMPPSQ,GMPDA)=0
SET GMPDT=$$DT^XLFDT
+9 FOR
SET GMPCAT=$ORDER(^GMPL(125.11,"C",GMPCAT))
if 'GMPCAT
QUIT
Begin DoDot:1
+10 FOR
SET GMPPSQ=$ORDER(^GMPL(125.11,"C",GMPCAT,GMPPSQ))
if 'GMPPSQ
QUIT
Begin DoDot:2
+11 FOR
SET GMPDA=$ORDER(^GMPL(125.11,"C",GMPCAT,GMPPSQ,GMPDA))
if 'GMPDA
QUIT
Begin DoDot:3
+12 IF $LENGTH($PIECE(^GMPL(125.11,GMPCAT,1,GMPDA,0),U,4))
Begin DoDot:4
+13 NEW GMPL0,GMPPROB,GMPARY,GMPADT,GMPCSPTR,GMPICD
+14 SET GMPL0=$GET(^GMPL(125.11,GMPCAT,1,GMPDA,0))
SET GMPICD=$PIECE(GMPL0,U,4)
+15 SET GMPCSPTR=+$$CODECS^ICDEX(GMPICD,80,GMPDT)
+16 ;already inactive
IF '$$STATCHK^ICDEX(GMPICD,GMPDT,GMPCSPTR)
QUIT
+17 SET GMPARY=$$HIST^ICDEX(GMPICD,.GMPARY,GMPCSPTR)
+18 SET GMPADT=+$ORDER(GMPARY(GMPDT))
+19 ; no future activity
if 'GMPADT
QUIT
+20 ; no future inactivation = OK
IF $GET(GMPARY(GMPADT))
QUIT
+21 SET GMPPROB=$$GET1^DIQ(125.111,""_GMPDA_","_GMPCAT_",",.01)
+22 SET ^TMP("GMPLSL",$JOB,"F",GMPCAT,GMPDA)=GMPPROB_U_$PIECE(GMPL0,U,3)_U_GMPICD_U_$$FMTE^XLFDT(GMPADT)
+23 QUIT
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+24 ;
+25 ; find lists that contain the categories
+26 SET CAT=0
+27 FOR
SET CAT=$ORDER(^TMP("GMPLSL",$JOB,"F",CAT))
if 'CAT
QUIT
Begin DoDot:1
+28 ; category not part of any lists
IF '$DATA(^GMPL(125,"AC",CAT))
QUIT
+29 NEW LIST
SET LIST=0
+30 FOR
SET LIST=$ORDER(^GMPL(125,"AC",CAT,LIST))
if 'LIST
QUIT
Begin DoDot:2
+31 SET ^TMP("GMPLSL",$JOB,"F",CAT,"L",LIST)=$$GET1^DIQ(125,LIST,.01)
+32 QUIT
End DoDot:2
+33 QUIT
End DoDot:1
+34 QUIT
