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

ORWLRAP1.m

Go to the documentation of this file.
  1. ORWLRAP1 ;DSS/TFF - LAB ANATOMIC PATHOLOGY CONFIGURATION SUPPORT ;Feb 16, 2024@14:39
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**539,569,588,601**;Dec 17, 1997;Build 1
  1. ;
  1. ;
  1. ; Reference to COLL^LR7OR3 in ICR #2428
  1. ; Reference to OK4CPRS^LRAPDLG in ICR #7339
  1. ; Reference to ^LAB(62, in ICR #2389
  1. ;
  1. Q
  1. ;
  1. ; ORDER ELEMENT Configuration handled after the order element population
  1. ; PAGE Configuration
  1. ; SPECIMEN LIST Is populated or a lookup is used independently of this RPC
  1. ; SPECIMEN Configuration happens when the user selects a specimen on the dialog
  1. ;
  1. GETIEN(IDX) ; Get the 101.45 IEN from the orderable item IEN
  1. Q +$O(^ORD(101.45,"C",IDX,0))
  1. ;
  1. CONFIG(RET,TYP,IEN) ; RPC: ORWLRAP1 CONFIG
  1. ; *This configures the Delphi forms for CPRS aside from the original elements found
  1. ; in the Lab order dialog.
  1. ;
  1. ; TYP = O - ORDER ELEMENTS
  1. ; OCM - ORDER CHANGE MESSAGE
  1. ; P - PAGES
  1. ; PG;# - PAGE CONFIGURATION
  1. ; SP;# - SPECIMEN
  1. ;
  1. N OD,PG,L,W,WL,SP,SPB,BLK,POS,DES,CT
  1. S IEN=$$GETIEN(+$G(IEN)),RET=$NA(^TMP($J,"CONFIG ORWLRAP1")) K @RET S @RET@(0)=0
  1. Q:'IEN!($G(TYP)="")
  1. I '$D(^ORD(101.45,IEN)) D DEFAULT(TYP) Q
  1. ; *** ORDER ELEMENTS
  1. ; O^ID^HIDE(1,0)^REQUIRED(1,0)^DEFAULT_VALUE
  1. I TYP="O" D D END Q
  1. . S OD=0 F S OD=$O(^ORD(101.45,IEN,1,OD)) Q:'OD D
  1. . . S @RET@("O",OD)="O^"_$G(^ORD(101.45,IEN,1,OD,0))
  1. ; *** ORDER CHANGE MESSAGE
  1. I TYP="OCM" S @RET@(0)=$G(^ORD(101.45,IEN,4)) Q
  1. ; *** PAGES
  1. ; P^NUMBER^NAME^RESPONSE_ID
  1. I TYP="P"!(TYP?1"PG;".N) D D END Q
  1. . S PG=0 F S PG=$O(^ORD(101.45,IEN,2,PG)) Q:'PG D
  1. . . Q:TYP?1"PG;".N&(PG'=$P(TYP,";",2))
  1. . . S L=$G(^ORD(101.45,IEN,2,PG,0))
  1. . . Q:$P(L,U,3) ; *** HIDE PAGE
  1. . . I TYP="P" S @RET@("P",PG)="P^"_PG_U_$$NRQ($P(L,U,4),$P(L,U,2))_U_$P(L,U,5) Q
  1. . . ; *** PAGE WP BUILDER BLOCK
  1. . . ; PWB^PAGE^ID^TITLE^LIST(1,0)^DEFAULT_VALUE
  1. . . ; PWV^PAGE^ID^VAL;D-CODE;#|VAL;E;#| (D(ate),E(dit))
  1. . . ; PWW^PAGE^TITLE
  1. . . I $P($G(^ORD(101.45,IEN,2,PG,1,0)),U,4) D
  1. . . . S W=0 F S W=$O(^ORD(101.45,IEN,2,PG,1,W)) Q:'W D
  1. . . . . S WL=$G(^ORD(101.45,IEN,2,PG,1,W,0))
  1. . . . . S @RET@("P",PG,W)="PWB^"_PG_U_W_U_$$NRQ($P(WL,U,2),$P(WL,U))_U_$P(WL,U,3)_U_$P(WL,U,4)
  1. . . . . S @RET@("P",PG,W,"V")="PWV^"_PG_U_W_U_$$VWL(2,PG,W)
  1. . . S @RET@("P",PG)="PWW^"_PG_U_$P($G(^ORD(101.45,IEN,2,PG,0)),U,6)
  1. ; *** SPECIMEN
  1. ; SPH^SP^HIDE_FROM_DESCRIPTION^POSITION^COLLECTION_SAMPLE_HIDE(1,0)^COLLECTION_SAMPLE_DEFAULT
  1. ; SPB^SP^ID^TITLE^HIDE^REQUIRED^DEFAULT_VALUE^POSITION
  1. ; SPV^SP^ID^VAL|VAL(;CODE;CD_VALUE)
  1. I TYP?1"SP;".N S SP=+$P(TYP,";",2) D D END Q
  1. . S @RET@("S",0)="SPH^"_SP_U_$P($G(^ORD(101.45,IEN,3,SP,0)),U,2)_U_+$P($G(^ORD(101.45,IEN,3,SP,0)),U,3)_U_$P($G(^ORD(101.45,IEN,3,SP,2)),U,1,2)
  1. . Q:'$D(^ORD(101.45,IEN,3,SP))
  1. . S (BLK,SPB)=0 F S SPB=$O(^ORD(101.45,IEN,3,SP,1,SPB)),BLK=BLK+1 Q:'SPB!(BLK>4) D
  1. . . S @RET@("S",SPB)="SPB^"_SP_U_SPB_U_$G(^ORD(101.45,IEN,3,SP,1,SPB,0))
  1. . . S POS(+$P(@RET@("S",SPB),U,8),SPB)=""
  1. . . S @RET@("S",SPB,"V")="SPV^"_SP_U_SPB_U_$$VWL(3,SP,SPB)
  1. . ; *** Fix Specimen Description Positioning
  1. . S DES(+$P(@RET@("S",0),U,4))=""
  1. . S CT="" F S CT=$O(POS(CT)) Q:CT="" D
  1. . . S SPB=0 F S SPB=$O(POS(CT,SPB)) Q:'SPB D
  1. . . . I $D(DES(CT)) S DES($O(DES(""),-1)+1)="",$P(@RET@("S",SPB),U,8)=$O(DES(""),-1) Q
  1. . . . S DES(CT)=""
  1. Q
  1. ;
  1. DEFAULT(TYP) ; Set Default Configuration
  1. ; *RET
  1. ; *** ORDER ELEMENTS
  1. ; O^ID^HIDE(1,0)^REQUIRED(1,0)^DEFAULT_VALUE
  1. I TYP="O" D D END Q
  1. . S @RET@("O",1)="O^OPURG^^1"
  1. . S @RET@("O",2)="O^OPCDT^^1"
  1. . S @RET@("O",3)="O^OPCTY^^^WC"
  1. ; *** PAGES
  1. ; P^NUMBER^NAME^RESPONSE_ID
  1. I TYP="P" D D END Q
  1. . S @RET@("P",1)="P^1^*Clinical History^CLINHX"
  1. . S @RET@("P",2)="P^2^Pre-Operative Diagnosis^PREOPDX"
  1. . S @RET@("P",3)="P^3^Operative Findings^OPFIND"
  1. . S @RET@("P",4)="P^4^Post-Operative Findings^POSTOPDX"
  1. I TYP?1"PG;".N D D END Q
  1. . S @RET@("P",$P(TYP,";",2))="PWW^"_$P(TYP,";",2)
  1. ; *** SPECIMEN
  1. ; SPH^SP^HIDE_FROM_DESCRIPTION^POSITION^COLLECTION_SAMPLE_HIDE(1,0)^COLLECTION_SAMPLE_DEFAULT
  1. I TYP?1"SP;".N D D END
  1. . S @RET@("S",0)="SPH^"_$P(TYP,";",2)_"^^0^^"_$$FIND1^DIC(62,,"X","AP SPECIMEN")
  1. Q
  1. ;
  1. SPEC(RET,IEN) ; RPC: ORWLRAP1 SPEC
  1. ; *This returns the default specimen list.
  1. ;
  1. ; RETURN
  1. ; 0 (1,0)ALLOW_OTHER^(1,0)RESTRICT_MULTIPLE
  1. ; # IEN^SPECIMEN_NAME
  1. ;
  1. N C,SP
  1. S IEN=$$GETIEN(+$G(IEN)),RET=$NA(^TMP($J,"SPEC ORWLRAP1")) K @RET S @RET@(0)=0
  1. Q:'IEN Q:'$D(^ORD(101.45,IEN))
  1. S @RET@(0)=+$P($G(^ORD(101.45,IEN,0)),U,2)_U_+$P($G(^ORD(101.45,IEN,0)),U,3) D SPEC1
  1. Q:'$P($G(^ORD(101.45,IEN,3,0)),U,4)
  1. S C=$O(@RET@(""),-1)+1
  1. S SP="" F S SP=$O(^ORD(101.45,IEN,3,"S",SP)) Q:SP="" D
  1. . S @RET@(C)=$O(^ORD(101.45,IEN,3,"S",SP,""))_U_SP,C=C+1
  1. Q
  1. ;
  1. SPEC1() ; Lab list of specimens for this test
  1. N OROUT,IDX
  1. Q:'IEN
  1. S IDX=+$P($G(^ORD(101.45,IEN,0)),U,4)
  1. Q:'IDX
  1. D COLL^LR7OR3(+$$GET1^DIQ(101.43,IDX,2),.OROUT) Q:'$G(OROUT("Specimens"))
  1. S CT=0 F S CT=$O(OROUT("Specimens",CT)) Q:'CT D
  1. . S @RET@(CT)=OROUT("Specimens",CT)
  1. Q
  1. ;
  1. ; SUPPORTING APIs ------------------------------------------------------------
  1. ;
  1. NRQ(RQ,NM) ; Add * to name if required
  1. Q:RQ "*"_NM
  1. Q NM
  1. ;
  1. VWL(ND0,ND1,IENS) ; Add value list as pipe delimited string
  1. N V,STR
  1. S V="" F S V=$O(^ORD(101.45,IEN,ND0,ND1,1,IENS,1,"B",V)) Q:V="" D
  1. . S STR=$S($D(STR):STR_"|"_$$EXT(1),1:$$EXT(1))_$S(ND0=2:";"_$$EXT(2)_"-"_$$EXT(4)_";"_$$EXT(3),1:";"_$$EXT(2))
  1. Q $G(STR)
  1. ;
  1. EXT(PC) ; Extend Value
  1. Q:'$G(PC) ""
  1. N VI S VI=$O(^ORD(101.45,IEN,ND0,ND1,1,IENS,1,"B",V,""))
  1. Q $P($G(^ORD(101.45,IEN,ND0,ND1,1,IENS,1,+VI,0)),U,PC)
  1. ;
  1. END ; Clean Up
  1. I $O(@RET@(""),-1)?.A K @RET@(0) Q
  1. K:$O(@RET@(""),-1) @RET@(0)
  1. Q
  1. ;
  1. APOITEMS(Y,QOCALL,SHOWALL,CODE,NATFLAG,ACCESS) ; Subset of AP orderable items
  1. ; Y(n)=IEN^.01 Name^.01 Name -or- IEN^Synonym <.01 Name>^.01 Name
  1. ; QOCALL = Allow quick orders
  1. ; SHOWALL = Show inactive entries
  1. ; CODE: 0 = List only entries already in File 101.45
  1. ; 1 = List only entries not already in File 101.45
  1. ; NATFLAG = Add National Standard flag as piece 4 of the data
  1. ; ACCESS - List of allowed display groups
  1. ;
  1. N I,IEN,X,CURTM,FROM,XREF,LABIEN,INACTIVE,CHKACCESS,LRCODE,ORTESTIEN,ORLABOK
  1. N ORLRFILTER
  1. S QOCALL=+$G(QOCALL),CODE=+$G(CODE),NATFLAG=+$G(NATFLAG),SHOWALL=+$G(SHOWALL)
  1. S ACCESS=$G(ACCESS),CHKACCESS=($L(ACCESS)>1)
  1. S I=0,FROM="",XREF="S.AP",CURTM=$$NOW^XLFDT
  1. S ORLRFILTER=+$$GET^XPAR("SYS","OR LR ORDERABLE ITEM FILTERING",1,"I")
  1. F S FROM=$O(^ORD(101.43,XREF,FROM)) Q:FROM="" D
  1. . S IEN="" F S IEN=$O(^ORD(101.43,XREF,FROM,IEN)) Q:'IEN D
  1. . . I '$$OK4CPRS(IEN) Q
  1. . . S LABIEN=+$O(^ORD(101.45,"C",IEN,0))
  1. . . S INACTIVE=$S(LABIEN:+$P($G(^ORD(101.45,LABIEN,0)),U,6),1:0)
  1. . . I CODE=0,'LABIEN Q
  1. . . I CODE=1,LABIEN Q
  1. . . I 'SHOWALL,INACTIVE Q
  1. . . I CHKACCESS D I ACCESS'[(U_LRCODE_U) Q
  1. . . . S LRCODE=$P($G(^ORD(101.43,IEN,"LR")),U,6)
  1. . . . I LRCODE="" S LRCODE="CH"
  1. . . S X=$G(^ORD(101.43,XREF,FROM,IEN))
  1. . . I +$P(X,U,3),$P(X,U,3)<CURTM Q
  1. . . I 'QOCALL,$P(X,U,5) Q
  1. . . I ORLRFILTER,'$$CHKLABDIV^ORWDX2(IEN,XREF) Q
  1. . . S I=I+1
  1. . . I 'X S Y(I)=IEN_U_$P(X,U,2)_U_$P(X,U,2)
  1. . . E S Y(I)=IEN_U_$P(X,U,2)_$C(9)_"<"_$P(X,U,4)_">"_U_$P(X,U,4)
  1. . . I NATFLAG S $P(Y(I),U,4)=$S(LABIEN:+$P($G(^ORD(101.45,LABIEN,0)),U,5),1:0)
  1. . . I SHOWALL,INACTIVE S $P(Y(I),U,2)=$P(Y(I),U,2)_" <Inactive>"
  1. Q
  1. ;
  1. OK4CPRS(ORDITEM,QUICK) ; Determines if an orderable item is allowed for AP Dialogs
  1. ; Also used as a screen by the LR OTHER LAB AP TESTS order dialog
  1. N LABTEST,OK,LABIEN,NAME,X
  1. S OK=0
  1. S LABTEST=$P($G(^ORD(101.43,ORDITEM,0)),U,2)
  1. S LABTEST=$S($P(LABTEST,";",2)="99LRT":+LABTEST,1:0)
  1. I 'LABTEST Q 0
  1. I $$OK4CPRS^LRAPDLG(LABTEST) S OK=1
  1. I OK,$G(QUICK) D
  1. . S OK=0
  1. . S LABIEN=+$O(^ORD(101.45,"C",ORDITEM,0)) I 'LABIEN Q
  1. . I +$P($G(^ORD(101.45,LABIEN,0)),U,6) Q
  1. . S NAME=$P($G(^ORD(101.43,ORDITEM,0)),U) I NAME="" Q
  1. . S X=$G(^ORD(101.43,"S.AP",NAME,ORDITEM)) I X="" Q
  1. . I +$P(X,U,3),$P(X,U,3)<$$NOW^XLFDT Q
  1. . S OK=1
  1. Q OK
  1. ;
  1. APORDITM(Y,QOCALL,ACCESS) ; Subset of AP orderable items
  1. D APOITEMS(.Y,$G(QOCALL),,,,$G(ACCESS))
  1. Q
  1. ;
  1. APDLGS ; Update AP Order Dialogs - Entry point for Option ORCM UPDATE AP DIALOGS
  1. N RESPONSE,ACTION,DLGIEN,EDITIEN,OIIEN,NAME,X0,I,NATSTAND,ORAPDLGEDIT
  1. S ORAPDLGEDIT=1 ; Disables NAME field override
  1. F D Q:ACTION=""
  1. . W !!,"Update Anatomic Pathology Order Dialogs",!
  1. . S RESPONSE=$$GETAPIENS
  1. . S ACTION=$P(RESPONSE,U) Q:(ACTION="")!(ACTION="R")
  1. . S DLGIEN=$P(RESPONSE,U,2),OIIEN=$P(RESPONSE,U,3),NATSTAND=$P(RESPONSE,U,4)
  1. . S EDITIEN=0
  1. . I ACTION="E" S EDITIEN=DLGIEN
  1. . I "^C^N^"[(U_ACTION_U) D Q:ACTION="R"
  1. . . N FDA,MSG,IEN
  1. . . I 'OIIEN S ACTION="R" Q
  1. . . S NAME=$P($G(^ORD(101.43,OIIEN,0)),U)
  1. . . I NAME="" W !,"Orderable Item not found!",! S ACTION="R" Q
  1. . . S FDA(101.45,"+1,",.01)=NAME,FDA(101.45,"+1,",.04)=OIIEN
  1. . . S FDA(101.45,"+1,",.06)=1 ; new entry starts as inactive
  1. . . I ACTION="C" D
  1. . . . S X0=$G(^ORD(101.45,DLGIEN,0))
  1. . . . S FDA(101.45,"+1,",.02)=$P(X0,U,2)
  1. . . . S FDA(101.45,"+1,",.03)=$P(X0,U,3)
  1. . . D UPDATE^DIE("","FDA","IEN","MSG")
  1. . . I ($D(MSG)>0)!('$G(IEN(1))) W !,"Error creating new entry. Please try again later." S ACTION="R" Q
  1. . . S EDITIEN=IEN(1)
  1. . . I ACTION="C" D
  1. . . . F I=1:1:4 I $D(^ORD(101.45,DLGIEN,I)) M ^ORD(101.45,EDITIEN,I)=^ORD(101.45,DLGIEN,I)
  1. . I EDITIEN D
  1. . . N DA,DIE,DR
  1. . . S DIE="^ORD(101.45,",DA=+EDITIEN
  1. . . I NATSTAND S DR="[OR AP DIALOG ACTIVATE ONLY]"
  1. . . E S DR="[OR AP DIALOG EDIT TEMPLATE]"
  1. . . D ^DIE
  1. Q
  1. ;
  1. GETAPIENS() ;
  1. N IDX,OILIST,ITEM,FLAG,HASFLAGS,CANEDIT,MAX,UMAX,ACTION,ACTIONS,INDEX
  1. N EDITIDX,TXT,NEWIDX,EDITIEN,NEWIEN,EDITNAME,NEWNAME,MSG,NATFLAG
  1. N DA,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,DONE,UNASSIGNED,CANCOPY,ACTCOUNT
  1. D APOITEMS(.UNASSIGNED,0,1,1) S UMAX=+$O(UNASSIGNED(9999999),-1),CANCOPY=(UMAX>0)
  1. D APOITEMS(.OILIST,0,1,0,1) S MAX=+$O(OILIST(9999999),-1),CANEDIT=(MAX>0)
  1. S (HASFLAGS,EDITIDX,NEWIDX)=0,(ACTION,ACTIONS)=""
  1. S IDX=0 F S IDX=$O(OILIST(IDX)) Q:('IDX)!HASFLAGS D
  1. . I $P(OILIST(IDX),U,4)=1 S HASFLAGS=1
  1. W !,"Before you can copy existing anatomic pathology order dialogs,"
  1. W !,"or create new order dialogs, you must work with your laboratory"
  1. W !,"application coordinator to create new, active anatomic pathology"
  1. W !,"tests in the LABORATORY TEST File (#60) that are mapped to a"
  1. W !,"CPRS SCREEN.",!
  1. I CANCOPY D
  1. . D ADDACTION("N")
  1. . I MAX D ADDACTION("C")
  1. I CANEDIT D ADDACTION("E")
  1. I ACTIONS="" Q ""
  1. S ACTCOUNT=$L(ACTIONS,";")
  1. I ACTCOUNT=1 S ACTION=$E(ACTIONS,1)
  1. E D
  1. . S TXT="",INDEX=0,DIR(0)="SOB^"_ACTIONS
  1. . F IDX=1:1:ACTCOUNT S ACTION=$P($P(ACTIONS,";",IDX),":") D
  1. . . D ADD(.TXT,$$GETATXT(ACTION),$S(IDX<ACTCOUNT:", ",1:" or "))
  1. . . D ADDDESC(ACTION)
  1. . S DIR("A")=TXT,DIR("?")=" "
  1. . D ^DIR S ACTION=$S($D(DIRUT):"",1:$G(Y))
  1. I ACTION="" Q ""
  1. ; Get OILIST array index (in EDITIDX) for Copy or Edit
  1. I "^C^E^"[(U_ACTION_U) D
  1. . W !!,"Existing Anatomic Pathology Order Dialogs:",!!
  1. . S IDX=0 F S IDX=$O(OILIST(IDX)) Q:'IDX D
  1. . . S ITEM=OILIST(IDX),FLAG=$S($P(ITEM,U,4)=1:"*",1:" ")
  1. . . W ?1,IDX,?5,FLAG_$P(ITEM,U,2),!
  1. . I HASFLAGS W !,"* Indicates a National Standard.",!
  1. . K DA,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1. . S DIR(0)="NOA^1:"_MAX_":0"
  1. . S DIR("A")="Select Order Dialog to "_$$GETATXT(ACTION)_" (1-"_MAX_"): "
  1. . D ^DIR I $D(DIRUT) S ACTION="" Q
  1. . W !," ",$P($G(OILIST(+$G(Y))),U,2),!
  1. . S EDITIDX=+$G(Y) I EDITIDX=0 S ACTION="R"
  1. ; Get UNASSIGNED array Index (in NEWIDX) for New or Copy
  1. I "^C^N^"[(U_ACTION_U) D
  1. . W !!,"Anatomic Pathology Orderable Items not assigned to an Order Dialog:",!!
  1. . S IDX=0 F S IDX=$O(UNASSIGNED(IDX)) Q:'IDX D
  1. . . W ?1,IDX,?5,$P(UNASSIGNED(IDX),U,2),!
  1. . K DA,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1. . S DIR(0)="NOA^1:"_UMAX_":0"
  1. . I ACTION="N" S TXT="New"
  1. . E S TXT="Copied"
  1. . S DIR("A")="Attach "_TXT_" Order Dialog to which Orderable Item? (1-"_UMAX_"): "
  1. . D ^DIR I $D(DIRUT) S ACTION="" Q
  1. . W !," ",$P($G(UNASSIGNED(+$G(Y))),U,2),!
  1. . S NEWIDX=+$G(Y) I NEWIDX=0 S ACTION="R"
  1. Q:(ACTION="")!(ACTION="R") ACTION
  1. S EDITIEN=$P($G(OILIST(EDITIDX)),U) I EDITIEN S EDITIEN=$O(^ORD(101.45,"C",EDITIEN,0))
  1. S EDITNAME=$P($G(OILIST(EDITIDX)),U,2)_" order dialog"
  1. S NEWIEN=$P($G(UNASSIGNED(NEWIDX)),U)
  1. S NEWNAME=$P($G(UNASSIGNED(NEWIDX)),U,2)_" orderable item"
  1. K DA,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1. W !
  1. S DIR(0)="YA",DIR("B")="NO",TXT=""
  1. I ACTION="N" S TXT="Create new order dialog and link it to "_NEWNAME
  1. I ACTION="C" S TXT="Copy "_EDITNAME_" and link it to "_NEWNAME
  1. I ACTION="E" S TXT="Edit "_EDITNAME
  1. I TXT'="" D
  1. . S TXT=TXT_"? (Yes or No): "
  1. . D WRAP^ORUTL(TXT,"DIR(""A"")",1,0,2,0,70)
  1. . S IDX=$O(DIR("A",99999),-1) S DIR("A")=DIR("A",IDX) K DIR("A",IDX)
  1. . D ^DIR I $D(DIRUT) S ACTION="" Q
  1. . I $G(Y)'=1 S ACTION="R"
  1. S NATFLAG="" I ACTION="E",+EDITIEN,$P($G(^ORD(101.45,EDITIEN,0)),U,5) S NATFLAG=1
  1. Q ACTION_U_EDITIEN_U_NEWIEN_U_NATFLAG
  1. ;
  1. ADDACTION(ACTION) ; Add Action Text to TEXT
  1. N ATXT S ATXT=ACTION_":"_$$GETATXT(ACTION)
  1. D ADD(.ACTIONS,ATXT,";")
  1. Q
  1. ;
  1. ADD(TEXT,TEXT2,PREFIX) ; Add TEXT2 to TEXT, insert PREFIX between the two if TEXT '= ""
  1. N RESULT
  1. S RESULT=TEXT
  1. I TEXT'="" S RESULT=RESULT_PREFIX
  1. S RESULT=RESULT_TEXT2
  1. S TEXT=RESULT
  1. Q
  1. ;
  1. GETATXT(ACTION) ; Get Action Text
  1. I ACTION="N" Q "New"
  1. I ACTION="C" Q "Copy"
  1. I ACTION="E" Q "Edit"
  1. Q "*** ERROR: INVALID ACTION """_ACTION_""""
  1. ;
  1. ADDQ(TEXT) ; Add TEXT to DIR("?",INDEX) or RESULT
  1. S INDEX=INDEX+1
  1. S DIR("?",INDEX)=TEXT
  1. Q
  1. ;
  1. ADDDESC(ACTION) ; Get action description
  1. I ACTION="N" D Q
  1. . D ADDQ("(N)ew will create a new order dialog, link it to an existing,")
  1. . D ADDQ(" unassigned, anatomic pathology orderable item, and allow")
  1. . D ADDQ(" you to edit the new order dialog.")
  1. . D ADDQ(" ")
  1. I ACTION="C" D Q
  1. . D ADDQ("(C)opy will copy an existing order dialog to a new order dialog,")
  1. . D ADDQ(" link that dialog to an existing, unassigned, anatomic pathology")
  1. . D ADDQ(" orderable item, and allow you to edit the copied order dialog.")
  1. . D ADDQ(" ")
  1. I ACTION="E" D Q
  1. . N ETXT
  1. . S ETXT="(E)dit allows you to edit an existing order dialog."
  1. . I HASFLAGS S ETXT=ETXT_" National"
  1. . D ADDQ(ETXT)
  1. . I HASFLAGS D ADDQ(" Standard dialogs may only be activated/inactivated.")
  1. . D ADDQ(" ")
  1. D ADDQ($$GETATXT(ACTION))
  1. Q