- 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