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

GMPLBLD.m

Go to the documentation of this file.
  1. GMPLBLD ; SLC/MKB/TC -- Build Problem Selection Lists ;02/22/17 14:07
  1. ;;2.0;Problem List;**3,28,33,36,42,49**;Aug 25, 1994;Build 43
  1. ;
  1. ; External References:
  1. ; ICR 2056 $$GET1^DIQ
  1. ; ICR 4083 $$STATCHK^LEXSRC2
  1. ; ICR 5747 $$CODECS^ICDEX,$$STATCHK^ICDEX
  1. ; ICR 10026 ^DIR
  1. ; ICR 10103 $$DT^XLFDT,$$FMTE^XLFDT
  1. ; ICR 10116 FULL^VALM1
  1. ; ICR 10117 CNTRL^VALM10
  1. ; ICR 10118 EN^VALM
  1. ;
  1. EN ; -- main entry point
  1. D EN^VALM("GMPL SELECTION LIST BUILD")
  1. Q
  1. ;
  1. HDR ; -- header code
  1. N NAME,NUM,DATE
  1. S NUM=+^TMP("GMPLST",$J,0)_" categor"_$S(+^TMP("GMPLST",$J,0)'=1:"ies",1:"y")
  1. S DATE="Last Modified: "_$S(+$P(GMPLSLST,U,3):$$FMTE^XLFDT($P(GMPLSLST,U,3)),1:"<new list>")
  1. S VALMHDR(1)=DATE_$J(NUM,79-$L(DATE))
  1. S NAME=$P(GMPLSLST,U,2),VALMHDR(2)=$J(NAME,$L(NAME)\2+41)
  1. Q
  1. ;
  1. INIT ; -- init variables and list array
  1. S GMPLSLST=$$LIST^GMPLBLD2("L") I GMPLSLST="^" S VALMQUIT=1 Q
  1. L +^GMPL(125,+GMPLSLST,0):1 I '$T D G INIT
  1. . W $C(7),!!,"This list is currently being edited by another user!",!
  1. S GMPLMODE="E",VALMSG=$$MSG^GMPLX
  1. D GETLIST,BUILD("^TMP(""GMPLIST"",$J)",GMPLMODE)
  1. ;D LENGTH
  1. Q
  1. ;
  1. GETLIST ; Build ^TMP("GMPLIST",$J,#)
  1. N GRP,ITEM,CNT,GMPLDA K ^TMP("GMPLIST",$J) S CNT=0,(GMPLDA,GMPLCSQ)=""
  1. W !,"Searching for the list ..."
  1. F S GMPLCSQ=$O(^GMPL(125,"AD",+GMPLSLST,GMPLCSQ)) Q:'GMPLCSQ D
  1. . F S GMPLDA=$O(^GMPL(125,"AD",+GMPLSLST,GMPLCSQ,GMPLDA)) Q:GMPLDA'>0 D
  1. . . S ITEM=$G(^GMPL(125,+GMPLSLST,1,GMPLDA,0)),GRP=$P(ITEM,U,1)
  1. . . S ^TMP("GMPLIST",$J,GMPLDA)=$G(ITEM),CNT=CNT+1 ; group ^ seq ^ subhdr ^ probs
  1. . . S (^TMP("GMPLIST",$J,"GRP",GRP),^TMP("GMPLIST",$J,"SEQ",GMPLCSQ))=GMPLDA
  1. S ^TMP("GMPLIST",$J,0)=CNT
  1. Q
  1. ;
  1. BUILD(LIST,MODE) ; Build ^TMP("GMPLST",$J,)
  1. N LCNT,NUM,HDR,GROUP,GMPSEQ,ITEM,IFN,PSEQ,GMPIFN,GMPLCSQ,GMPDT,GMPCLASS,GMPLSHDR,GMPLCOL D CLEAN^VALM10
  1. S:'$D(^TMP("GMPLIST",$J,0)) ^TMP("GMPLIST",$J,0)=0
  1. I $P($G(^TMP("GMPLIST",$J,0)),U,1)'>0 S ^TMP("GMPLST",$J,1,0)=" ",^TMP("GMPLST",$J,2,0)="No items available.",^TMP("GMPLST",$J,0)="0^2",VALMCNT=2 Q
  1. S (LCNT,NUM,GMPSEQ)=0,GMPDT=$$DT^XLFDT
  1. F S GMPSEQ=$O(^TMP("GMPLIST",$J,"SEQ",GMPSEQ)) Q:GMPSEQ'>0 D
  1. . S GMPIFN=^TMP("GMPLIST",$J,"SEQ",GMPSEQ),LCNT=LCNT+1,NUM=NUM+1
  1. . S GROUP=$P(^TMP("GMPLIST",$J,GMPIFN),U,1),GMPLCSQ=$P(^TMP("GMPLIST",$J,GMPIFN),U,2)
  1. . S HDR=$P(^TMP("GMPLIST",$J,GMPIFN),U,3),GMPCLASS=$$GET1^DIQ(125.11,""_GROUP_",",.03)
  1. . S:'$L(HDR) HDR="<no header>"
  1. . S HDR=HDR_" ("_GMPCLASS_")"
  1. . I LCNT>1,+$P(^TMP("GMPLIST",$J,GMPIFN),U,4),^TMP("GMPLST",$J,LCNT-1,0)'=" " S LCNT=LCNT+1,^TMP("GMPLST",$J,LCNT,0)=" "
  1. . S GMPLSHDR=$J(NUM,3)_" "_HDR
  1. . S ^TMP("GMPLST",$J,LCNT,0)=$S(MODE="I":"<"_GMPLCSQ_">",1:" ")_GMPLSHDR,^TMP("GMPLST",$J,"B",NUM)=GMPIFN
  1. . S GMPLCOL=(($L(^TMP("GMPLST",$J,LCNT,0)))-($L(GMPLSHDR)))+1
  1. . D CNTRL^VALM10(LCNT,GMPLCOL,$L(GMPLSHDR),IOINHI,IOINORM)
  1. . Q:'+$P(^TMP("GMPLIST",$J,GMPIFN),U,4)
  1. . D CNTRL^VALM10(LCNT,8,$L(HDR),IOUON,IOUOFF)
  1. . F PSEQ=0:0 S PSEQ=$O(^GMPL(125.11,"C",+GROUP,PSEQ)) Q:PSEQ'>0 D
  1. .. N GMPCSYS,GMPLSCT,GMPLICD,GMPSCTC,GMPICD,GMPDTXT S (GMPLSCT,GMPLICD)=0
  1. .. S IFN=$O(^GMPL(125.11,"C",+GROUP,PSEQ,0)),LCNT=LCNT+1
  1. .. S ITEM=$G(^GMPL(125.11,+GROUP,1,IFN,0)),GMPDTXT=$P(ITEM,U,3)
  1. .. S GMPSCTC=$P(ITEM,U,5),GMPICD=$P(ITEM,U,4)
  1. .. S ^TMP("GMPLST",$J,LCNT,0)=" "_GMPDTXT
  1. .. I $L(GMPSCTC) D
  1. ... I $$STATCHK^LEXSRC2(GMPSCTC,GMPDT,"","SCT") Q
  1. ... S GMPLSCT=1
  1. .. I $L(GMPICD) D
  1. ... N GMI,GMPCSPTR,GMPCSREC,GMPCSNME
  1. ... S GMPCSREC=$$CODECS^ICDEX($P(GMPICD,"/"),80,GMPDT),GMPCSPTR=$P(GMPCSREC,U),GMPCSNME=$P(GMPCSREC,U,2)
  1. ... S ^TMP("GMPLST",$J,LCNT,0)=^TMP("GMPLST",$J,LCNT,0)_" ("_GMPCSNME_" "_GMPICD_")"
  1. ... F GMI=1:1:$L(GMPICD,"/") D
  1. .... I $$STATCHK^ICDEX($P(GMPICD,"/",GMI),GMPDT,GMPCSPTR) Q ; code is active
  1. .... S GMPLICD=1
  1. .. S GMPCSYS=$S(GMPLSCT:"SCT",GMPLICD:"ICD",(GMPLSCT&GMPLICD):"SCT/ICD",1:"")
  1. .. S:GMPCSYS'="" ^TMP("GMPLST",$J,LCNT,0)=^TMP("GMPLST",$J,LCNT,0)_" <INACTIVE "_GMPCSYS_" CODE>"
  1. . S LCNT=LCNT+1,^TMP("GMPLST",$J,LCNT,0)=" "
  1. S ^TMP("GMPLST",$J,0)=NUM_U_LCNT,VALMCNT=LCNT
  1. Q
  1. ;
  1. HELP ; -- help code
  1. N X
  1. W !!?4,"You may take a variety of actions to update this selection list."
  1. W !?4,"New categories may be added to this list, or an existing one"
  1. W !?4,"removed; Edit Category will allow you to change the contents of"
  1. W !?4,"a category, or create a new one that may be added to this list."
  1. W !?4,"You may also change how each category appears in this list,"
  1. W !?4,"view each category's sequence number to facilitate resequencing,"
  1. W !?4,"assign this list to a clinic or user(s), or edit a different list."
  1. W !!,"Press <return> to continue ..." R X:DTIME
  1. S VALMSG=$$MSG^GMPLX,VALMBCK=$S(VALMCC:"",1:"R")
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. N GMPDT
  1. I $D(GMPLSAVE),$$CKSAVE^GMPLBLD2 D
  1. . S GMPDT=$$DT^XLFDT
  1. . D SAVE^GMPLBLD2
  1. . S ^GMPL(125,+GMPLSLST,0)=$P(GMPLSLST,U,2)_U_GMPDT_U_$P(GMPLSLST,U,4)_U_$P(GMPLSLST,U,5)
  1. L -^GMPL(125,+GMPLSLST,0)
  1. K GMPLIST,GMPLST,GMPLMODE,GMPLSLST,GMPLSAVE,GMPREBLD,GMPQUIT,RT,TMPLST
  1. K ^TMP("GMPLIST",$J),^TMP("GMPLST",$J)
  1. Q
  1. ;
  1. ADD ; Add group(s)
  1. N SEQ,GROUP,HDR,IFN,GMPQUIT,GMPREBLD D FULL^VALM1
  1. I $P($G(GMPLSLST),U,5)="N" W !!,"Cannot make edits to a National list." H 2 G ADQ
  1. F D Q:$D(GMPQUIT) W !
  1. . S GROUP=$$GROUP^GMPLBLD2("") I GROUP="^" S GMPQUIT=1 Q
  1. . I $P(GROUP,U,4)="N" D Q
  1. . . W !!,"Cannot add a National category to a list. Please use the Copy to New Category"
  1. . . W !,"menu action under the Enter/Edit Category menu to copy into a local category."
  1. . . H 2 G ADQ
  1. . I $D(^TMP("GMPLIST",$J,"GRP",+GROUP)) W !?4,">>> This category is already part of this list!" Q
  1. . I '$$VALGRP^GMPLBLD2(+GROUP) D Q
  1. . . D FULL^VALM1
  1. . . W !!,$C(7),"This category contains one or more problems with inactive SNOMED and/or ICD"
  1. . . W !,"codes. These codes must be updated before adding the category to a selection"
  1. . . W !,"list."
  1. . . N DIR,DTOUT,DIRUT,DUOUT,X,Y
  1. . . S DIR(0)="E" D ^DIR
  1. . . S VALMBCK="R"
  1. . S HDR=$$HDR^GMPLBLD1($P(GROUP,U,2)) I HDR="^" S GMPQUIT=1 Q
  1. . S RT="^TMP(""GMPLIST"",$J,""SEQ"",",SEQ=+$$LAST^GMPLBLD2(RT)+1
  1. . S SEQ=$$SEQ^GMPLBLD1(SEQ) I SEQ="^" S GMPQUIT=1 Q
  1. . S IFN=$$TMPIFN^GMPLBLD1,^TMP("GMPLIST",$J,IFN)=+GROUP_U_SEQ_U_HDR_"^1"
  1. . S (^TMP("GMPLIST",$J,"GRP",+GROUP),^TMP("GMPLIST",$J,"SEQ",SEQ))=IFN,^TMP("GMPLIST",$J,0)=^TMP("GMPLIST",$J,0)+1,GMPREBLD=1
  1. I $D(GMPREBLD) S VALMBCK="R",GMPLSAVE=1 D BUILD("^TMP(""GMPLIST"",$J)",GMPLMODE),HDR
  1. ADQ S VALMBCK="R",VALMSG=$$MSG^GMPLX
  1. Q
  1. ;
  1. EDIT ; Edit category contents
  1. N GMPLIST,GMPLST,GMPLMODE,GMPLGRP,GMPLSAVE
  1. I $P($G(GMPLSLST),U,5)="N" W !!,"Cannot make edits to a National list." H 2 G EDQ
  1. D EN^VALM("GMPL SELECTION GROUP BUILD")
  1. S GMPLMODE="E"
  1. D GETLIST,BUILD("TMP(""GMPLIST"",$J)",GMPLMODE)
  1. EDQ S VALMBCK="R",VALMSG=$$MSG^GMPLX
  1. Q
  1. ;
  1. REMOVE ; Remove group
  1. N NUM,IFN,SEQ,GRP,DIR,X,Y,GMPLCIEN S VALMBCK=""
  1. I $P($G(GMPLSLST),U,5)="N" W !!,"Cannot make edits to a National list." H 2 G RMQ
  1. S NUM=$$SEL1^GMPLBLD1 G:NUM="^" RMQ
  1. S IFN=$G(^TMP("GMPLST",$J,"B",NUM)) G:+IFN'>0 RMQ
  1. S GMPLCIEN=$P($G(^TMP("GMPLIST",$J,IFN)),U,1)
  1. I "@"[$G(^TMP("GMPLIST",$J,IFN)) W $C(7),!!,"Category is not part of this list!" H 2 G RMQ
  1. I $P(^GMPL(125.11,GMPLCIEN,0),U,3)="N",($P($G(GMPLSLST),U,5)="N") W $C(7),!!,"Category may not be removed from this National list!" H 2 G RMQ
  1. S DIR("A")="Are you sure you want to remove '"_$P(^TMP("GMPLIST",$J,IFN),U,3)_"'? "
  1. S DIR("?")="Enter YES to delete this category from the current list; enter NO to exit."
  1. S DIR(0)="YA",DIR("B")="NO" D ^DIR
  1. I 'Y W !?5,"< Nothing removed! >" H 1 G RMQ
  1. D DELETE^GMPLBLD1(IFN) S VALMBCK="R",GMPLSAVE=1
  1. D BUILD("^TMP(""GMPLIST"",$J)",GMPLMODE),HDR
  1. RMQ S:'VALMCC VALMBCK="R" S VALMSG=$$MSG^GMPLX
  1. Q
  1. ;
  1. LENGTH ;SHORTEN THE ICD9'S DESCRIPTION TO FIT SCREEN
  1. S LLCNT=0
  1. F S LLCNT=$O(^TMP("GMPLST",$J,LLCNT)) Q:LLCNT="" Q:LLCNT'?1N.N D
  1. .; I '$D(^TMP("GMPLST",$J,LLCNT,O)) Q
  1. . S ICD9VAR=^TMP("GMPLST",$J,LLCNT,0) I $L(ICD9VAR)>50 D
  1. .. S ICD9VAR=$P(ICD9VAR,"(",1)
  1. .. S ICD9VAR=$E(ICD9VAR,1,50)_" ("_$P(^TMP("GMPLST",$J,LLCNT,0),"(",2)
  1. .. S ^TMP("GMPLST",$J,LLCNT,0)=ICD9VAR
  1. Q