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

CIAZGUTP.m

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