GMPLBLCK ;SLC/JFR - check selection list ICD9 codes; 3/20/03 09:05
;;2.0;Problem List;**28**;Aug 25, 1994
;
; This routine invokes IA #3990
Q
CSVPEP ;called from protocol GMPL SELECTION LIST CSV EVENT
N CAT,LN,LST,LIST,XMSUB,XMTEXT,XMDUZ,XMY
D CKLISTS,CKCODES
K ^TMP("GMPLMSG",$J)
S LN=1
I $D(^TMP("GMPLSL",$J,"I")) D
. S ^TMP("GMPLMSG",$J,LN)="The following Problem Selection Lists contain one or more problems that",LN=LN+1
. S ^TMP("GMPLMSG",$J,LN)="have inactive ICD-9 codes attached to them. Any current users or clinics using",LN=LN+1
. S ^TMP("GMPLMSG",$J,LN)="these Selection Lists, will not be able to add the problems with inactive ",LN=LN+1
. S ^TMP("GMPLMSG",$J,LN)="codes, until the list and the inactive codes are updated. The list may not be",LN=LN+1
. S ^TMP("GMPLMSG",$J,LN)="assigned to any additional users or clinics until updated.",LN=LN+1
. S LST=0
. F S LST=$O(^TMP("GMPLSL",$J,"I",LST)) Q:'LST D
.. S ^TMP("GMPLMSG",$J,LN)=" "_^TMP("GMPLSL",$J,"I",LST)
.. S LN=LN+1
;
I $D(^TMP("GMPLSL",$J,"F")) D ;no future inact. dates
. S ^TMP("GMPLMSG",$J,LN)="",LN=LN+1
. S ^TMP("GMPLMSG",$J,LN)="",LN=LN+1
. S ^TMP("GMPLMSG",$J,LN)="The following Problem Selection List categories contain problems with ICD9 ",LN=LN+1
. S ^TMP("GMPLMSG",$J,LN)="codes that have a future inactivation date. These Categories should be updated",LN=LN+1
. S ^TMP("GMPLMSG",$J,LN)="as soon as possible after the inactivation date to reduce the interruption of",LN=LN+1
. S ^TMP("GMPLMSG",$J,LN)="use of the selection list(s) by users or clinics.",LN=LN+1
. S ^TMP("GMPLMSG",$J,LN)="",LN=LN+1
. S CAT=0
. F S CAT=$O(^TMP("GMPLSL",$J,"F",CAT)) Q:'CAT D
.. S ^TMP("GMPLMSG",$J,LN)=" Category name: "_$$GET1^DIQ(125.11,CAT,.01)
.. S LN=LN+1
.. S ^TMP("GMPLMSG",$J,LN)="",LN=LN+1
.. S ^TMP("GMPLMSG",$J,LN)=" Problems with ICD9 codes due to be inactivated:",LN=LN+1
.. S ^TMP("GMPLMSG",$J,LN)="",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("GMPLMSG",$J,LN)=" Problem text: "_$P(TXT,U),LN=LN+1
... S ^TMP("GMPLMSG",$J,LN)=" Display text: "_$P(TXT,U,2),LN=LN+1
... S ^TMP("GMPLMSG",$J,LN)=" Code: "_$P(TXT,U,3),LN=LN+1
... S ^TMP("GMPLMSG",$J,LN)=" Inactive Date: "_$$FMTE^XLFDT($P(TXT,U,4),2),LN=LN+1
... S ^TMP("GMPLMSG",$J,LN)="",LN=LN+1
.. I '$D(^TMP("GMPLSL",$J,"F",CAT,"L")) Q ; category not part of lists
.. S ^TMP("GMPLMSG",$J,LN)="",LN=LN+1
.. S ^TMP("GMPLMSG",$J,LN)=" This Category is part of the following Problem Selection Lists:",LN=LN+1
.. S LIST=0
.. F S LIST=$O(^TMP("GMPLSL",$J,"F",CAT,"L",LIST)) Q:'LIST D
... S ^TMP("GMPLMSG",$J,LN)=" "_^TMP("GMPLSL",$J,"F",CAT,"L",LIST)
... S LN=LN+1
.. S ^TMP("GMPLMSG",$J,LN)="",LN=LN+1
.. S ^TMP("GMPLMSG",$J,LN)="",LN=LN+1
.. Q
I '$D(^TMP("GMPLSL",$J)) D ; no problems found
. S ^TMP("GMPLMSG",$J,LN)="No Problems Selection List corrections/review required"
. S LN=LN+1
S XMY("G.GMPL CODE SET VERSION UPDATES")=""
S XMSUB="Problem Selection List Code Set Version review"
S XMDUZ="Code Set Version Install"
S XMTEXT="^TMP(""GMPLMSG"",$J,"
D ^XMD
K ^TMP("GMPLSL",$J),^TMP("GMPLMSG",$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,LST,LIST,PAGE
D CKLISTS,CKCODES
S PAGE=1 D PAGE(.PAGE)
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"
. W !,"have inactive ICD-9 codes attached to them. Any current users or clinics using"
. W !,"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 LST=0
. F S LST=$O(^TMP("GMPLSL",$J,"I",LST)) Q:'LST!(PAGE<1) D
.. I IOSL-$Y<3 D PAGE(.PAGE) Q:'PAGE
.. W !," "_^TMP("GMPLSL",$J,"I",LST)
;
I $D(^TMP("GMPLSL",$J,"F")) D ; future inact. dates
. D PAGE(.PAGE) Q:'PAGE
. W !,"The following Problem Selection List categories contain problems with ICD9 "
. 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(.PAGE) Q:'PAGE
.. W !!!," Category name: "_$$GET1^DIQ(125.11,CAT,.01),!
.. W !," Problems with ICD9 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(.PAGE) 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(.PAGE) 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(.PAGE) 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
S LST=0
F S LST=$O(^GMPL(125,LST)) Q:'LST I '$$VALLIST^GMPLBLD2(LST) D
. S ^TMP("GMPLSL",$J,"I",LST)=$P(^GMPL(125,LST,0),U)
. 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 PROB,CAT,LIST
S PROB=0
F S PROB=$O(^GMPL(125.12,PROB)) Q:'PROB I $L($P(^(PROB,0),U,5)) D
. N PROB0,PROBTX,APIDATA,PROBCAT,ACTDT
. S PROB0=^GMPL(125.12,PROB,0)
. I '$$STATCHK^ICDAPIU($P(PROB0,U,5),DT) Q ;already inactive
. S APIDATA=$$HIST^ICDAPIU($P(PROB0,U,5),.APIDATA)
. S ACTDT=+$O(APIDATA(DT))
. Q:'ACTDT ; no future activity
. I $G(APIDATA(ACTDT)) Q ; no future inactivation = OK
. S PROBTX=$$GET1^DIQ(125.12,PROB,2)
. S PROBCAT=$P(PROB0,U)
. S ^TMP("GMPLSL",$J,"F",PROBCAT,PROB)=PROBTX_U_$P(PROB0,U,4)_U_$P(PROB0,U,5)_U_$$FMTE^XLFDT(ACTDT)
. 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.1,"G",CAT)) Q ; category not part of any lists
. N LIST S LIST=0
. F S LIST=$O(^GMPL(125.1,"G",CAT,LIST)) Q:'LIST D
.. S ^TMP("GMPLSL",$J,"F",CAT,"L",LIST)=$$GET1^DIQ(125.1,LIST,.01)
.. Q
. Q
Q
;
PAGE(NUM) ;print header and raise page number
Q:'$G(NUM)
I NUM'=1,$E(IOST,1,2)="C-" D Q:'NUM
. N DIR,DTOUT,DIRUT,DUOUT,X,Y
. S DIR(0)="E" D ^DIR
. I $D(DTOUT)!($D(DUOUT)) S NUM=0
W @IOF
W "Code Set Version review of Problem Selection Lists"
W ?70,"Page: ",NUM
W !,$$REPEAT^XLFSTR("-",78)
S NUM=NUM+1
Q
GMPLBLCK ;SLC/JFR - check selection list ICD9 codes; 3/20/03 09:05
+1 ;;2.0;Problem List;**28**;Aug 25, 1994
+2 ;
+3 ; This routine invokes IA #3990
+4 QUIT
CSVPEP ;called from protocol GMPL SELECTION LIST CSV EVENT
+1 NEW CAT,LN,LST,LIST,XMSUB,XMTEXT,XMDUZ,XMY
+2 DO CKLISTS
DO CKCODES
+3 KILL ^TMP("GMPLMSG",$JOB)
+4 SET LN=1
+5 IF $DATA(^TMP("GMPLSL",$JOB,"I"))
Begin DoDot:1
+6 SET ^TMP("GMPLMSG",$JOB,LN)="The following Problem Selection Lists contain one or more problems that"
SET LN=LN+1
+7 SET ^TMP("GMPLMSG",$JOB,LN)="have inactive ICD-9 codes attached to them. Any current users or clinics using"
SET LN=LN+1
+8 SET ^TMP("GMPLMSG",$JOB,LN)="these Selection Lists, will not be able to add the problems with inactive "
SET LN=LN+1
+9 SET ^TMP("GMPLMSG",$JOB,LN)="codes, until the list and the inactive codes are updated. The list may not be"
SET LN=LN+1
+10 SET ^TMP("GMPLMSG",$JOB,LN)="assigned to any additional users or clinics until updated."
SET LN=LN+1
+11 SET LST=0
+12 FOR
SET LST=$ORDER(^TMP("GMPLSL",$JOB,"I",LST))
IF 'LST
QUIT
Begin DoDot:2
+13 SET ^TMP("GMPLMSG",$JOB,LN)=" "_^TMP("GMPLSL",$JOB,"I",LST)
+14 SET LN=LN+1
End DoDot:2
End DoDot:1
+15 ;
+16 ;no future inact. dates
IF $DATA(^TMP("GMPLSL",$JOB,"F"))
Begin DoDot:1
+17 SET ^TMP("GMPLMSG",$JOB,LN)=""
SET LN=LN+1
+18 SET ^TMP("GMPLMSG",$JOB,LN)=""
SET LN=LN+1
+19 SET ^TMP("GMPLMSG",$JOB,LN)="The following Problem Selection List categories contain problems with ICD9 "
SET LN=LN+1
+20 SET ^TMP("GMPLMSG",$JOB,LN)="codes that have a future inactivation date. These Categories should be updated"
SET LN=LN+1
+21 SET ^TMP("GMPLMSG",$JOB,LN)="as soon as possible after the inactivation date to reduce the interruption of"
SET LN=LN+1
+22 SET ^TMP("GMPLMSG",$JOB,LN)="use of the selection list(s) by users or clinics."
SET LN=LN+1
+23 SET ^TMP("GMPLMSG",$JOB,LN)=""
SET LN=LN+1
+24 SET CAT=0
+25 FOR
SET CAT=$ORDER(^TMP("GMPLSL",$JOB,"F",CAT))
IF 'CAT
QUIT
Begin DoDot:2
+26 SET ^TMP("GMPLMSG",$JOB,LN)=" Category name: "_$$GET1^DIQ(125.11,CAT,.01)
+27 SET LN=LN+1
+28 SET ^TMP("GMPLMSG",$JOB,LN)=""
SET LN=LN+1
+29 SET ^TMP("GMPLMSG",$JOB,LN)=" Problems with ICD9 codes due to be inactivated:"
SET LN=LN+1
+30 SET ^TMP("GMPLMSG",$JOB,LN)=""
SET LN=LN+1
+31 NEW PROB,TXT
+32 SET PROB=0
+33 FOR
SET PROB=$ORDER(^TMP("GMPLSL",$JOB,"F",CAT,PROB))
IF 'PROB
QUIT
Begin DoDot:3
+34 SET TXT=^TMP("GMPLSL",$JOB,"F",CAT,PROB)
+35 SET ^TMP("GMPLMSG",$JOB,LN)=" Problem text: "_$PIECE(TXT,U)
SET LN=LN+1
+36 SET ^TMP("GMPLMSG",$JOB,LN)=" Display text: "_$PIECE(TXT,U,2)
SET LN=LN+1
+37 SET ^TMP("GMPLMSG",$JOB,LN)=" Code: "_$PIECE(TXT,U,3)
SET LN=LN+1
+38 SET ^TMP("GMPLMSG",$JOB,LN)=" Inactive Date: "_$$FMTE^XLFDT($PIECE(TXT,U,4),2)
SET LN=LN+1
+39 SET ^TMP("GMPLMSG",$JOB,LN)=""
SET LN=LN+1
End DoDot:3
+40 ; category not part of lists
IF '$DATA(^TMP("GMPLSL",$JOB,"F",CAT,"L"))
QUIT
+41 SET ^TMP("GMPLMSG",$JOB,LN)=""
SET LN=LN+1
+42 SET ^TMP("GMPLMSG",$JOB,LN)=" This Category is part of the following Problem Selection Lists:"
SET LN=LN+1
+43 SET LIST=0
+44 FOR
SET LIST=$ORDER(^TMP("GMPLSL",$JOB,"F",CAT,"L",LIST))
IF 'LIST
QUIT
Begin DoDot:3
+45 SET ^TMP("GMPLMSG",$JOB,LN)=" "_^TMP("GMPLSL",$JOB,"F",CAT,"L",LIST)
+46 SET LN=LN+1
End DoDot:3
+47 SET ^TMP("GMPLMSG",$JOB,LN)=""
SET LN=LN+1
+48 SET ^TMP("GMPLMSG",$JOB,LN)=""
SET LN=LN+1
+49 QUIT
End DoDot:2
End DoDot:1
+50 ; no problems found
IF '$DATA(^TMP("GMPLSL",$JOB))
Begin DoDot:1
+51 SET ^TMP("GMPLMSG",$JOB,LN)="No Problems Selection List corrections/review required"
+52 SET LN=LN+1
End DoDot:1
+53 SET XMY("G.GMPL CODE SET VERSION UPDATES")=""
+54 SET XMSUB="Problem Selection List Code Set Version review"
+55 SET XMDUZ="Code Set Version Install"
+56 SET XMTEXT="^TMP(""GMPLMSG"",$J,"
+57 DO ^XMD
+58 KILL ^TMP("GMPLSL",$JOB),^TMP("GMPLMSG",$JOB)
+59 QUIT
+60 ;
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,LST,LIST,PAGE
+4 DO CKLISTS
DO CKCODES
+5 SET PAGE=1
DO PAGE(.PAGE)
+6 ; no problems found
IF '$DATA(^TMP("GMPLSL",$JOB))
Begin DoDot:1
+7 WRITE !,"No Problems Selection List corrections/review required"
+8 IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:2
+9 NEW DIR,DTOUT,DIRUT,DUOUT,X,Y
+10 SET DIR(0)="E"
DO ^DIR
End DoDot:2
+11 QUIT
End DoDot:1
+12 ;
+13 ; some inactive problem codes
IF $DATA(^TMP("GMPLSL",$JOB,"I"))
Begin DoDot:1
+14 WRITE !,"The following Problem Selection List(s) contain one or more problems that"
+15 WRITE !,"have inactive ICD-9 codes attached to them. Any current users or clinics using"
+16 WRITE !,"these Selection Lists, will not be able to add the problems with inactive "
+17 WRITE !,"codes, until the list and the inactive codes are updated. The list may not be"
+18 WRITE !,"assigned to any additional users or clinics until updated.",!
+19 SET LST=0
+20 FOR
SET LST=$ORDER(^TMP("GMPLSL",$JOB,"I",LST))
IF 'LST!(PAGE<1)
QUIT
Begin DoDot:2
+21 IF IOSL-$Y<3
DO PAGE(.PAGE)
IF 'PAGE
QUIT
+22 WRITE !," "_^TMP("GMPLSL",$JOB,"I",LST)
End DoDot:2
End DoDot:1
+23 ;
+24 ; future inact. dates
IF $DATA(^TMP("GMPLSL",$JOB,"F"))
Begin DoDot:1
+25 DO PAGE(.PAGE)
IF 'PAGE
QUIT
+26 WRITE !,"The following Problem Selection List categories contain problems with ICD9 "
+27 WRITE !,"codes that have a future inactivation date. These Categories should be updated"
+28 WRITE !,"as soon as possible after the inactivation date to reduce the interruption of"
+29 WRITE !,"use of the selection list(s) by users or clinics.",!
+30 SET CAT=0
+31 FOR
SET CAT=$ORDER(^TMP("GMPLSL",$JOB,"F",CAT))
IF 'CAT
QUIT
Begin DoDot:2
+32 IF IOSL-$Y<8
DO PAGE(.PAGE)
IF 'PAGE
QUIT
+33 WRITE !!!," Category name: "_$$GET1^DIQ(125.11,CAT,.01),!
+34 WRITE !," Problems with ICD9 codes due to be inactivated:",!
+35 NEW PROB,TXT
+36 SET PROB=0
+37 FOR
SET PROB=$ORDER(^TMP("GMPLSL",$JOB,"F",CAT,PROB))
IF 'PROB!(PAGE<1)
QUIT
Begin DoDot:3
+38 SET TXT=^TMP("GMPLSL",$JOB,"F",CAT,PROB)
+39 IF IOSL-$Y<5
DO PAGE(.PAGE)
IF 'PAGE
QUIT
+40 WRITE !," Problem text: "_$PIECE(TXT,U)
+41 WRITE !," Display text: "_$PIECE(TXT,U,2)
+42 WRITE !," Code: "_$PIECE(TXT,U,3)
+43 WRITE !," Inactive Date: "_$PIECE(TXT,U,4),!
End DoDot:3
+44 ; category not part of lists
IF '$DATA(^TMP("GMPLSL",$JOB,"F",CAT,"L"))
QUIT
+45 IF IOSL-$Y<3
DO PAGE(.PAGE)
IF 'PAGE
QUIT
+46 WRITE !!," This Category is part of the following Problem Selection Lists:",!
+47 SET LIST=0
+48 FOR
SET LIST=$ORDER(^TMP("GMPLSL",$JOB,"F",CAT,"L",LIST))
IF 'LIST!(PAGE<1)
QUIT
Begin DoDot:3
+49 IF IOSL-$Y<3
DO PAGE(.PAGE)
IF 'PAGE
QUIT
+50 WRITE !," "_^TMP("GMPLSL",$JOB,"F",CAT,"L",LIST)
End DoDot:3
+51 QUIT
End DoDot:2
+52 QUIT
End DoDot:1
+53 IF $EXTRACT(IOST,1,2)'="C-"
DO ^%ZISC
+54 DO HOME^%ZIS
+55 KILL ^TMP("GMPLSL",$JOB)
+56 QUIT
+57 ;
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
+6 SET LST=0
+7 FOR
SET LST=$ORDER(^GMPL(125,LST))
IF 'LST
QUIT
IF '$$VALLIST^GMPLBLD2(LST)
Begin DoDot:1
+8 SET ^TMP("GMPLSL",$JOB,"I",LST)=$PIECE(^GMPL(125,LST,0),U)
+9 QUIT
End DoDot:1
+10 QUIT
+11 ;
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 PROB,CAT,LIST
+8 SET PROB=0
+9 FOR
SET PROB=$ORDER(^GMPL(125.12,PROB))
IF 'PROB
QUIT
IF $LENGTH($PIECE(^(PROB,0),U,5))
Begin DoDot:1
+10 NEW PROB0,PROBTX,APIDATA,PROBCAT,ACTDT
+11 SET PROB0=^GMPL(125.12,PROB,0)
+12 ;already inactive
IF '$$STATCHK^ICDAPIU($PIECE(PROB0,U,5),DT)
QUIT
+13 SET APIDATA=$$HIST^ICDAPIU($PIECE(PROB0,U,5),.APIDATA)
+14 SET ACTDT=+$ORDER(APIDATA(DT))
+15 ; no future activity
IF 'ACTDT
QUIT
+16 ; no future inactivation = OK
IF $GET(APIDATA(ACTDT))
QUIT
+17 SET PROBTX=$$GET1^DIQ(125.12,PROB,2)
+18 SET PROBCAT=$PIECE(PROB0,U)
+19 SET ^TMP("GMPLSL",$JOB,"F",PROBCAT,PROB)=PROBTX_U_$PIECE(PROB0,U,4)_U_$PIECE(PROB0,U,5)_U_$$FMTE^XLFDT(ACTDT)
+20 QUIT
End DoDot:1
+21 ;
+22 ; find lists that contain the categories
+23 SET CAT=0
+24 FOR
SET CAT=$ORDER(^TMP("GMPLSL",$JOB,"F",CAT))
IF 'CAT
QUIT
Begin DoDot:1
+25 ; category not part of any lists
IF '$DATA(^GMPL(125.1,"G",CAT))
QUIT
+26 NEW LIST
SET LIST=0
+27 FOR
SET LIST=$ORDER(^GMPL(125.1,"G",CAT,LIST))
IF 'LIST
QUIT
Begin DoDot:2
+28 SET ^TMP("GMPLSL",$JOB,"F",CAT,"L",LIST)=$$GET1^DIQ(125.1,LIST,.01)
+29 QUIT
End DoDot:2
+30 QUIT
End DoDot:1
+31 QUIT
+32 ;
PAGE(NUM) ;print header and raise page number
+1 IF '$GET(NUM)
QUIT
+2 IF NUM'=1
IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+3 NEW DIR,DTOUT,DIRUT,DUOUT,X,Y
+4 SET DIR(0)="E"
DO ^DIR
+5 IF $DATA(DTOUT)!($DATA(DUOUT))
SET NUM=0
End DoDot:1
IF 'NUM
QUIT
+6 WRITE @IOF
+7 WRITE "Code Set Version review of Problem Selection Lists"
+8 WRITE ?70,"Page: ",NUM
+9 WRITE !,$$REPEAT^XLFSTR("-",78)
+10 SET NUM=NUM+1
+11 QUIT
