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

GMPLBLDC.m

Go to the documentation of this file. 
  1. GMPLBLDC ; SLC/MKB -- Build Problem Selection Categories ;09/22/11  14:31
  1.  ;;2.0;Problem List;**3,7,28,36**;Aug 25, 1994;Build 65
  1.  ;
  1.  ; This routine invokes IA #3991
  1.  ;
  1. EN ; -- main entry point for GMPL SELECTION GROUP BUILD
  1.  D EN^VALM("GMPL SELECTION GROUP BUILD")
  1.  Q
  1.  ;
  1. HDR ; -- header code
  1.  N NAME,NUM,DATE S NUM=+^TMP("GMPLST",$J,0)_" problem"_$S(+^TMP("GMPLST",$J,0)'=1:"s",1:"")
  1.  S DATE="Last Modified: "_$S(+$P(GMPLGRP,U,3):$$FMTE^XLFDT($P(GMPLGRP,U,3)),1:"<new category>")
  1.  S VALMHDR(1)=DATE_$J(NUM,79-$L(DATE))
  1.  S NAME=$P(GMPLGRP,U,2),VALMHDR(2)=$J(NAME,$L(NAME)\2+41)
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1.  S GMPLGRP=$$GROUP^GMPLBLD2("L") I GMPLGRP="^" S VALMQUIT=1 Q
  1.  L +^GMPL(125.11,+GMPLGRP,0):1 I '$T D  G INIT
  1.  . W $C(7),!!,"This category is currently being edited by another user!",!
  1.  S GMPLMODE="E",VALMSG=$$MSG^GMPLX
  1.  D GETLIST,BUILD("^TMP(""GMPLIST"",$J)",GMPLMODE)
  1.  Q
  1.  ;
  1. GETLIST ; Build ^TMP("GMPLIST",$J,#) of problems
  1.  N SEQ,IFN,ITEM,PROB,CNT K ^TMP("GMPLIST",$J) S CNT=0
  1.  W !,"Searching for the problems ..."
  1.  F IFN=0:0 S IFN=$O(^GMPL(125.12,"B",+GMPLGRP,IFN)) Q:IFN'>0  D
  1.  . S ITEM=$G(^GMPL(125.12,IFN,0)),SEQ=$P(ITEM,U,2),PROB=$P(ITEM,U,3)
  1.  . S ^TMP("GMPLIST",$J,IFN)=$P(ITEM,U,2,7),CNT=CNT+1 ; seq ^ prob ^ text ^ code ^ snomed ct concept ^ snomed ct designation
  1.  . S (^TMP("GMPLIST",$J,"PROB",PROB),^TMP("GMPLIST",$J,"SEQ",SEQ))=IFN ; Xrefs
  1.  S ^TMP("GMPLIST",$J,0)=CNT
  1.  Q
  1.  ;
  1. BUILD(LIST,MODE) ; Build ^TMP("GMPLST",$J,) of current items in LIST for display
  1.  N SEQ,LCNT,NUM,PROB,TEXT,IFN,ITEM,CODE D CLEAN^VALM10
  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.  . N GMI
  1.  . S IFN=^TMP("GMPLIST",$J,"SEQ",SEQ),LCNT=LCNT+1,NUM=NUM+1
  1.  . S PROB=$P(^TMP("GMPLIST",$J,IFN),U,2),TEXT=$P(^TMP("GMPLIST",$J,IFN),U,3),CODE=$P(^TMP("GMPLIST",$J,IFN),U,4)
  1.  . S ^TMP("GMPLST",$J,LCNT,0)=$S(MODE="I":$J("<"_SEQ_">",8),1:"        ")_$J(NUM,4)_" "_TEXT
  1.  . I $L(CODE) D
  1.  .. S ^TMP("GMPLST",$J,LCNT,0)=^TMP("GMPLST",$J,LCNT,0)_" ("_CODE_")"
  1.  .. F GMI=1:1:$L(CODE,"/") D
  1.  ... I $$STATCHK^ICDAPIU($P(CODE,"/",GMI),DT) Q  ; OK - code is active
  1.  ... S ^TMP("GMPLST",$J,LCNT,0)=^TMP("GMPLST",$J,LCNT,0)_"     <INACTIVE CODE>"
  1.  . D CNTRL^VALM10(LCNT,9,5,IOINHI,IOINORM)
  1.  . S ^TMP("GMPLST",$J,"B",NUM)=IFN
  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 from this prompt.  To update"
  1.  W !?4,"this category you may add new problems or remove an existing"
  1.  W !?4,"one; you may also change the text or code displayed, or the order"
  1.  W !?4,"in which each problem is displayed.  Select View w/wo Seq Numbers"
  1.  W !?4,"to toggle seeing the sequence number in addition to the display"
  1.  W !?4,"number per problem.  If necessary, the current category may be"
  1.  W !?4,"deleted; you may change to a different category to continue editing."
  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.11,+GMPLGRP,0)=$P(GMPLGRP,U,2)_U_DT
  1.  L -^GMPL(125.11,+GMPLGRP,0)
  1.  K GMPLIST,GMPLST,GMPLMODE,GMPLGRP,GMPLSAVE,GMPREBLD,GMPQUIT,RT1,TMPITEM
  1.  K VALMBCK,VALMCNT,VALMSG,VALMHDR
  1.  K ^TMP("GMPLIST",$J),^TMP("GMPLST",$J)
  1.  Q
  1.  ;
  1. ADD ; Add new problem(s)
  1.  N GMPVOCAB,GMPQUIT,GMPREBLD S VALMBCK="" D FULL^VALM1
  1.  S GMPVOCAB="" ; $$VOCAB^GMPLX1 Q:GMPVOCAB="^"
  1.  F  D  Q:$D(GMPQUIT)  W !!
  1.  . N X,Y,SEQ,CODE,IFN,SCTS,SCTT,SCTC,SCTD
  1.  . S (X,Y,SCTS,SCTT,SCTC,SCTD)="" D SEARCH^GMPLX(.X,.Y,"PROBLEM: ","1",GMPVOCAB)
  1.  . I +Y'>0 S GMPQUIT=1 Q
  1.  . I X["(SCT" D
  1.  . . S SCTS=X
  1.  . . S SCTT=$P(SCTS," (SCT ")
  1.  . . S SCTC=$P($P(SCTS,"SCT ",2),")")
  1.  . . S SCTD=$$GETDES^LEXTRAN1("SCT",SCTT)
  1.  . . S SCTD=$S(+SCTD=1:$P(SCTD,U,2),1:"")
  1.  . S X=$$TEXT^GMPLBLD1(X) I X="^" S GMPQUIT=1 Q
  1.  . S CODE=$$CODE^GMPLBLD1($G(SCTC),$G(Y(1))) I CODE']"" S GMPQUIT=1 Q
  1.  . S RT1="^TMP(""GMPLIST"",$J,""SEQ"",",SEQ=+$$LAST^GMPLBLD2(RT1)+1 ; dflt = next #
  1.  . S SEQ=$$SEQ^GMPLBLD1(SEQ) I SEQ="^" S GMPQUIT=1 Q
  1.  . S IFN=$$TMPIFN^GMPLBLD1,^TMP("GMPLIST",$J,0)=^TMP("GMPLIST",$J,0)+1
  1.  . S ^TMP("GMPLIST",$J,IFN)=SEQ_U_+Y_U_X_U_CODE_U_SCTC_U_SCTD ; seq ^ # ^ text ^ code
  1.  . S (^TMP("GMPLIST",$J,"PROB",+Y),^TMP("GMPLIST",$J,"SEQ",SEQ))=IFN,GMPREBLD=1
  1.  I $D(GMPREBLD) S VALMBCK="R",GMPLSAVE=1 D BUILD("^TMP(""GMPLIST"",$J)",GMPLMODE),HDR
  1.  S VALMBCK="R" S VALMSG=$$MSG^GMPLX
  1.  Q
  1.  ;
  1. REMOVE ; Remove problem from group
  1.  N NUM,IFN S VALMBCK=""
  1.  S NUM=$$SEL1^GMPLBLD1 G:NUM="^" RMQ
  1.  S IFN=$P($G(^TMP("GMPLST",$J,"B",NUM)),U,1) G:+IFN'>0 RMQ
  1.  I "@"[$G(^TMP("GMPLIST",$J,IFN)) W $C(7),!!,"Problem does not exist in this category!" H 2 G RMQ
  1.  I '$$SURE^GMPLX 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. EDIT ; Edit problem text and code
  1.  N NUM,SEL,IFN,PIECE,CODE,PROB,PROBLEM,GMPQUIT,GMPREBLD S VALMBCK="" D FULL^VALM1
  1.  S SEL=$$SEL^GMPLBLD1 G:SEL="^" EDQ
  1.  F PIECE=1:1:$L(SEL,",") D  Q:$D(GMPQUIT)  W !
  1.  . S NUM=$P(SEL,",",PIECE) Q:NUM'>0
  1.  . S IFN=$P($G(^TMP("GMPLST",$J,"B",NUM)),U,1) Q:IFN'>0
  1.  . I "@"[$G(^TMP("GMPLIST",$J,IFN)) W $C(7),!!,"Problem #"_NUM_" does not exist in this category!" H 2 Q
  1.  . W !!,">>>  Problem #"_NUM S PROBLEM=^TMP("GMPLIST",$J,IFN)
  1.  . W:$P(PROBLEM,U,2)>1 " = "_$G(^LEX(757.01,+$P(PROBLEM,U,2),0)) W ! ; KER
  1.  . S PROB=$$TEXT^GMPLBLD1($P(PROBLEM,U,3)) I PROB="^" S GMPQUIT=1 Q
  1.  . I PROB="@" D DELETE^GMPLBLD1(IFN) S GMPREBLD=1 Q
  1.  . S CODE=$$CODE^GMPLBLD1($P(PROBLEM,U,5),$P(PROBLEM,U,4)) I CODE="^" S GMPQUIT=1 Q
  1.  . S ^TMP("GMPLIST",$J,IFN)=$P(PROBLEM,U,1,2)_U_PROB_U_CODE_U_$P(PROBLEM,U,5,6),GMPREBLD=1
  1.  I $D(GMPREBLD) S VALMBCK="R",GMPLSAVE=1 D BUILD("^TMP(""GMPLIST"",$J)",GMPLMODE)
  1. EDQ S:'VALMCC VALMBCK="R" S VALMSG=$$MSG^GMPLX
  1.  Q