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

MDARSET.m

Go to the documentation of this file. 
  1. MDARSET ; HOIFO/NCA,WOIFO/KLM - High Volume Check-In Setup ;31 Oct 2018 10:02 AM
  1.  ;;1.0;CLINICAL PROCEDURES;**21,65,73**;Apr 01, 2004;Build 2
  1.  ; Reference IA # 2263 [Supported] XPAR parameter calls
  1.  ;               10104 [Supported] XLFSTR call
  1.  ;                6924 [Private  ] ^TIU(8925.1
  1.  ;
  1. EN1 ; Entry Point for the setup option
  1.  N MDAPT,MDAR,MDCP,MDCP1,MDCT,MDDEF,MDERR,MDKK,MDLST,MDLST1,MDMF,MDNOD,MDVAL,MDX,MDX1,X,Y S (MDMF,MDCT)=0
  1.  D GETLST^XPAR(.MDLST,"SYS","MD GET HIGH VOLUME")
  1.  F MDKK=0:0 S MDKK=$O(MDLST(MDKK)) Q:MDKK<1  S MDX=$G(MDLST(MDKK)),MDLST1(+MDX)=MDKK_"^"_$P(MDX,"^",2),MDCT=MDCT+1
  1.  S MDAR=$$GET^XPAR("SYS","MD NOT ADMN CLOSE MUSE NOTE",1)
  1. A1 ; Ask for procedure parameter
  1.  N MDTIU
  1.  S (MDCP1,MDDEF)="",MDCP1="NO"
  1.  W !!,"Procedure: " R X:DTIME G:'$T!("^"[X) KIL
  1.  I X["?" D PHELP
  1.  K DIC S DIC="^MDS(702.01,",DIC(0)="EQMZ",DIC("S")="I +$P(^(0),U,9)>0&(+$P(^(0),U,6)'=2)&(+$P(^(0),U,11)'=2)"
  1.  D ^DIC K DIC G A1:"^"[X!$D(DTOUT),A1:Y<1
  1.  S MDCP=+Y,MDNOD="" D CHKTL I MDTIU']"" G A1 ;KLM/p65 -note title information. /p73 If no title, can't proceed
  1.  S MDMF=$$MUSE(MDCP)
  1.  I $G(MDLST1(MDCP))'="" S MDDEF=+$P($G(MDLST1(MDCP)),"^",2),MDCP1=+$P($P($G(MDLST1(MDCP)),"^",2),";",2)
  1.  I $G(MDLST1(MDCP))="" G A2
  1. A11 ; Ask to delete an existing entry
  1.  K DIR S DIR(0)="YA",DIR("A")="Delete current procedure setup? ",DIR("B")="NO",DIR("?")="Enter either 'Y' or 'N'."
  1.  S DIR("?",1)="Enter Yes or No, if you want to delete the setup for the procedure."
  1.  D ^DIR G:$D(DIRUT)!$D(DIROUT)!(Y<0) KIL K DIR
  1.  I +Y D EN^XPAR("SYS","MD GET HIGH VOLUME",$P($G(^MDS(702.01,+MDCP,0)),"^",1),"@") D:+MDMF EN^XPAR("SYS","MD NOT ADMN CLOSE MUSE NOTE",1,0) W "...Procedure deleted" D  S MDR=1 G TIU
  1.  .S MDNOD=+MDLST1(MDCP) K MDLST1(MDCP),MDLST(+MDNOD) Q
  1. A2 ; Get Text
  1.  K DIR S DIR(0)="YA",DIR("A")="Get Text? " S:MDDEF'="" DIR("B")=$S(+MDDEF:"Yes",1:"No") S DIR("?")="Enter either 'Y' or 'N'."
  1.  S DIR("?",1)="Indicate whether the text from the result should or should not"
  1.  S DIR("?",2)="be obtained."
  1.  D ^DIR G:$D(DIRUT)!$D(DIROUT)!(Y<0) KIL K DIR
  1.  S MDDEF=Y
  1.  I '+MDDEF S MDVAL=MDDEF_";"_0 D:+MDMF EN^XPAR("SYS","MD NOT ADMN CLOSE MUSE NOTE",1,0) G SET
  1.  I '+MDMF G A4
  1. A3 ; Use Interpreter to close the note
  1.  K DIR S DIR(0)="YA",DIR("A")="Use Interpreter to close note? " S:MDAR'="" DIR("B")=$S(+MDAR:"Yes",1:"No") S DIR("?")="Enter either 'Y' or 'N'."
  1.  S DIR("?",1)="If 'YES', the interpreter of the result will be used to close"
  1.  S DIR("?",2)="the note.  If 'NO', the Proxy service will be used."
  1.  D ^DIR G:$D(DIRUT)!$D(DIROUT)!(Y<0) KIL K DIR
  1.  D EN^XPAR("SYS","MD NOT ADMN CLOSE MUSE NOTE",1,Y)
  1.  I +Y S MDVAL=MDDEF_";"_0 D EN^XPAR("SYS","MD GET HIGH VOLUME","`"_+MDCP,MDVAL) D  G TIU ;P73
  1.  .S MDNOD=$G(MDLST1(MDCP)) I MDNOD="" S MDCT=MDCT+1,MDLST1(MDCP)=MDCT_"^"_MDVAL,MDLST(MDCT)=MDCP_"^"_MDVAL Q
  1.  .I MDNOD'="" S $P(MDNOD,"^",2)=MDVAL,MDLST1(MDCP)=MDNOD,$P(MDLST(+MDNOD),"^",2)=MDVAL Q
  1.  .Q
  1. A4 ; Use CP Method
  1.  K DIR S DIR(0)="YA",DIR("A")="Do Not Auto Close Note? " S:MDCP1'="" DIR("B")=$S(+MDCP1:"Yes",1:"No") S DIR("?")="Enter either 'Y' or 'N'."
  1.  S DIR("?",1)="If 'YES', the text of the result will be in the significant finding of the procedure."
  1.  S DIR("?",2)="If 'NO', the default auto closure will be used."
  1.  D ^DIR G:$D(DIRUT)!$D(DIROUT)!(Y<0) KIL K DIR
  1.  S MDCP1=Y,MDVAL=MDDEF_";"_MDCP1
  1. SET ; Set parameter
  1.  D EN^XPAR("SYS","MD GET HIGH VOLUME","`"_+MDCP,MDVAL)
  1.  S MDNOD=$G(MDLST1(MDCP)) I MDNOD="" S MDCT=MDCT+1,MDLST1(MDCP)=MDCT_"^"_MDVAL,MDLST(MDCT)=MDCP_"^"_MDVAL
  1.  I MDNOD'="" S $P(MDNOD,"^",2)=MDVAL,MDLST1(MDCP)=MDNOD,$P(MDLST(+MDNOD),"^",2)=MDVAL
  1.  I $G(MDCP1)=1 G A1 ;p73 -If SIG FINDINGS do not set tech fields
  1. TIU ;KLM/P65 -Set tech fields COMMIT ACTION and POST-SIGNATURE CODE for note title
  1.  N MDIENS,MDTS
  1.  I MDTIU']"" W !,"Note title not found!" G A1
  1.  S MDIENS=MDTIU_","
  1.  I $D(MDR)=0 G TIU1 ;p73 - Skip asking for SET action.
  1.  W !,"Do you want to "_$S($D(MDR):"delete",1:"set")_" the technical fields for the "_MD01_" title?"
  1.  K Y,DIR S DIR(0)="Y",DIR("B")="Yes",DIR("?")="Enter 'Yes' to update the technical fields or 'No' to bypass this step"
  1.  S DIR("??")="^D TLH2^MDARSET" D ^DIR
  1.  I +Y=0 G A1
  1. TIU1 ;Check title's status (#.07), it must be inactive to continue
  1.  S MDTS=$$GET1^DIQ(8925.1,MDTIU,.07)
  1.  I MDTS'="INACTIVE" D  K MDR,MD41,MD49 G A1 ;p73
  1.  .W:$D(MDR)=1 !!,"Cannot update technical fields - Please INACTIVATE the note title first"
  1.  .I $D(MDR)=0 D
  1.  ..I (MD41="")&(MD49="") D
  1.  ...W !!,"Cannot update technical fields - Please INACTIVATE the note title first"
  1.  ...W !!,"** Deleting procedure from High Volume Setup **"
  1.  ...D EN^XPAR("SYS","MD GET HIGH VOLUME",$P($G(^MDS(702.01,+MDCP,0)),"^",1),"@") D:+MDMF EN^XPAR("SYS","MD NOT ADMN CLOSE MUSE NOTE",1,0)
  1.  ...S MDNOD=+MDLST1(MDCP) K MDLST1(MDCP),MDLST(+MDNOD)
  1.  ...Q
  1.  ..E  W !!,"Technical fields already set to 'QUIT', Procedure setup OK"
  1.  ..Q
  1.  .Q
  1.  ;MDR set if procedure's HV setup is deleted...
  1.  S MDFDA(8925.1,MDIENS,4.1)=$S($D(MDR):"",1:"Q") ;COMMIT ACTION
  1.  S MDFDA(8925.1,MDIENS,4.9)=$S($D(MDR):"",1:"Q") ;POST-SIGNATURE CODE
  1.  L +^TIU(8925.1,MDTIU):1 I '$T W !,"Record is locked." G XIT
  1.  D FILE^DIE("E","MDFDA","MDERR")
  1.  I $D(MDERR) D  G XIT
  1.  .W !,"Update failed due to the following reason: "
  1.  .S MDI="" F  S MDI=$O(MDERR("DIERR",1,"TEXT",MDI)) Q:MDI=""  W !,?5,$G(MDERR("DIERR",1,"TEXT",MDI))
  1.  .Q
  1.  L -^TIU(8925.1,MDTIU)
  1.  W !!,"Update successful!  Don't forget to REACTIVATE the title."
  1.  K MDFDA,MDR,MD01,MDERR,Y,DIR,MD41,MD49
  1.  G A1
  1. KIL ; kill DIR variables
  1.  K DIC,DIR,DIROUT,DIRUT,DTOUT
  1.  Q
  1. MUSE(MDP) ; Check if procedure has Muse as a device
  1.  N MDM,MDLL,MDINL S MDM=0
  1.  Q:'$G(MDP)
  1.  S MDLL=0 F  S MDLL=$O(^MDS(702.01,+MDP,.1,MDLL)) Q:MDLL<1  S MDINL=+$G(^(MDLL,0)) D  Q:+MDM
  1.  .S:$$UP^XLFSTR($$GET1^DIQ(702.09,MDINL_",",".01","E"))["MUSE" MDM=1
  1.  Q MDM
  1. PHELP ; Procedure list
  1.  N MDCH,MDACN,MDNAU
  1.  S MDNAU=+$$GET^XPAR("SYS","MD USE NOTE",1)
  1.  S MDACN=$$GET^XPAR("SYS","MD NOT ADMN CLOSE MUSE NOTE",1)
  1.  W ! F MDKK=0:0 S MDKK=$O(MDLST(MDKK)) Q:MDKK<1  S MDX=$G(MDLST(MDKK)),MDX1=$P(MDX,"^",2) D
  1.  .S MDCH=0 S:+$$MUSE(+MDX) MDCH=1
  1.  .W !,$P($G(^MDS(702.01,+MDX,0)),"^"),?45,$S(+$P(MDX1,";"):"Text",1:"No Text")
  1.  .W ?55,$S((+$P(MDX1,";",2)&'+MDNAU):"SF",(+MDCH&+MDACN):"Muse Interpreter",(+$P(MDX1,";",2)&+MDNAU):"Not Auto",1:"Auto")
  1.  W !
  1.  Q
  1. CHKTL ;KLM/P65 -Display the associated note title information
  1.  Q:'MDCP
  1.  N MDIENS S MDTIU=$$GET1^DIQ(702.01,MDCP,.04,"I") I MDTIU']"" W !,"Note title not found!" Q
  1.  S MDIENS=MDTIU_"," D GETS^DIQ(8925.1,MDIENS,".01;.07;4.1;4.9","","MDROOT")
  1.  S MD01=$G(MDROOT(8925.1,MDIENS,.01)) ;TITLE
  1.  S MD41=$G(MDROOT(8925.1,MDIENS,4.1)) ;COMMIT ACTION
  1.  S MD49=$G(MDROOT(8925.1,MDIENS,4.9)) ;POST-SIGNATURE CODE
  1.  S MD07=$G(MDROOT(8925.1,MDIENS,.07)) ;STATUS
  1.  W !!,?5,"This procedure has note title "_MD01_" associated with it."
  1.  W !!,?5,"The current setup is as follows:"
  1.  W !,?10,"STATUS:",?32,MD07
  1.  W !,?10,"COMMIT ACTION:",?32,$S(MD41]"":MD41,1:"<NULL>")
  1.  W !,?10,"POST-SIGNATURE CODE:",?32,$S(MD49]"":MD41,1:"<NULL>")
  1.  W !!,?5,"When a procedure is setup for High Volume, the COMMIT ACTION and"
  1.  W !,?5,"POST-SIGNATURE CODE fields must contain a 'Q'. If you need to update"
  1.  W !,?5,"these fields, the title ("_MD01_") must be inactivated first.",!!
  1.  K MDROOT,MD07
  1.  Q
  1. TLH2 ;Help for ?? on update title prompt
  1.  W !!,"Select 'Yes' to "_$S($D(MDR):"delete",1:"set")_" the COMMIT ACTION and POST-SIGNATURE CODE"
  1.  W !,"technical fields of the associated note title. Note that if you"
  1.  W !,"are deleting a procedure from the High Volume setup, but the note"
  1.  W !,"title is shared with other procedures still configured for High"
  1.  W !,"Volume, then you should not delete these fields, but instead"
  1.  W !,"create a new title to be used separately (unless the procedure"
  1.  W !,"is being decommissioned)."
  1.  Q
  1. XIT ;clean up and go
  1.  K MDFDA,MDIENS,MDR,MD01,MDTS,MDERR,MDI,MDTIU,Y,DIR
  1.  Q