GMPLMENU ; SLC/MKB -- VALM Utilities for Add Menu sub-list ;5/26/94 15:55
;;2.0;Problem List;**11**;Aug 25, 1994
HDR ; -- header code
N PAT,NUM,LIST S NUM=GMPLCNT_" problem(s) added"
S PAT=$P(GMPDFN,U,2)_" ("_$P(GMPDFN,U,3)_")"
S VALMHDR(1)=PAT_$J(NUM,79-$L(PAT)),LIST=$P(GMPLSLST,U,2)
S VALMHDR(2)=$J(LIST,$L(LIST)\2+41)
Q
;
HELP ; -- help code
N X,CNT S CNT=+$G(^TMP("GMPLMENU",$J,"LIST",0))
W !!?4,"You may select one or more of the above listed items by entering"
W !?4,"its display number (1-"_CNT_") at the prompt; if the text if followed"
W !?4,"by '...', all problems under that heading will be displayed for"
W !?4,"selection. Enter AD to select a problem not listed above."
W !?4,"If you enter a list or range of numbers to add several problems,"
W !?4,"you will be presented with each to complete, one at a time."
W:VALMCNT>10 !?4,"Enter + to see more items, as in the problem list."
W !!,"Press <return> to continue ..." R X:DTIME
S VALMSG=$$MSG,VALMBCK=$S(VALMCC:"",1:"R")
Q
EXIT ; -- exit code
N I F I=0:0 S I=$O(XQORM("KEY",I)) Q:I'>0 K XQORM("KEY",I)
K ^TMP("GMPLMENU",$J),GMPLCNT
Q
;
MSG() ; -- set LMgr msg bar
Q "Enter the number of the item(s) you wish to select"
;
BUILD ; -- Build ^TMP("GMPLMENU",$J,"LIST") list to display
N I,LCNT,NUM,ITEM,CODE,GRP,PROBS,ADDED
S (GRP,NUM,LCNT)=0 D CLEAN^VALM10
F S GRP=$O(^TMP("GMPLMENU",$J,GRP)) Q:GRP'>0 D
. S ITEM=$G(^TMP("GMPLMENU",$J,GRP,0)),PROBS=+$P(ITEM,U,2)
. I 'PROBS D Q
. . S LCNT=LCNT+1,NUM=NUM+1,^TMP("GMPLMENU",$J,"IDX",NUM)=U_GRP_U_LCNT
. . S ^TMP("GMPLMENU",$J,"LIST",LCNT,0)=$J(NUM,5)_" "_$P(ITEM,U)_" ..."
. . D CNTRL^VALM10(LCNT,1,5,IOINHI,IOINORM)
BLD1 . I LCNT,^TMP("GMPLMENU",$J,"LIST",LCNT,0)'=" " S LCNT=LCNT+1,^TMP("GMPLMENU",$J,"LIST",LCNT,0)=" "
. S:+$G(GMPLGRP)=GRP VALMBG=LCNT+1 ; start list display here
. I $L($P(ITEM,U)) D ; have a hdr
. . S LCNT=LCNT+1,^TMP("GMPLMENU",$J,"LIST",LCNT,0)=" "_$P(ITEM,U)
. . D CNTRL^VALM10(LCNT,7,$L($P(ITEM,U)),IOUON,IOUOFF)
. S I=0 F S I=$O(^TMP("GMPLMENU",$J,GRP,I)) Q:I'>0 D
. . S LCNT=LCNT+1,NUM=NUM+1
. . S ITEM=$G(^TMP("GMPLMENU",$J,GRP,I)),CODE=$P(ITEM,U,3),ADDED=+$P(ITEM,U,4) ; ITEM=term^text^code, _"^1" if added
. . S ^TMP("GMPLMENU",$J,"LIST",LCNT,0)=$S(ADDED:" X",1:" ")_$J(NUM,3)_" "_$P(ITEM,U,2)_$S($L(CODE):" ("_CODE_")",1:"")
. . S ^TMP("GMPLMENU",$J,"IDX",NUM)=I_U_GRP_U_LCNT_U_ITEM
. . D CNTRL^VALM10(LCNT,1,5,IOINHI,IOINORM)
. S LCNT=LCNT+1,^TMP("GMPLMENU",$J,"LIST",LCNT,0)=" "
BLDQ S ^TMP("GMPLMENU",$J,"LIST",0)=NUM_U_LCNT,VALMCNT=LCNT,GMPLCNT=0,VALMSG=$$MSG
D KEYS
Q
;
KEYS ; -- setup XQORM("KEY") array for menu
N I,PROTCL,NUM S NUM=+$G(^TMP("GMPLMENU",$J,"LIST",0))
S PROTCL=$O(^ORD(101,"B","GMPL LIST SELECT ITEM",0))_"^1"
F I=1:1:NUM S XQORM("KEY",I)=PROTCL
S VALMSG=$$MSG
Q
;
CK ; -- check whether to stop processing after each problem
; Called from exit action of GMPL LIST XXX protocols
S:$D(GMPQUIT) XQORPOP=1 K GMPQUIT
I $D(DTOUT)!($G(VALMBCK)="Q") S VALMBCK="Q" Q
S VALMBCK="R",VALMSG=$$MSG
Q
;
ITEM ; -- select item from menu
N NUM,GMPROB,GMPTERM,GMPICD,GMPSAVED,LCNT,LINE,DUP,ITEM,CODE,GRP,PROB,GMPINDEX
S NUM=+$P(XQORNOD(0),U,3) Q:NUM'>0
S GMPINDEX=$G(^TMP("GMPLMENU",$J,"IDX",NUM)),PROB=+GMPINDEX,GRP=$P(GMPINDEX,U,2)
I 'PROB D Q ; expand category
. S ITEM=$G(^TMP("GMPLMENU",$J,+GRP,0)) S:'$D(GMPLGRP) GMPLGRP=+GRP
. S ^TMP("GMPLMENU",$J,+GRP,0)=$P(ITEM,U)_"^1"
S ITEM=$P(GMPINDEX,U,4,6) ; CLU^text^code
S GMPTERM=$S(+ITEM>1:$P(ITEM,U,1,2),1:""),GMPROB=$P(ITEM,U,2)
S CODE=$P(ITEM,U,3),GMPICD=$S('$L(CODE):"799.9",1:CODE)
W !!!,">>> Adding problem #"_NUM_" '"_GMPROB_"' ..."
S DUP=$$DUPL^GMPLX(+GMPDFN,+GMPTERM,GMPROB)
I DUP,'$$DUPLOK^GMPLX(DUP) G ITQ
D ADD1^GMPL1
ITQ I $D(GMPSAVED) D D HDR
. S GMPREBLD=1,GMPLCNT=GMPLCNT+1,LCNT=+$P(GMPINDEX,U,3)
. S LINE=$G(^TMP("GMPLMENU",$J,"LIST",LCNT,0)),^TMP("GMPLMENU",$J,"LIST",LCNT,0)=" X"_$E(LINE,3,999)
. S ^TMP("GMPLMENU",$J,+GRP,+PROB)=ITEM_"^1" ; problem added
Q
;
CLU ; -- add problem not on menu, from CLU
N GMPSAVED W !!!,">>> Adding a problem not on the menu ..."
W @IOF D FULL^VALM1,ADD^GMPL1 S VALMBCK="R" I $D(GMPSAVED) S GMPREBLD=1,GMPLCNT=GMPLCNT+1 K VALMHDR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMPLMENU 4279 printed Nov 22, 2024@17:40:09 Page 2
+1 ;;2.0;Problem List;**11**;Aug 25, 1994
HDR ; -- header code
+1 NEW PAT,NUM,LIST
SET NUM=GMPLCNT_" problem(s) added"
+2 SET PAT=$PIECE(GMPDFN,U,2)_" ("_$PIECE(GMPDFN,U,3)_")"
+3 SET VALMHDR(1)=PAT_$JUSTIFY(NUM,79-$LENGTH(PAT))
SET LIST=$PIECE(GMPLSLST,U,2)
+4 SET VALMHDR(2)=$JUSTIFY(LIST,$LENGTH(LIST)\2+41)
+5 QUIT
+6 ;
HELP ; -- help code
+1 NEW X,CNT
SET CNT=+$GET(^TMP("GMPLMENU",$JOB,"LIST",0))
+2 WRITE !!?4,"You may select one or more of the above listed items by entering"
+3 WRITE !?4,"its display number (1-"_CNT_") at the prompt; if the text if followed"
+4 WRITE !?4,"by '...', all problems under that heading will be displayed for"
+5 WRITE !?4,"selection. Enter AD to select a problem not listed above."
+6 WRITE !?4,"If you enter a list or range of numbers to add several problems,"
+7 WRITE !?4,"you will be presented with each to complete, one at a time."
+8 if VALMCNT>10
WRITE !?4,"Enter + to see more items, as in the problem list."
+9 WRITE !!,"Press <return> to continue ..."
READ X:DTIME
+10 SET VALMSG=$$MSG
SET VALMBCK=$SELECT(VALMCC:"",1:"R")
+11 QUIT
EXIT ; -- exit code
+1 NEW I
FOR I=0:0
SET I=$ORDER(XQORM("KEY",I))
if I'>0
QUIT
KILL XQORM("KEY",I)
+2 KILL ^TMP("GMPLMENU",$JOB),GMPLCNT
+3 QUIT
+4 ;
MSG() ; -- set LMgr msg bar
+1 QUIT "Enter the number of the item(s) you wish to select"
+2 ;
BUILD ; -- Build ^TMP("GMPLMENU",$J,"LIST") list to display
+1 NEW I,LCNT,NUM,ITEM,CODE,GRP,PROBS,ADDED
+2 SET (GRP,NUM,LCNT)=0
DO CLEAN^VALM10
+3 FOR
SET GRP=$ORDER(^TMP("GMPLMENU",$JOB,GRP))
if GRP'>0
QUIT
Begin DoDot:1
+4 SET ITEM=$GET(^TMP("GMPLMENU",$JOB,GRP,0))
SET PROBS=+$PIECE(ITEM,U,2)
+5 IF 'PROBS
Begin DoDot:2
+6 SET LCNT=LCNT+1
SET NUM=NUM+1
SET ^TMP("GMPLMENU",$JOB,"IDX",NUM)=U_GRP_U_LCNT
+7 SET ^TMP("GMPLMENU",$JOB,"LIST",LCNT,0)=$JUSTIFY(NUM,5)_" "_$PIECE(ITEM,U)_" ..."
+8 DO CNTRL^VALM10(LCNT,1,5,IOINHI,IOINORM)
End DoDot:2
QUIT
BLD1 IF LCNT
IF ^TMP("GMPLMENU",$JOB,"LIST",LCNT,0)'=" "
SET LCNT=LCNT+1
SET ^TMP("GMPLMENU",$JOB,"LIST",LCNT,0)=" "
+1 ; start list display here
if +$GET(GMPLGRP)=GRP
SET VALMBG=LCNT+1
+2 ; have a hdr
IF $LENGTH($PIECE(ITEM,U))
Begin DoDot:2
+3 SET LCNT=LCNT+1
SET ^TMP("GMPLMENU",$JOB,"LIST",LCNT,0)=" "_$PIECE(ITEM,U)
+4 DO CNTRL^VALM10(LCNT,7,$LENGTH($PIECE(ITEM,U)),IOUON,IOUOFF)
End DoDot:2
+5 SET I=0
FOR
SET I=$ORDER(^TMP("GMPLMENU",$JOB,GRP,I))
if I'>0
QUIT
Begin DoDot:2
+6 SET LCNT=LCNT+1
SET NUM=NUM+1
+7 ; ITEM=term^text^code, _"^1" if added
SET ITEM=$GET(^TMP("GMPLMENU",$JOB,GRP,I))
SET CODE=$PIECE(ITEM,U,3)
SET ADDED=+$PIECE(ITEM,U,4)
+8 SET ^TMP("GMPLMENU",$JOB,"LIST",LCNT,0)=$SELECT(ADDED:" X",1:" ")_$JUSTIFY(NUM,3)_" "_$PIECE(ITEM,U,2)_$SELECT($LENGTH(CODE):" ("_CODE_")",1:"")
+9 SET ^TMP("GMPLMENU",$JOB,"IDX",NUM)=I_U_GRP_U_LCNT_U_ITEM
+10 DO CNTRL^VALM10(LCNT,1,5,IOINHI,IOINORM)
End DoDot:2
+11 SET LCNT=LCNT+1
SET ^TMP("GMPLMENU",$JOB,"LIST",LCNT,0)=" "
End DoDot:1
BLDQ SET ^TMP("GMPLMENU",$JOB,"LIST",0)=NUM_U_LCNT
SET VALMCNT=LCNT
SET GMPLCNT=0
SET VALMSG=$$MSG
+1 DO KEYS
+2 QUIT
+3 ;
KEYS ; -- setup XQORM("KEY") array for menu
+1 NEW I,PROTCL,NUM
SET NUM=+$GET(^TMP("GMPLMENU",$JOB,"LIST",0))
+2 SET PROTCL=$ORDER(^ORD(101,"B","GMPL LIST SELECT ITEM",0))_"^1"
+3 FOR I=1:1:NUM
SET XQORM("KEY",I)=PROTCL
+4 SET VALMSG=$$MSG
+5 QUIT
+6 ;
CK ; -- check whether to stop processing after each problem
+1 ; Called from exit action of GMPL LIST XXX protocols
+2 if $DATA(GMPQUIT)
SET XQORPOP=1
KILL GMPQUIT
+3 IF $DATA(DTOUT)!($GET(VALMBCK)="Q")
SET VALMBCK="Q"
QUIT
+4 SET VALMBCK="R"
SET VALMSG=$$MSG
+5 QUIT
+6 ;
ITEM ; -- select item from menu
+1 NEW NUM,GMPROB,GMPTERM,GMPICD,GMPSAVED,LCNT,LINE,DUP,ITEM,CODE,GRP,PROB,GMPINDEX
+2 SET NUM=+$PIECE(XQORNOD(0),U,3)
if NUM'>0
QUIT
+3 SET GMPINDEX=$GET(^TMP("GMPLMENU",$JOB,"IDX",NUM))
SET PROB=+GMPINDEX
SET GRP=$PIECE(GMPINDEX,U,2)
+4 ; expand category
IF 'PROB
Begin DoDot:1
+5 SET ITEM=$GET(^TMP("GMPLMENU",$JOB,+GRP,0))
if '$DATA(GMPLGRP)
SET GMPLGRP=+GRP
+6 SET ^TMP("GMPLMENU",$JOB,+GRP,0)=$PIECE(ITEM,U)_"^1"
End DoDot:1
QUIT
+7 ; CLU^text^code
SET ITEM=$PIECE(GMPINDEX,U,4,6)
+8 SET GMPTERM=$SELECT(+ITEM>1:$PIECE(ITEM,U,1,2),1:"")
SET GMPROB=$PIECE(ITEM,U,2)
+9 SET CODE=$PIECE(ITEM,U,3)
SET GMPICD=$SELECT('$LENGTH(CODE):"799.9",1:CODE)
+10 WRITE !!!,">>> Adding problem #"_NUM_" '"_GMPROB_"' ..."
+11 SET DUP=$$DUPL^GMPLX(+GMPDFN,+GMPTERM,GMPROB)
+12 IF DUP
IF '$$DUPLOK^GMPLX(DUP)
GOTO ITQ
+13 DO ADD1^GMPL1
ITQ IF $DATA(GMPSAVED)
Begin DoDot:1
+1 SET GMPREBLD=1
SET GMPLCNT=GMPLCNT+1
SET LCNT=+$PIECE(GMPINDEX,U,3)
+2 SET LINE=$GET(^TMP("GMPLMENU",$JOB,"LIST",LCNT,0))
SET ^TMP("GMPLMENU",$JOB,"LIST",LCNT,0)=" X"_$EXTRACT(LINE,3,999)
+3 ; problem added
SET ^TMP("GMPLMENU",$JOB,+GRP,+PROB)=ITEM_"^1"
End DoDot:1
DO HDR
+4 QUIT
+5 ;
CLU ; -- add problem not on menu, from CLU
+1 NEW GMPSAVED
WRITE !!!,">>> Adding a problem not on the menu ..."
+2 WRITE @IOF
DO FULL^VALM1
DO ADD^GMPL1
SET VALMBCK="R"
IF $DATA(GMPSAVED)
SET GMPREBLD=1
SET GMPLCNT=GMPLCNT+1
KILL VALMHDR
+3 QUIT
