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

YTXCHGL.m

Go to the documentation of this file. 
  1. YTXCHGL ;SLC/KCM - MH Exchange List Manager Calls  ; 08-AUG-2016
  1.  ;;5.01;MENTAL HEALTH;**121,218**;Dec 30, 1994;Build 9
  1.  ;
  1. EN ; -- main entry point for YTXCHG MAIN
  1.  D EN^VALM("YTXCHG MAIN")
  1.  D FULL^VALM1
  1.  Q
  1.  ;
  1. HDR ; -- header code
  1.  S VALMHDR(1)="Instrument Exchange File Entries"
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1.  K ^TMP("YTXLST",$J)
  1.  N CNT,NM,DT,IEN,ROW,X0,PKEY
  1.  D OWNSKEY^XUSRB(.PKEY,"XUPROG")
  1.  S CNT=0
  1.  S NM="" F  S NM=$O(^YTT(601.95,"C",NM)) Q:NM=""  D
  1.  . S DT=0 F  S DT=$O(^YTT(601.95,"C",NM,DT)) Q:'DT  D
  1.  . . S IEN=0 F  S IEN=$O(^YTT(601.95,"C",NM,DT,IEN)) Q:'IEN  D
  1.  . . . S X0=^YTT(601.95,IEN,0)
  1.  . . . I 'PKEY(0),$P(X0,U,3)="backup copy" Q  ; screen out backup copies
  1.  . . . S CNT=CNT+1,ROW=""
  1.  . . . S ROW=$$SETFLD^VALM1(CNT,ROW,"ITEM")
  1.  . . . S ROW=$$SETFLD^VALM1($P(X0,U),ROW,"ENTRY")
  1.  . . . S ROW=$$SETFLD^VALM1($P(X0,U,3),ROW,"SOURCE")
  1.  . . . S ROW=$$SETFLD^VALM1($$FMTE^XLFDT($P(X0,U,2),"5Z"),ROW,"CREATED")
  1.  . . . S ^TMP("YTXLST",$J,CNT,0)=ROW
  1.  . . . S ^TMP("YTXLST",$J,"IDX",CNT,IEN)=""
  1.  S VALMCNT=CNT
  1.  Q
  1. HELP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1. EXIT ; -- exit code
  1.  Q
  1. EXPND ; -- expand code
  1.  Q
  1.  ;
  1. CREATE ; create new instrument exchange entry
  1.  D FULL^VALM1
  1.  K ^TMP("YTXCHG",$J,"WP",2)
  1.  N TESTS,REC
  1.  D LIST^YTXCHGP(601.71,.TESTS) I TESTS=0 G XREFR
  1.  S REC(.01)=$$PRMTNAME^YTXCHGP("Exchange Name") I '$L(REC(.01)) G XREFR ; name
  1.  S REC(.02)=$$NOW^XLFDT                                                 ; date/time
  1.  S REC(.03)=$P($$GET1^DIQ(200,DUZ,.01),",")_"@"_$P($$SITE^VASITE,U,2)   ; source
  1.  S REC(2)=$NA(^TMP("YTXCHG",$J,"WP",2))                                 ; description
  1.  D EDITWP^YTXCHGP("Enter a description for "_REC(.01),REC(2))
  1.  W !!,"Creating:",?11,REC(.01)
  1.  W !,?11,$$FMTE^XLFDT(REC(.02),"5Z")
  1.  D CREATE^YTXCHG(.TESTS,.REC)
  1.  K ^TMP("YTXCHG",$J,"WP",2)
  1.  D XPAUSE
  1.  Q
  1. REBUILD ; rebuild spec for existing exchange entry (with new date)
  1.  D FULL^VALM1
  1.  N XCHGIEN,INFO,TESTS,I
  1.  S XCHGIEN=$$SELECT() I 'XCHGIEN G XREFR
  1.  K ^TMP("YTXCHG",$J,"WP")
  1.  D INFO^YTXCHG(XCHGIEN,.INFO)
  1.  W !!," Rebuilding:",?14,INFO(.01)
  1.  W !,?14,$$FMTE^XLFDT(INFO(.02),"5Z")
  1.  W !,"Instruments:"
  1.  S I=0 F  S I=$O(INFO("tests",I)) Q:'I  D
  1.  . W ?14,INFO("tests",I),!
  1.  . S TESTS(I)=$O(^YTT(601.71,"B",INFO("tests",I),0))
  1.  K INFO("tests")
  1.  I $$CONFIRM^YTXCHGP("Do you want to continue? ")<1 G XREBUILD
  1.  D DELETE^YTXCHG(XCHGIEN)
  1.  D CREATE^YTXCHG(.TESTS,.INFO)
  1.  D XPAUSE
  1. XREBUILD ; exit REBUILD here
  1.  K ^TMP("YTXCHG",$J,"WP")
  1.  Q
  1. DELETE ; delete instrument exchange entry
  1.  N XCHGIEN,XCHGNM
  1.  S XCHGIEN=$$SELECT() I 'XCHGIEN G XREFR
  1.  S XCHGNM=$P(^YTT(601.95,XCHGIEN,0),U)
  1.  I $$CONFIRM^YTXCHGP("Are you sure you want to delete "_XCHGNM_"? ")<1 G XREFR
  1.  D DELETE^YTXCHG(XCHGIEN)
  1.  D XINIT
  1.  Q
  1. DRYRUN ; Trial install without database changes
  1.  N DRYRUN S DRYRUN=1
  1.  ; drop through to install with DRYRUN set
  1. INSTALL ; Install instrument exchange entry locally
  1.  D FULL^VALM1
  1.  N XCHGIEN,STATS,YTXVRB
  1.  S XCHGIEN=$$SELECT() I 'XCHGIEN G XREFR
  1.  S YTXVRB=$$CONFIRM^YTXCHGP("Use verbose mode? ","No") G:YTXVRB<0 XREFR
  1.  W !!,$S($G(DRYRUN):"Trial ",1:"")_"Installing "_$P(^YTT(601.95,XCHGIEN,0),U)
  1.  I $G(DRYRUN) W !,"*** No database changes will be made. ***",!
  1.  D INSTALL^YTXCHG(XCHGIEN,$G(DRYRUN))
  1.  D XPAUSE
  1.  Q
  1. BROWSE ; Browse instrument specification
  1.  D FULL^VALM1
  1.  N XCHGIEN,NUM,NAME
  1.  S XCHGIEN=$$SELECT() I 'XCHGIEN G XREFR
  1.  K ^TMP("YTXCHG",$J,"TREE")
  1.  K ^TMP("YTXCHG",$J,"BROWSE")
  1.  D SPEC2TR^YTXCHGT(XCHGIEN,$NA(^TMP("YTXCHG",$J,"TREE")))
  1.  S NUM=$$PICKTEST^YTXCHGP($NA(^TMP("YTXCHG",$J,"TREE"))) I 'NUM G XREFR
  1.  S NAME=^TMP("YTXCHG",$J,"TREE","test",NUM,"info","name")_" Specification"
  1.  D BLDVIEW^YTXCHG($NA(^TMP("YTXCHG",$J,"TREE","test",NUM)),$NA(^TMP("YTXCHG",$J,"BROWSE")))
  1.  D BROWSE^DDBR($NA(^TMP("YTXCHG",$J,"BROWSE")),"NR",NAME)
  1.  K ^TMP("YTXCHG",$J,"TREE")
  1.  K ^TMP("YTXCHG",$J,"BROWSE")
  1.  D XREFR
  1.  Q
  1. SAVEHOST ; Save exchange entry to host file
  1.  N XCHGIEN,FULLNM,OK
  1.  S XCHGIEN=$$SELECT() I 'XCHGIEN G XREFR
  1.  I $D(^YTT(601.95,XCHGIEN,1))'>1 W !,"No data to save." G XREFR
  1.  S FULLNM=$$PRMTNAME^YTXCHGP("Enter file name","Enter full path and filename.",245)
  1.  I '$L(FULLNM) G XREFR
  1.  S OK=$$SAVEHFS^YTXCHG(XCHGIEN,FULLNM)
  1.  W !,$S(OK:"File saved.",1:"Save failed.")
  1.  D XPAUSE
  1.  Q
  1. LOADHOST ; Load exchange entry from host file
  1.  D FULL^VALM1
  1.  K ^TMP("YTXCHG",$J,"WP")
  1.  N FULLNM,XCHGREC
  1.  S FULLNM=$$PRMTNAME^YTXCHGP("Enter file name","Enter full path and filename.",245)
  1.  I '$L(FULLNM) G XREFR
  1.  D LOADFILE^YTXCHG(FULLNM,.XCHGREC) I $G(XCHGREC)=-1 G XLOADHST
  1.  D LOAD2FM(.XCHGREC)
  1. XLOADHST ; exit LOADHOST here
  1.  D XPAUSE
  1.  K ^TMP("YTXCHG",$J,"WP")
  1.  Q
  1. LOADURL ; Load exchange entry from URL
  1.  D FULL^VALM1
  1.  K ^TMP("YTXCHG",$J,"WP")
  1.  N URL,XCHGREC
  1.  S URL=$$PRMTNAME^YTXCHGP("Enter the URL","Enter the full URL of the desired file.",245)
  1.  S URL=$$LOW^XLFSTR(URL)
  1.  I '$L(URL) G XREFR
  1.  D LOADFILE^YTXCHG(URL,.XCHGREC) I $G(XCHGREC)=-1 G XLOADURL
  1.  D LOAD2FM(.XCHGREC)
  1. XLOADURL ; exit LOADURL here
  1.  D XPAUSE
  1.  K ^TMP("YTXCHG",$J,"WP")
  1.  Q
  1. LOAD2FM(XCHGREC) ; confirm and load into Fileman entry (file 601.95)
  1.  N I,REPLACE,XCHGIEN
  1.  I '$L($G(XCHGREC(.01)))!'$L($G(XCHGREC(.02))) W !,"File is wrong format." QUIT
  1.  W !
  1.  W !,"This will load:  "_XCHGREC(.01)
  1.  W !,"    created on:  "_$$FMTE^XLFDT(XCHGREC(.02),"5Z")
  1.  W !,"        source:  "_XCHGREC(.03)
  1.  W !,"Description ---"
  1.  S I=0 F  S I=$O(^TMP("YTXCHG",$J,"WP",2,I)) Q:'I  W !,?3,^TMP("YTXCHG",$J,"WP",2,I,0)
  1.  S REPLACE=$D(^YTT(601.95,"C",XCHGREC(.01),XCHGREC(.02)))
  1.  I REPLACE W !!,">>> This will OVERWRITE the current entry!"
  1.  I '$$CONFIRM^YTXCHGP("Do you want to continue? ",$S(REPLACE:"No",1:"Yes")) QUIT
  1.  I REPLACE D
  1.  . S XCHGIEN=$O(^YTT(601.95,"C",XCHGREC(.01),XCHGREC(.02),0))
  1.  . D FMUPD^YTXCHGU(601.95,.XCHGREC,.XCHGIEN)
  1.  E  D FMADD^YTXCHGU(601.95,.XCHGREC,.XCHGIEN)
  1.  W !,$P(^YTT(601.95,XCHGIEN,0),U)_" loaded."
  1.  Q
  1.  ;
  1. XINIT ; exit back to LM, update listing
  1.  D INIT S VALMBCK="R"
  1.  Q
  1. XPAUSE ; exit back to LM, pause first
  1.  D PAUSE^YTXCHGP
  1.  D INIT S VALMBCK="R"
  1.  Q
  1. XREFR ; exit back to LM, refresh screen only
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1. SELECT() ; return IEN for selection from list
  1.  N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,IEN
  1.  S DIR(0)="N^1:"_VALMCNT_":0"
  1.  D ^DIR
  1.  I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) Q 0
  1.  I 'Y Q 0
  1.  S IEN=$O(@VALMAR@("IDX",+Y,""))
  1.  Q IEN
  1.  ;