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/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
  1.  ;
  1.  ; External References:
  1.  ;   ICR  2056   $$GET1^DIQ
  1.  ;   ICR  5747   $$CODECS^ICDEX,$$STATCHK^ICDEX,$$HIST^ICDEX
  1.  ;   ICR  10026  ^DIR
  1.  ;   ICR  10063  ^%ZTLOAD
  1.  ;   ICR  10070  ^XMD
  1.  ;   ICR  10086  %ZIS,HOME^%ZIS
  1.  ;   ICR  10089  %ZISC
  1.  ;   ICR  10103  $$DT^XLFDT,$$FMTE^XLFDT
  1.  ;   ICR  10104  $$REPEAT^XLFSTR
  1.  Q
  1. CSVPEP ;called from protocol GMPL SELECTION LIST CSV EVENT
  1.  N CAT,LN,GMPLST,LIST,SUB,GMPXMSUB,GMPLTO,GMPLFROM,GMPLCAT,GMPLI
  1.  D CKLISTS,CKCODES
  1.  S SUB="GMPLMSG",LN=1
  1.  K ^TMP(SUB,$J)
  1.  I '$D(^TMP("GMPLSL",$J)) D  ; no problems found
  1.  . S ^TMP(SUB,$J,LN,0)="No Problems Selection List corrections/review required"
  1.  ;
  1.  I $D(^TMP("GMPLSL",$J,"I")) D  ; some inactive problem codes
  1.  . S ^TMP(SUB,$J,LN,0)="The following Problem Selection List(s) contain one or more problems that have",LN=LN+1
  1.  . S ^TMP(SUB,$J,LN,0)="inactive SNOMED and/or ICD codes attached to them. Any current users or clinics",LN=LN+1
  1.  . S ^TMP(SUB,$J,LN,0)="using these Selection Lists, will not be able to add the problems with inactive",LN=LN+1
  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
  1.  . S ^TMP(SUB,$J,LN,0)="assigned to any additional users or clinics until updated.",LN=LN+1
  1.  . S (GMPLST,GMPLCAT,GMPLI)=0
  1.  . F  S GMPLST=$O(^TMP("GMPLSL",$J,"I",GMPLST)) Q:GMPLST=""  D
  1.  . . S ^TMP(SUB,$J,LN,0)="",LN=LN+1
  1.  . . S ^TMP(SUB,$J,LN,0)=" "_GMPLST_":",LN=LN+1
  1.  . . F  S GMPLCAT=$O(^TMP("GMPLSL",$J,"I",GMPLST,GMPLCAT)) Q:GMPLCAT=""  D
  1.  . . . S ^TMP(SUB,$J,LN,0)="   "_GMPLCAT_":",LN=LN+1
  1.  . . . F  S GMPLI=$O(^TMP("GMPLSL",$J,"I",GMPLST,GMPLCAT,GMPLI)) Q:GMPLI=""  D
  1.  . . . . N GMPLREC,GMPLDTXT,GMPLICD,GMPLCSYS,GMPLPROB,GMPLTEXT,GMPLK
  1.  . . . . S GMPLREC=$G(^TMP("GMPLSL",$J,"I",GMPLST,GMPLCAT,GMPLI)),GMPLK=0
  1.  . . . . S GMPLDTXT=$P(GMPLREC,U),GMPLICD=$P(GMPLREC,U,2),GMPLCSYS=$P(GMPLREC,U,3)
  1.  . . . . S GMPLPROB="     "_GMPLDTXT_" "_GMPLICD_"   <INACTIVE "_GMPLCSYS_" CODE>"
  1.  . . . . D WRAP^GMPLX(GMPLPROB,79,.GMPLTEXT)
  1.  . . . . F  S GMPLK=$O(GMPLTEXT(GMPLK)) Q:GMPLK=""  D
  1.  . . . . . S ^TMP(SUB,$J,LN,0)=$S(GMPLK>1:"     "_GMPLTEXT(GMPLK),1:GMPLTEXT(GMPLK)),LN=LN+1
  1.  ;
  1.  I $D(^TMP("GMPLSL",$J,"F")) D  ;no future inact. dates
  1.  . S ^TMP(SUB,$J,LN,0)="",LN=LN+1
  1.  . S ^TMP(SUB,$J,LN,0)="",LN=LN+1
  1.  . S ^TMP(SUB,$J,LN,0)="The following Problem Selection List categories contain problems with ICD",LN=LN+1
  1.  . S ^TMP(SUB,$J,LN,0)="codes that have a future inactivation date. These Categories should be updated",LN=LN+1
  1.  . S ^TMP(SUB,$J,LN,0)="as soon as possible after the inactivation date to reduce the interruption of",LN=LN+1
  1.  . S ^TMP(SUB,$J,LN,0)="use of the selection list(s) by users or clinics.",LN=LN+1
  1.  . S ^TMP(SUB,$J,LN,0)="",LN=LN+1
  1.  . S CAT=0
  1.  . F  S CAT=$O(^TMP("GMPLSL",$J,"F",CAT)) Q:'CAT  D
  1.  . . S ^TMP(SUB,$J,LN,0)=" Category name: "_$$GET1^DIQ(125.11,CAT,.01),LN=LN+1
  1.  . . S ^TMP(SUB,$J,LN,0)="",LN=LN+1
  1.  . . S ^TMP(SUB,$J,LN,0)="    Problems with ICD codes due to be inactivated:",LN=LN+1
  1.  . . S ^TMP(SUB,$J,LN,0)="",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(SUB,$J,LN,0)="       Problem text: "_$P(TXT,U),LN=LN+1
  1.  . . . S ^TMP(SUB,$J,LN,0)="       Display text: "_$P(TXT,U,2),LN=LN+1
  1.  . . . S ^TMP(SUB,$J,LN,0)="               Code: "_$P(TXT,U,3),LN=LN+1
  1.  . . . S ^TMP(SUB,$J,LN,0)="      Inactive Date: "_$$FMTE^XLFDT($P(TXT,U,4),2),LN=LN+1
  1.  . . . S ^TMP(SUB,$J,LN,0)="",LN=LN+1
  1.  . . I '$D(^TMP("GMPLSL",$J,"F",CAT,"L")) Q  ; category not part of lists
  1.  . . S ^TMP(SUB,$J,LN,0)="",LN=LN+1
  1.  . . S ^TMP(SUB,$J,LN,0)="    This Category is part of the following Problem Selection Lists:",LN=LN+1
  1.  . . S ^TMP(SUB,$J,LN,0)="",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(SUB,$J,LN,0)="     "_^TMP("GMPLSL",$J,"F",CAT,"L",LIST),LN=LN+1
  1.  . . S ^TMP(SUB,$J,LN,0)="",LN=LN+1
  1.  . . S ^TMP(SUB,$J,LN,0)="",LN=LN+1
  1.  . . Q
  1.  S GMPXMSUB="Problem Selection List Code Set Version review"
  1.  S GMPLFROM="Code Set Version Install"
  1.  S GMPLTO("G.GMPL CODE SET VERSION UPDATES")=""
  1.  D SEND^GMPLUTL4(SUB,GMPXMSUB,.GMPLTO,GMPLFROM)
  1.  K ^TMP("GMPLSL",$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,GMPLST,LIST,PAGE,GMPLCAT,GMPLI,GMPLTITL
  1.  D CKLISTS,CKCODES
  1.  S GMPLTITL="Code Set Version Review of Problem Selection Lists"
  1.  S PAGE=1 D PAGE^GMPLSLRP(.PAGE,GMPLTITL)
  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 have"
  1.  . W !,"inactive SNOMED and/or ICD codes attached to them. Any current users or clinics"
  1.  . W !,"using 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 (GMPLST,GMPLCAT,GMPLI)=0
  1.  . F  S GMPLST=$O(^TMP("GMPLSL",$J,"I",GMPLST)) Q:GMPLST=""!(PAGE<1)  D
  1.  . . W !!," "_GMPLST_":"
  1.  . . F  S GMPLCAT=$O(^TMP("GMPLSL",$J,"I",GMPLST,GMPLCAT)) Q:GMPLCAT=""!(PAGE<1)  D
  1.  . . . W !,"   "_GMPLCAT_":"
  1.  . . . F  S GMPLI=$O(^TMP("GMPLSL",$J,"I",GMPLST,GMPLCAT,GMPLI)) Q:GMPLI=""!(PAGE<1)  D
  1.  . . . . I IOSL-$Y<3 D PAGE^GMPLSLRP(.PAGE,GMPLTITL) Q:'PAGE
  1.  . . . . N GMPLREC,GMPLDTXT,GMPLICD,GMPLCSYS,GMPLPROB,GMPLTEXT,GMPLK
  1.  . . . . S GMPLREC=$G(^TMP("GMPLSL",$J,"I",GMPLST,GMPLCAT,GMPLI)),GMPLK=0
  1.  . . . . S GMPLDTXT=$P(GMPLREC,U),GMPLICD=$P(GMPLREC,U,2),GMPLCSYS=$P(GMPLREC,U,3)
  1.  . . . . S GMPLPROB="     "_GMPLDTXT_" "_GMPLICD_"   <INACTIVE "_GMPLCSYS_" CODE>"
  1.  . . . . D WRAP^GMPLX(GMPLPROB,79,.GMPLTEXT)
  1.  . . . . F  S GMPLK=$O(GMPLTEXT(GMPLK)) Q:GMPLK=""  D
  1.  . . . . . W !,$S(GMPLK>1:"     "_GMPLTEXT(GMPLK),1:GMPLTEXT(GMPLK))
  1.  ;
  1.  I $D(^TMP("GMPLSL",$J,"F")) D  ; future inact. dates
  1.  . D PAGE^GMPLSLRP(.PAGE,GMPLTITL) Q:'PAGE
  1.  . W !,"The following Problem Selection List categories contain problems with ICD"
  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^GMPLSLRP(.PAGE,GMPLTITL) Q:'PAGE
  1.  .. W !!!," Category name: "_$$GET1^DIQ(125.11,CAT,.01),!
  1.  .. W !,"    Problems with ICD 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^GMPLSLRP(.PAGE,GMPLTITL) 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^GMPLSLRP(.PAGE,GMPLTITL) 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^GMPLSLRP(.PAGE,GMPLTITL) 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,GMPLCNME,GMPLSEQ,GMPLREC,GMPLCNT
  1.  S (LST,GMPLCNME,GMPLSEQ)=0
  1.  F  S LST=$O(^GMPL(125,LST)) Q:'LST  D
  1.  . N GMPLCLST
  1.  . I '$$VALLIST^GMPLBLD2(LST,"GMPLCLST") D
  1.  . . S GMPLCNT=0
  1.  . . I $D(GMPLCLST) D
  1.  . . . F  S GMPLCNME=$O(GMPLCLST(GMPLCNME)) Q:GMPLCNME=""  D
  1.  . . . . F  S GMPLSEQ=$O(GMPLCLST(GMPLCNME,GMPLSEQ)) Q:GMPLSEQ=""  D
  1.  . . . . . S GMPLREC=GMPLCLST(GMPLCNME,GMPLSEQ),GMPLCNT=GMPLCNT+1
  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)
  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 CAT,LIST,GMPCAT,GMPPSQ,GMPDA,GMPDT
  1.  S (GMPCAT,GMPPSQ,GMPDA)=0,GMPDT=$$DT^XLFDT
  1.  F  S GMPCAT=$O(^GMPL(125.11,"C",GMPCAT)) Q:'GMPCAT  D
  1.  . F  S GMPPSQ=$O(^GMPL(125.11,"C",GMPCAT,GMPPSQ)) Q:'GMPPSQ  D
  1.  . . F  S GMPDA=$O(^GMPL(125.11,"C",GMPCAT,GMPPSQ,GMPDA)) Q:'GMPDA  D
  1.  . . . I $L($P(^GMPL(125.11,GMPCAT,1,GMPDA,0),U,4)) D
  1.  . . . . N GMPL0,GMPPROB,GMPARY,GMPADT,GMPCSPTR,GMPICD
  1.  . . . . S GMPL0=$G(^GMPL(125.11,GMPCAT,1,GMPDA,0)),GMPICD=$P(GMPL0,U,4)
  1.  . . . . S GMPCSPTR=+$$CODECS^ICDEX(GMPICD,80,GMPDT)
  1.  . . . . I '$$STATCHK^ICDEX(GMPICD,GMPDT,GMPCSPTR) Q  ;already inactive
  1.  . . . . S GMPARY=$$HIST^ICDEX(GMPICD,.GMPARY,GMPCSPTR)
  1.  . . . . S GMPADT=+$O(GMPARY(GMPDT))
  1.  . . . . Q:'GMPADT  ; no future activity
  1.  . . . . I $G(GMPARY(GMPADT)) Q  ; no future inactivation = OK
  1.  . . . . S GMPPROB=$$GET1^DIQ(125.111,""_GMPDA_","_GMPCAT_",",.01)
  1.  . . . . S ^TMP("GMPLSL",$J,"F",GMPCAT,GMPDA)=GMPPROB_U_$P(GMPL0,U,3)_U_GMPICD_U_$$FMTE^XLFDT(GMPADT)
  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,"AC",CAT)) Q  ; category not part of any lists
  1.  . N LIST S LIST=0
  1.  . F  S LIST=$O(^GMPL(125,"AC",CAT,LIST)) Q:'LIST  D
  1.  .. S ^TMP("GMPLSL",$J,"F",CAT,"L",LIST)=$$GET1^DIQ(125,LIST,.01)
  1.  .. Q
  1.  . Q
  1.  Q