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

YTXCHGP.m

Go to the documentation of this file. 
  1. YTXCHGP ;SLC/KCM - MH Exchange Prompting ; 9/15/2015
  1.  ;;5.01;MENTAL HEALTH;**121**;Dec 30, 1994;Build 61
  1.  ;
  1. LKUP(FILE) ; Lookup Mental Health Instrument & return IEN
  1.  ; returns IEN, 0 for no selection, -1 for up-arrow or timeout
  1.  N DIC,X,Y,DTOUT,DUOUT
  1.  S DIC=FILE,DIC(0)="AEMQ" D ^DIC
  1.  S:Y<1 Y=0 S:$G(DUOUT)!$G(DTOUT) Y=-1
  1.  Q +Y
  1.  ;
  1. LIST(FILE,ENTRIES) ; Lookup in File to make list of ENTRIES
  1.  ;.ENTRIES=total
  1.  ;.ENTRIES(n)=ien
  1.  N I,IEN
  1.  S ENTRIES=0
  1.  F I=1:1 S IEN=$$LKUP(FILE) Q:IEN<1  S ENTRIES=I,ENTRIES(I)=IEN
  1.  I IEN<0 K ENTRIES S ENTRIES=0  ; ^out or timeout
  1.  Q
  1. PRMTNAME(ASK,HELP,MAX) ; Prompt using ASK and return text or ""
  1.  N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1.  S MAX=$G(MAX,64)
  1.  S DIR(0)="FO^3:"_MAX,DIR("A")=ASK S:$L($G(HELP)) DIR("?")=HELP
  1.  D ^DIR
  1.  I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) S Y=""
  1.  S Y=$$TRIM^XLFSTR(Y)
  1.  Q Y
  1.  ;
  1. CONFIRM(ASK,DFLT) ; return true if user confirms
  1.  N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1.  S DIR(0)="YA",DIR("A")=ASK,DIR("B")=$G(DFLT,"YES")
  1.  D ^DIR
  1.  I $G(DUOUT)!$G(DTOUT) S Y=-1
  1.  Q +Y
  1.  ;
  1. PAUSE() ; prompt user for return to continue
  1.  N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1.  S DIR(0)="EA",DIR("A")="Press return to continue..."
  1.  D ^DIR
  1.  Q
  1. EDITWP(INSTRUCT,DEST) ; Edit word processing text in DEST
  1.  ; INSTRUCT: instructions to user
  1.  ;     DEST: global reference for WP text
  1.  I $E($RE(DEST))=")" S $E(DEST,$L(DEST))=","
  1.  W !,INSTRUCT," --"
  1.  N DIC,DDWFLAGS,DWLW,DWPK
  1.  N I,J,X,X1  ; variables that DIWE seems to leave around
  1.  S DIC=DEST,DDWFLAGS="Q",DWLW=72,DWPK=1
  1.  D EN^DIWE
  1.  I '$D(@(DEST_"1,0)")) D
  1.  . S @(DEST_"0)")="^^1^1^"_DT_"^"
  1.  . S @(DEST_"1,0)")="(no description)"
  1.  Q
  1. PICKTEST(TREE) ; Return a string of instruments selected]
  1.  N I,X,T,TESTS
  1.  S I=0 F  S I=$O(@TREE@("test",I)) Q:'I  D
  1.  . S TESTS=I
  1.  . S TESTS(I)=@TREE@("test",I,"info","name")
  1.  . S TESTS("B",$$LOW^XLFSTR(TESTS(I)))=I
  1.  I TESTS=1 Q 1  ; no prompting if only 1 tests
  1.  ;
  1.  F  D  Q:X'["?"
  1.  . D TESTLIST
  1.  . W !!,"Choose instrument to browse: "
  1.  . R X:DTIME S:$E(X)="^" X="" Q:X=""
  1.  . S X=$$LOW^XLFSTR(X)
  1.  . I +X,$D(TESTS(X)) Q                    ; number entered
  1.  . I $D(TESTS("B",X)) S X=TESTS("B",X) Q  ; full name entered
  1.  . S T=$O(TESTS("B",X))                   ; partial name entered
  1.  . I X=$E(T,1,$L(X)) W "  ",T S X=TESTS("B",T) Q
  1.  . W "  ??",! S X="?"                     ; no match
  1.  Q X
  1.  ;
  1. TESTLIST ; Show a list of tests
  1.  ; expects TESTS,TREE from PICKTEST
  1.  W !,"Instruments contained in ",@TREE@("xchg","name")," are:"
  1.  S I=0 F  S I=$O(TESTS(I)) Q:'I  W !,$J(I,4),?7,TESTS(I)
  1.  Q
  1. SHOSUMM(YTXLOG,YTXDRY) ; Display summary log information
  1.  ; may be called during KIDS build, so uses MES^XPDUTL
  1.  N MSG
  1.  I $G(YTXLOG("conflict")) D
  1.  . N I S I=0 F  S I=$O(YTXLOG("conflict",I)) Q:'I  D
  1.  . . S MSG="Conflict -- "_YTXLOG("conflict",I)
  1.  . . D MES^XPDUTL(MSG)
  1.  . S MSG="Conflicts with existing instruments prevent installation."
  1.  . D LOG^YTXCHGU("error",MSG)
  1.  . S MSG="Contact national support to resolve the conflicts."
  1.  . D MES^XPDUTL(MSG)
  1.  S MSG="  "_$G(YTXLOG("added"),0)_" records "_$S(YTXDRY:"would be ",1:"")_"added."
  1.  D MES^XPDUTL(MSG)
  1.  S MSG="  "_$G(YTXLOG("updated"),0)_" records "_$S(YTXDRY:"would be ",1:"")_"updated."
  1.  D MES^XPDUTL(MSG)
  1.  S MSG="  "_$G(YTXLOG("deleted"),0)_" records "_$S(YTXDRY:"would be ",1:"")_"deleted."
  1.  D MES^XPDUTL(MSG)
  1.  S MSG="  "_$G(YTXLOG("error"),0)_" errors."
  1.  D MES^XPDUTL(MSG)
  1.  Q