Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMPLBLCK

GMPLBLCK.m

Go to the documentation of this file. 
  1. GMPLBLCK ;SLC/JFR - check selection list ICD9 codes; 3/20/03 09:05
  1.  ;;2.0;Problem List;**28**;Aug 25, 1994
  1.  ;
  1.  ; This routine invokes IA #3990
  1.  Q
  1. CSVPEP ;called from protocol GMPL SELECTION LIST CSV EVENT
  1.  N CAT,LN,LST,LIST,XMSUB,XMTEXT,XMDUZ,XMY
  1.  D CKLISTS,CKCODES
  1.  K ^TMP("GMPLMSG",$J)
  1.  S LN=1
  1.  I $D(^TMP("GMPLSL",$J,"I")) D
  1.  . S ^TMP("GMPLMSG",$J,LN)="The following Problem Selection Lists contain one or more problems that",LN=LN+1
  1.  . S ^TMP("GMPLMSG",$J,LN)="have inactive ICD-9 codes attached to them. Any current users or clinics using",LN=LN+1
  1.  . S ^TMP("GMPLMSG",$J,LN)="these Selection Lists, will not be able to add the problems with inactive ",LN=LN+1
  1.  . S ^TMP("GMPLMSG",$J,LN)="codes, until the list and the inactive codes are updated. The list may not be",LN=LN+1
  1.  . S ^TMP("GMPLMSG",$J,LN)="assigned to any additional users or clinics until updated.",LN=LN+1
  1.  . S LST=0
  1.  . F  S LST=$O(^TMP("GMPLSL",$J,"I",LST)) Q:'LST  D
  1.  .. S ^TMP("GMPLMSG",$J,LN)="   "_^TMP("GMPLSL",$J,"I",LST)
  1.  .. S LN=LN+1
  1.  ;
  1.  I $D(^TMP("GMPLSL",$J,"F")) D  ;no future inact. dates
  1.  . S ^TMP("GMPLMSG",$J,LN)="",LN=LN+1
  1.  . S ^TMP("GMPLMSG",$J,LN)="",LN=LN+1
  1.  . S ^TMP("GMPLMSG",$J,LN)="The following Problem Selection List categories contain problems with ICD9 ",LN=LN+1
  1.  . S ^TMP("GMPLMSG",$J,LN)="codes that have a future inactivation date. These Categories should be updated",LN=LN+1
  1.  . S ^TMP("GMPLMSG",$J,LN)="as soon as possible after the inactivation date to reduce the interruption of",LN=LN+1
  1.  . S ^TMP("GMPLMSG",$J,LN)="use of the selection list(s) by users or clinics.",LN=LN+1
  1.  . S ^TMP("GMPLMSG",$J,LN)="",LN=LN+1
  1.  . S CAT=0
  1.  . F  S CAT=$O(^TMP("GMPLSL",$J,"F",CAT)) Q:'CAT  D
  1.  .. S ^TMP("GMPLMSG",$J,LN)=" Category name: "_$$GET1^DIQ(125.11,CAT,.01)
  1.  .. S LN=LN+1
  1.  .. S ^TMP("GMPLMSG",$J,LN)="",LN=LN+1
  1.  .. S ^TMP("GMPLMSG",$J,LN)="    Problems with ICD9 codes due to be inactivated:",LN=LN+1
  1.  .. S ^TMP("GMPLMSG",$J,LN)="",LN=LN+1
  1.  .. N PROB,TXT
  1.  .. S PROB=0
  1.  .. F  S PROB=$O(^TMP("GMPLSL",$J,"F",CAT,PROB)) Q:'PROB  D
  1.  ... S TXT=^TMP("GMPLSL",$J,"F",CAT,PROB)
  1.  ... S ^TMP("GMPLMSG",$J,LN)="       Problem text: "_$P(TXT,U),LN=LN+1
  1.  ... S ^TMP("GMPLMSG",$J,LN)="       Display text: "_$P(TXT,U,2),LN=LN+1
  1.  ... S ^TMP("GMPLMSG",$J,LN)="               Code: "_$P(TXT,U,3),LN=LN+1
  1.  ... S ^TMP("GMPLMSG",$J,LN)="      Inactive Date: "_$$FMTE^XLFDT($P(TXT,U,4),2),LN=LN+1
  1.  ... S ^TMP("GMPLMSG",$J,LN)="",LN=LN+1
  1.  .. I '$D(^TMP("GMPLSL",$J,"F",CAT,"L")) Q  ; category not part of lists
  1.  .. S ^TMP("GMPLMSG",$J,LN)="",LN=LN+1
  1.  .. S ^TMP("GMPLMSG",$J,LN)="    This Category is part of the following Problem Selection Lists:",LN=LN+1
  1.  .. S LIST=0
  1.  .. F  S LIST=$O(^TMP("GMPLSL",$J,"F",CAT,"L",LIST)) Q:'LIST  D
  1.  ... S ^TMP("GMPLMSG",$J,LN)="     "_^TMP("GMPLSL",$J,"F",CAT,"L",LIST)
  1.  ... S LN=LN+1
  1.  .. S ^TMP("GMPLMSG",$J,LN)="",LN=LN+1
  1.  .. S ^TMP("GMPLMSG",$J,LN)="",LN=LN+1
  1.  .. Q
  1.  I '$D(^TMP("GMPLSL",$J)) D  ; no problems found
  1.  . S ^TMP("GMPLMSG",$J,LN)="No Problems Selection List corrections/review required"
  1.  . S LN=LN+1
  1.  S XMY("G.GMPL CODE SET VERSION UPDATES")=""
  1.  S XMSUB="Problem Selection List Code Set Version review"
  1.  S XMDUZ="Code Set Version Install"
  1.  S XMTEXT="^TMP(""GMPLMSG"",$J,"
  1.  D ^XMD
  1.  K ^TMP("GMPLSL",$J),^TMP("GMPLMSG",$J)
  1.  Q
  1.  ;
  1. CSVOPT ; called from option GMPL SELECTION LIST CSV CHECK
  1.  ;
  1.  N %ZIS,POP
  1.  S %ZIS="QM" D ^%ZIS Q:POP
  1.  I $D(IO("Q")) D  D ^%ZISC,HOME^%ZIS Q
  1.  . N ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK
  1.  . S ZTDESC="Review of GMPL SEL LISTS for CSV"
  1.  . S ZTRTN="QUEUE^GMPLBLCK",ZTIO=ION,ZTDTH=$H
  1.  . D ^%ZTLOAD
  1.  . I '$G(ZTSK) W !,"Unable to task report"
  1.  . Q
  1.  ;
  1. QUEUE ; entry point for tasked report
  1.  I $D(ZTQUEUED) S ZTREQ="@"
  1.  U IO
  1.  N CAT,LN,LST,LIST,PAGE
  1.  D CKLISTS,CKCODES
  1.  S PAGE=1 D PAGE(.PAGE)
  1.  I '$D(^TMP("GMPLSL",$J)) D  ; no problems found
  1.  . W !,"No Problems Selection List corrections/review required"
  1.  . I $E(IOST,1,2)="C-" D
  1.  .. N DIR,DTOUT,DIRUT,DUOUT,X,Y
  1.  .. S DIR(0)="E" D ^DIR
  1.  . Q
  1.  ;
  1.  I $D(^TMP("GMPLSL",$J,"I")) D  ; some inactive problem codes
  1.  . W !,"The following Problem Selection List(s) contain one or more problems that"
  1.  . W !,"have inactive ICD-9 codes attached to them. Any current users or clinics using"
  1.  . W !,"these Selection Lists, will not be able to add the problems with inactive "
  1.  . W !,"codes, until the list and the inactive codes are updated. The list may not be"
  1.  . W !,"assigned to any additional users or clinics until updated.",!
  1.  . S LST=0
  1.  . F  S LST=$O(^TMP("GMPLSL",$J,"I",LST)) Q:'LST!(PAGE<1)  D
  1.  .. I IOSL-$Y<3 D PAGE(.PAGE) Q:'PAGE
  1.  .. W !,"   "_^TMP("GMPLSL",$J,"I",LST)
  1.  ;
  1.  I $D(^TMP("GMPLSL",$J,"F")) D  ; future inact. dates
  1.  . D PAGE(.PAGE) Q:'PAGE
  1.  . W !,"The following Problem Selection List categories contain problems with ICD9 "
  1.  . W !,"codes that have a future inactivation date. These Categories should be updated"
  1.  . W !,"as soon as possible after the inactivation date to reduce the interruption of"
  1.  . W !,"use of the selection list(s) by users or clinics.",!
  1.  . S CAT=0
  1.  . F  S CAT=$O(^TMP("GMPLSL",$J,"F",CAT)) Q:'CAT  D
  1.  .. I IOSL-$Y<8 D PAGE(.PAGE) Q:'PAGE
  1.  .. W !!!," Category name: "_$$GET1^DIQ(125.11,CAT,.01),!
  1.  .. W !,"    Problems with ICD9 codes due to be inactivated:",!
  1.  .. N PROB,TXT
  1.  .. S PROB=0
  1.  .. F  S PROB=$O(^TMP("GMPLSL",$J,"F",CAT,PROB)) Q:'PROB!(PAGE<1)  D
  1.  ... S TXT=^TMP("GMPLSL",$J,"F",CAT,PROB)
  1.  ... I IOSL-$Y<5 D PAGE(.PAGE) Q:'PAGE
  1.  ... W !,"       Problem text: "_$P(TXT,U)
  1.  ... W !,"       Display text: "_$P(TXT,U,2)
  1.  ... W !,"               Code: "_$P(TXT,U,3)
  1.  ... W !,"      Inactive Date: "_$P(TXT,U,4),!
  1.  .. I '$D(^TMP("GMPLSL",$J,"F",CAT,"L")) Q  ; category not part of lists
  1.  .. I IOSL-$Y<3 D PAGE(.PAGE) Q:'PAGE
  1.  .. W !!,"    This Category is part of the following Problem Selection Lists:",!
  1.  .. S LIST=0
  1.  .. F  S LIST=$O(^TMP("GMPLSL",$J,"F",CAT,"L",LIST)) Q:'LIST!(PAGE<1)  D
  1.  ... I IOSL-$Y<3 D PAGE(.PAGE) Q:'PAGE
  1.  ... W !,"     "_^TMP("GMPLSL",$J,"F",CAT,"L",LIST)
  1.  .. Q
  1.  . Q
  1.  D:$E(IOST,1,2)'="C-" ^%ZISC
  1.  D HOME^%ZIS
  1.  K ^TMP("GMPLSL",$J)
  1.  Q
  1.  ;
  1. CKLISTS ; loop lists and see if any inactive problems
  1.  ;
  1.  ; returns ^TMP("GMPLSL",$J,"I"
  1.  ;
  1.  K ^TMP("GMPLSL",$J,"I")
  1.  N LST
  1.  S LST=0
  1.  F  S LST=$O(^GMPL(125,LST)) Q:'LST  I '$$VALLIST^GMPLBLD2(LST) D
  1.  . S ^TMP("GMPLSL",$J,"I",LST)=$P(^GMPL(125,LST,0),U)
  1.  . Q
  1.  Q
  1.  ;
  1. CKCODES ; check probs on lists for future inactivation dates
  1.  ;
  1.  ; returns:
  1.  ;   ^TMP("GMPLSL",$J,"F",category,problem)
  1.  ;   ^TMP("GMPLSL",$J,"F",category,"L",list)
  1.  ;
  1.  K ^TMP("GMPLSL",$J,"F")
  1.  N PROB,CAT,LIST
  1.  S PROB=0
  1.  F  S PROB=$O(^GMPL(125.12,PROB)) Q:'PROB  I $L($P(^(PROB,0),U,5)) D
  1.  . N PROB0,PROBTX,APIDATA,PROBCAT,ACTDT
  1.  . S PROB0=^GMPL(125.12,PROB,0)
  1.  . I '$$STATCHK^ICDAPIU($P(PROB0,U,5),DT) Q  ;already inactive
  1.  . S APIDATA=$$HIST^ICDAPIU($P(PROB0,U,5),.APIDATA)
  1.  . S ACTDT=+$O(APIDATA(DT))
  1.  . Q:'ACTDT  ; no future activity
  1.  . I $G(APIDATA(ACTDT)) Q  ; no future inactivation = OK
  1.  . S PROBTX=$$GET1^DIQ(125.12,PROB,2)
  1.  . S PROBCAT=$P(PROB0,U)
  1.  . S ^TMP("GMPLSL",$J,"F",PROBCAT,PROB)=PROBTX_U_$P(PROB0,U,4)_U_$P(PROB0,U,5)_U_$$FMTE^XLFDT(ACTDT)
  1.  . Q
  1.  ;
  1.  ; find lists that contain the categories
  1.  S CAT=0
  1.  F  S CAT=$O(^TMP("GMPLSL",$J,"F",CAT)) Q:'CAT  D
  1.  . I '$D(^GMPL(125.1,"G",CAT)) Q  ; category not part of any lists
  1.  . N LIST S LIST=0
  1.  . F  S LIST=$O(^GMPL(125.1,"G",CAT,LIST)) Q:'LIST  D
  1.  .. S ^TMP("GMPLSL",$J,"F",CAT,"L",LIST)=$$GET1^DIQ(125.1,LIST,.01)
  1.  .. Q
  1.  . Q
  1.  Q
  1.  ;
  1. PAGE(NUM) ;print header and raise page number
  1.  Q:'$G(NUM)
  1.  I NUM'=1,$E(IOST,1,2)="C-" D  Q:'NUM
  1.  . N DIR,DTOUT,DIRUT,DUOUT,X,Y
  1.  . S DIR(0)="E" D ^DIR
  1.  . I $D(DTOUT)!($D(DUOUT)) S NUM=0
  1.  W @IOF
  1.  W "Code Set Version review of Problem Selection Lists"
  1.  W ?70,"Page: ",NUM
  1.  W !,$$REPEAT^XLFSTR("-",78)
  1.  S NUM=NUM+1
  1.  Q