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 -- Build Problem Selection Lists ;09/22/11  15:14
  1.  ;;2.0;Problem List;**3,28,33,36**;Aug 25, 1994;Build 65
  1.  ;
  1.  ;This routine invokes IA #3991
  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 IFN,SEQ,GRP,ITEM,CNT K ^TMP("GMPLIST",$J) S CNT=0
  1.  W !,"Searching for the list ..."
  1.  F IFN=0:0 S IFN=$O(^GMPL(125.1,"B",+GMPLSLST,IFN)) Q:IFN'>0  D
  1.  . S ITEM=$G(^GMPL(125.1,IFN,0)),SEQ=$P(ITEM,U,2),GRP=$P(ITEM,U,3)
  1.  . S ^TMP("GMPLIST",$J,IFN)=$P(ITEM,U,2,5),CNT=CNT+1 ; seq ^ group ^ subhdr ^ probs
  1.  . S (^TMP("GMPLIST",$J,"GRP",GRP),^TMP("GMPLIST",$J,"SEQ",SEQ))=IFN
  1.  S ^TMP("GMPLIST",$J,0)=CNT
  1.  Q
  1.  ;
  1. BUILD(LIST,MODE) ; Build ^TMP("GMPLST",$J,)
  1.  N SEQ,LCNT,NUM,HDR,GROUP,IFN,ITEM,PSEQ 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,SEQ)=0
  1.  F  S SEQ=$O(^TMP("GMPLIST",$J,"SEQ",SEQ)) Q:SEQ'>0  D
  1.  . S IFN=^TMP("GMPLIST",$J,"SEQ",SEQ),LCNT=LCNT+1,NUM=NUM+1
  1.  . S GROUP=$P(^TMP("GMPLIST",$J,IFN),U,2),HDR=$P(^TMP("GMPLIST",$J,IFN),U,3)
  1.  . S:'$L(HDR) HDR="<no header>"
  1.  . I LCNT>1,+$P(^TMP("GMPLIST",$J,IFN),U,4),^TMP("GMPLST",$J,LCNT-1,0)'="   " S LCNT=LCNT+1,^TMP("GMPLST",$J,LCNT,0)="   "
  1.  . S ^TMP("GMPLST",$J,LCNT,0)=$S(MODE="I":$J("<"_SEQ_">",8),1:"        ")_$J(NUM,4)_" "_HDR,^TMP("GMPLST",$J,"B",NUM)=IFN
  1.  . D CNTRL^VALM10(LCNT,9,5,IOINHI,IOINORM)
  1.  . Q:'+$P(^TMP("GMPLIST",$J,IFN),U,4)
  1.  . D CNTRL^VALM10(LCNT,14,$L(HDR),IOUON,IOUOFF)
  1.  . F PSEQ=0:0 S PSEQ=$O(^GMPL(125.12,"C",+GROUP,PSEQ)) Q:PSEQ'>0  D
  1.  .. S IFN=$O(^GMPL(125.12,"C",+GROUP,PSEQ,0)),LCNT=LCNT+1
  1.  .. S ITEM=$G(^GMPL(125.12,IFN,0)),^TMP("GMPLST",$J,LCNT,0)="             "_$P(ITEM,U,4)
  1.  .. I $L($P(ITEM,U,5)) D
  1.  ... N GMI
  1.  ... S ^TMP("GMPLST",$J,LCNT,0)=^TMP("GMPLST",$J,LCNT,0)_" ("_$P(ITEM,U,5)_")"
  1.  ... F GMI=1:1:$L($P(ITEM,U,5),"/") D
  1.  .... I $$STATCHK^ICDAPIU($P($P(ITEM,U,5),"/",GMI),DT) Q  ; code is active
  1.  .... S ^TMP("GMPLST",$J,LCNT,0)=^TMP("GMPLST",$J,LCNT,0)_"    <INACTIVE 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.  I $D(GMPLSAVE),$$CKSAVE^GMPLBLD2 D
  1.  . D SAVE^GMPLBLD2
  1.  . S ^GMPL(125,+GMPLSLST,0)=$P(GMPLSLST,U,2)_U_DT_U_$P(GMPLSLST,U,4)
  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.  F  D  Q:$D(GMPQUIT)  W !
  1.  . S GROUP=$$GROUP^GMPLBLD2("") I GROUP="^" S GMPQUIT=1 Q
  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 ICD-9 codes. "
  1.  .. W !,"These codes must be updated before adding the category to a selection 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)=SEQ_U_+GROUP_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.  S VALMBCK="R",VALMSG=$$MSG^GMPLX
  1.  Q
  1.  ;
  1. EDIT ; Edit category contents
  1.  N GMPLIST,GMPLST,GMPLMODE,GMPLGRP,GMPLSAVE
  1.  D EN^VALM("GMPL SELECTION GROUP BUILD")
  1.  S GMPLMODE="E"
  1.  D GETLIST,BUILD("TMP(""GMPLIST"",$J)",GMPLMODE)
  1.  S VALMBCK="R",VALMSG=$$MSG^GMPLX
  1.  Q
  1.  ;
  1. REMOVE ; Remove group
  1.  N NUM,IFN,SEQ,GRP,DIR,X,Y S VALMBCK=""
  1.  S NUM=$$SEL1^GMPLBLD1 G:NUM="^" RMQ
  1.  S IFN=$G(^TMP("GMPLST",$J,"B",NUM)) G:+IFN'>0 RMQ
  1.  I "@"[$G(^TMP("GMPLIST",$J,IFN)) W $C(7),!!,"Category is not part of this 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