CIAZGUTP ;MSC/IND/DKM - User prompt APIs ;03-Mar-2008 10:15;DKM
;;1.4;GENERIC RETRIEVAL UTILITY;;Feb 14, 2008
;;Copyright 2000-2008, Medsphere Systems Corporation
;=================================================================
; Single value prompt
ASK1(DTP) ; EP
S VAL(1)=$$DIR(DTP,.PROMPT,$G(VAL(1)),,.ABORT)
Q
; Range prompt
ASK2(DTP) ; EP
N X1,X2
S X1=$G(VAL(1)),X2=$G(VAL(2))
D DIR2(DTP,.PROMPT,.X1,.X2,,.ABORT)
S:'$G(ABORT) VAL(1)=X1,VAL(2)=X2
Q
;
; Prompt for a range of values
DIR2(DTP,PMT,VAL1,VAL2,HLP,ABORT,SCN) ; EP
N Y
D PMPTOUT(.PMT)
S VAL1=$$DIR(DTP," First",.VAL1,.HLP,.ABORT)
Q:$G(ABORT)
S VAL2=$$DIR(DTP," Last",.VAL2,.HLP,.ABORT)
S:VAL1>VAL2 Y=VAL1,VAL1=VAL2,VAL2=Y
Q
; DIR call for Y/N response
DIRYN(PMT,DFL,HLP,POP) ; EP
Q $$DIR("YO",.PMT,.DFL,.HLP,.POP)
;
; Paramerized DIR call
DIR(DTP,PMT,DFL,HLP,ABORT,SCN) ; EP
N DIR,DTOUT,DUOUT,Y
I $E(DTP)="D",$G(DFL),DFL=+DFL S DFL=$$FMTE^XLFDT(DFL)
S DIR(0)=DTP,DIR("B")=$G(DFL)
I '$G(PMT) M DIR("A")=PMT
E D GETTEXT(PMT,$NA(DIR("A")))
I '$G(HLP) M DIR("?")=HLP
E D GETTEXT(HLP,$NA(DIR("?")))
S:$L($G(SCN)) DIR("S")=SCN
D ^DIR
S:$D(DUOUT)!$D(DTOUT) ABORT=1
I '$G(ABORT) D
.S DFL=Y
.W:$D(Y(0)) " ",Y(0)
Q:$Q Y
Q
; Pause for user input
DIRZ ; EP
D DIR("E",,,,.ABORT)
Q
; Display dialog text
; DLG = Dialog index (negative value causes pause)
SHOWDLG(DLG,SILENT) ; EP
Q:$D(SILENT)!$D(ZTQUEUED)
N X
D GETTEXT(DLG,"X")
S X=0
W:$X !
F S X=$O(X(X)) Q:'X W X(X),!
D:DLG<0 DIRZ
Q
; Load dialog text into array
; DLG = Dialog index^optional parameters
; ARY = Array to receive text
GETTEXT(DLG,ARY) ;
N PM
K @ARY
F X=2:1:$L(DLG,U) S PM(X-1)=$P(DLG,U,X)
S DLG=$S(DLG<0:-DLG,1:+DLG)
D BLD^DIALOG(DLG+199504000,.PM,,ARY)
Q
;
; Prompt for entry from file
; FILE = File #
; PMPT = Prompt
; SCRN = Screen (optional)
; .ABORT = If set, operation was aborted (returned)
GETIEN(FILE,PMPT,SCRN,ABORT) ; EP
N DIC,D,Y
S D=$$GET1^DIQ(FILE,$$FIND1^DIC(FILE,,," "),.01)
S DIC=FILE,DIC(0)="AE",DIC("A")=$G(PMPT),DIC("B")=D
S:$L($G(SCRN)) DIC("S")=SCRN
D ^DIC
S:Y'>0 ABORT=1
Q +Y
; Select one or more items from a file or set of codes
; ITEM = Item descriptor (start with "-" if exclusion)
; FILE = File #
; ARY = Array name to receive selections
; SCRN = Optional screen
; DFLT = Optional default value
; FLD = If target lookup is a set, pass the field # for the set
; ASK = Optional flag to issue Y/N prompt (default = 1)
SELECT(ITEM,FILE,ARY,SCRN,DFLT,ABORT,FLD,ASK) ; EP
N ITEMS,DONE,IE
I '$D(ITEM)!'$G(FILE)!'$D(ARY) S ABORT=1 Q
I $E(ITEM)="-" S $E(ITEM)="",IE="excluded from"
E S IE="included in"
S ITEMS=$S("Yy"[$E(ITEM,$L(ITEM)):$E(ITEM,1,$L(ITEM)-1)_"ies",1:ITEM_"s"),DONE=0,ASK=$G(ASK,1)
K @ARY
F D Q:ABORT!DONE
.N DIC,Y,X
.S:ASK DONE=$$DIRYN(14_U_ITEMS,"YES",13_U_ITEMS,.ABORT)
.Q:ABORT!DONE
.D SHOWDLG(15_U_ITEM_U_IE)
.I $G(FLD) D
..F D Q:Y<1
...S Y=+$$DIR(FILE_","_FLD_"O","Select "_ITEM,.DFLT,,.ABORT,.SCRN)
...S:Y>0 @ARY@(Y)=""
.E D
..S DIC(0)="QEMA",DIC=FILE,DIC("A")="Select "_ITEM_": "
..S:$D(DFLT) DIC("B")=DFLT
..S:$D(SCRN) DIC("S")=SCRN
..F D ^DIC K DIC("B") Q:Y<0 S @ARY@(+Y)=""
.D SHOWDLG($S($D(@ARY):17,1:16)_U_ITEMS_U_IE)
.S X=""
.F S X=$O(@ARY@(X)) Q:'$L(X) D
..I $G(FLD) W ?5,$$EXTERNAL^DILFD(FILE,FLD,,X),!
..E W ?5,$$GET1^DIQ(FILE,X,.01),!
.W !
.S DONE=$$DIRYN("Is this correct","YES",,.ABORT)
.I 'DONE D
..K @ARY
..D:'ABORT SHOWDLG(18_U_ITEMS)
Q
; Display a prompt
PMPTOUT(PMPT) ;
N NXT
W !!
S NXT="PMPT"
W:$D(PMPT)#2 PMPT,!
F S NXT=$Q(@NXT) Q:'$L(NXT) W @NXT,!
Q
CIAZGUTP ;MSC/IND/DKM - User prompt APIs ;03-Mar-2008 10:15;DKM
+1 ;;1.4;GENERIC RETRIEVAL UTILITY;;Feb 14, 2008
+2 ;;Copyright 2000-2008, Medsphere Systems Corporation
+3 ;=================================================================
+4 ; Single value prompt
ASK1(DTP) ; EP
+1 SET VAL(1)=$$DIR(DTP,.PROMPT,$GET(VAL(1)),,.ABORT)
+2 QUIT
+3 ; Range prompt
ASK2(DTP) ; EP
+1 NEW X1,X2
+2 SET X1=$GET(VAL(1))
SET X2=$GET(VAL(2))
+3 DO DIR2(DTP,.PROMPT,.X1,.X2,,.ABORT)
+4 IF '$GET(ABORT)
SET VAL(1)=X1
SET VAL(2)=X2
+5 QUIT
+6 ;
+7 ; Prompt for a range of values
DIR2(DTP,PMT,VAL1,VAL2,HLP,ABORT,SCN) ; EP
+1 NEW Y
+2 DO PMPTOUT(.PMT)
+3 SET VAL1=$$DIR(DTP," First",.VAL1,.HLP,.ABORT)
+4 IF $GET(ABORT)
QUIT
+5 SET VAL2=$$DIR(DTP," Last",.VAL2,.HLP,.ABORT)
+6 IF VAL1>VAL2
SET Y=VAL1
SET VAL1=VAL2
SET VAL2=Y
+7 QUIT
+8 ; DIR call for Y/N response
DIRYN(PMT,DFL,HLP,POP) ; EP
+1 QUIT $$DIR("YO",.PMT,.DFL,.HLP,.POP)
+2 ;
+3 ; Paramerized DIR call
DIR(DTP,PMT,DFL,HLP,ABORT,SCN) ; EP
+1 NEW DIR,DTOUT,DUOUT,Y
+2 IF $EXTRACT(DTP)="D"
IF $GET(DFL)
IF DFL=+DFL
SET DFL=$$FMTE^XLFDT(DFL)
+3 SET DIR(0)=DTP
SET DIR("B")=$GET(DFL)
+4 IF '$GET(PMT)
MERGE DIR("A")=PMT
+5 IF '$TEST
DO GETTEXT(PMT,$NAME(DIR("A")))
+6 IF '$GET(HLP)
MERGE DIR("?")=HLP
+7 IF '$TEST
DO GETTEXT(HLP,$NAME(DIR("?")))
+8 IF $LENGTH($GET(SCN))
SET DIR("S")=SCN
+9 DO ^DIR
+10 IF $DATA(DUOUT)!$DATA(DTOUT)
SET ABORT=1
+11 IF '$GET(ABORT)
Begin DoDot:1
+12 SET DFL=Y
+13 IF $DATA(Y(0))
WRITE " ",Y(0)
End DoDot:1
+14 IF $QUIT
QUIT Y
+15 QUIT
+16 ; Pause for user input
DIRZ ; EP
+1 DO DIR("E",,,,.ABORT)
+2 QUIT
+3 ; Display dialog text
+4 ; DLG = Dialog index (negative value causes pause)
SHOWDLG(DLG,SILENT) ; EP
+1 IF $DATA(SILENT)!$DATA(ZTQUEUED)
QUIT
+2 NEW X
+3 DO GETTEXT(DLG,"X")
+4 SET X=0
+5 IF $X
WRITE !
+6 FOR
SET X=$ORDER(X(X))
IF 'X
QUIT
WRITE X(X),!
+7 IF DLG<0
DO DIRZ
+8 QUIT
+9 ; Load dialog text into array
+10 ; DLG = Dialog index^optional parameters
+11 ; ARY = Array to receive text
GETTEXT(DLG,ARY) ;
+1 NEW PM
+2 KILL @ARY
+3 FOR X=2:1:$LENGTH(DLG,U)
SET PM(X-1)=$PIECE(DLG,U,X)
+4 SET DLG=$SELECT(DLG<0:-DLG,1:+DLG)
+5 DO BLD^DIALOG(DLG+199504000,.PM,,ARY)
+6 QUIT
+7 ;
+8 ; Prompt for entry from file
+9 ; FILE = File #
+10 ; PMPT = Prompt
+11 ; SCRN = Screen (optional)
+12 ; .ABORT = If set, operation was aborted (returned)
GETIEN(FILE,PMPT,SCRN,ABORT) ; EP
+1 NEW DIC,D,Y
+2 SET D=$$GET1^DIQ(FILE,$$FIND1^DIC(FILE,,," "),.01)
+3 SET DIC=FILE
SET DIC(0)="AE"
SET DIC("A")=$GET(PMPT)
SET DIC("B")=D
+4 IF $LENGTH($GET(SCRN))
SET DIC("S")=SCRN
+5 DO ^DIC
+6 IF Y'>0
SET ABORT=1
+7 QUIT +Y
+8 ; Select one or more items from a file or set of codes
+9 ; ITEM = Item descriptor (start with "-" if exclusion)
+10 ; FILE = File #
+11 ; ARY = Array name to receive selections
+12 ; SCRN = Optional screen
+13 ; DFLT = Optional default value
+14 ; FLD = If target lookup is a set, pass the field # for the set
+15 ; ASK = Optional flag to issue Y/N prompt (default = 1)
SELECT(ITEM,FILE,ARY,SCRN,DFLT,ABORT,FLD,ASK) ; EP
+1 NEW ITEMS,DONE,IE
+2 IF '$DATA(ITEM)!'$GET(FILE)!'$DATA(ARY)
SET ABORT=1
QUIT
+3 IF $EXTRACT(ITEM)="-"
SET $EXTRACT(ITEM)=""
SET IE="excluded from"
+4 IF '$TEST
SET IE="included in"
+5 SET ITEMS=$SELECT("Yy"[$EXTRACT(ITEM,$LENGTH(ITEM)):$EXTRACT(ITEM,1,$LENGTH(ITEM)-1)_"ies",1:ITEM_"s")
SET DONE=0
SET ASK=$GET(ASK,1)
+6 KILL @ARY
+7 FOR
Begin DoDot:1
+8 NEW DIC,Y,X
+9 IF ASK
SET DONE=$$DIRYN(14_U_ITEMS,"YES",13_U_ITEMS,.ABORT)
+10 IF ABORT!DONE
QUIT
+11 DO SHOWDLG(15_U_ITEM_U_IE)
+12 IF $GET(FLD)
Begin DoDot:2
+13 FOR
Begin DoDot:3
+14 SET Y=+$$DIR(FILE_","_FLD_"O","Select "_ITEM,.DFLT,,.ABORT,.SCRN)
+15 IF Y>0
SET @ARY@(Y)=""
End DoDot:3
IF Y<1
QUIT
End DoDot:2
+16 IF '$TEST
Begin DoDot:2
+17 SET DIC(0)="QEMA"
SET DIC=FILE
SET DIC("A")="Select "_ITEM_": "
+18 IF $DATA(DFLT)
SET DIC("B")=DFLT
+19 IF $DATA(SCRN)
SET DIC("S")=SCRN
+20 FOR
DO ^DIC
KILL DIC("B")
IF Y<0
QUIT
SET @ARY@(+Y)=""
End DoDot:2
+21 DO SHOWDLG($SELECT($DATA(@ARY):17,1:16)_U_ITEMS_U_IE)
+22 SET X=""
+23 FOR
SET X=$ORDER(@ARY@(X))
IF '$LENGTH(X)
QUIT
Begin DoDot:2
+24 IF $GET(FLD)
WRITE ?5,$$EXTERNAL^DILFD(FILE,FLD,,X),!
+25 IF '$TEST
WRITE ?5,$$GET1^DIQ(FILE,X,.01),!
End DoDot:2
+26 WRITE !
+27 SET DONE=$$DIRYN("Is this correct","YES",,.ABORT)
+28 IF 'DONE
Begin DoDot:2
+29 KILL @ARY
+30 IF 'ABORT
DO SHOWDLG(18_U_ITEMS)
End DoDot:2
End DoDot:1
IF ABORT!DONE
QUIT
+31 QUIT
+32 ; Display a prompt
PMPTOUT(PMPT) ;
+1 NEW NXT
+2 WRITE !!
+3 SET NXT="PMPT"
+4 IF $DATA(PMPT)#2
WRITE PMPT,!
+5 FOR
SET NXT=$QUERY(@NXT)
IF '$LENGTH(NXT)
QUIT
WRITE @NXT,!
+6 QUIT
