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

SDTMPEDT.m

Go to the documentation of this file.
  1. SDTMPEDT ;MS/SJA - TELEHEALTH STOP CODES EDIT ;Dec 17, 2020
  1. ;;5.3;Scheduling;**773,779,780,817,859**;Aug 13, 1993;Build 10
  1. ;
  1. ;
  1. EDIT ; Add/edit stop code entries in file #40.6
  1. N ADD,DEL,Y,X,STOPCODE,X1,GOOD,TMPERR
  1. S GOOD=0,X1=0,(ADD,DEL)=0
  1. K DIR,DTOUT,DUOUT
  1. W ! S DIR(0)="N",DIR("A")="Enter Stop Code"
  1. S DIR("?")="This is the stop code to added or deleted" D ^DIR K DIR I 'Y!$D(DTOUT)!$D(DUOUT) G EXIT
  1. S STOPCODE=Y
  1. S GOOD=$$CHKSTOP(STOPCODE) ;check to see if valid stop code in 40.7, message to user and quit if not valid
  1. I GOOD'>0 S TEXT="NOT A VALID STOP CODE" D MSG(TEXT) G:$G(Y) EDIT I $D(DTOUT)!$D(DUOUT) G EXIT ; Need to add code to give user an error message
  1. S X1=$O(^SD(40.6,"B",STOPCODE,""))
  1. D ASK($S(X1>0:"D",1:"A")) I $D(DTOUT)!$D(DUOUT) G EXIT
  1. I $G(DEL)="0",($G(ADD)="0") W ! D MSG("Do you want to edit another stop code") G:$G(Y) EDIT I 'Y!$D(DTOUT)!$D(DUOUT) G EXIT
  1. D UPD(DEL,STOPCODE)
  1. S TEXT=$G(TMPERR)
  1. D MSG("Do you want to edit another stop code") G:$G(Y) EDIT I $D(DTOUT)!$D(DUOUT) G EXIT
  1. Q
  1. UPD(DEL,STOPCODE) ;
  1. N FDA
  1. I DEL="1" S FDA(40.6,X1_",",.01)="@"
  1. E S FDA(40.6,"+1,",.01)=STOPCODE
  1. D UPDATE^DIE("","FDA","TMPERR")
  1. W !,$C(7),"STOP Code: ",STOPCODE," has been ",$S(DEL=1:"Deleted!",1:"Added!"),!
  1. Q
  1. ASK(ACT) ;
  1. D EX1
  1. S DIR(0)="Y",DIR("A")="This stop code is "_$S(ACT="D":"already",1:"NOT")_" in the file, do you want to "_$S(ACT="D":"delete",1:"add")_" it",DIR("B")="NO"
  1. D ^DIR K DIR I Y S:ACT="D" DEL=Y S:ACT="A" ADD=Y
  1. Q
  1. CHKSTOP(STOPCODE) ;
  1. N XX
  1. S XX=$O(^DIC(40.7,"C",STOPCODE,"")) ; check to be sure it is valid stop code
  1. Q XX
  1. EX1 ;
  1. K DIR(0),DIR("A"),DIR("?"),DIRUT,DUOUT,DTOUT,DIROUT,X,Y
  1. Q
  1. EXIT ;
  1. K DIR(0),DIR("A"),DIR("?"),DIRUT,DUOUT,DTOUT,DIROUT,X,X1,Y,STOPCODE
  1. Q
  1. MSG(TEXT) ; give user error message if stop code is not valid
  1. D EX1
  1. S DIR(0)="Y",DIR("A")=$G(TEXT),DIR("B")="NO" D ^DIR
  1. Q
  1. ;
  1. PROVID ; provider fields add/edit
  1. N CLNDA,JJ,PRIEN,SEQ,TXT,SDACT
  1. W !!!,$C(7),"CAUTION: DO NOT USE - Default Provider for setting up a Shared or Patient Site",!,?19,"Telehealth VistA Clinics."
  1. W !! S DIC("A")="Select Clinic: ",(DIC,DIE)=44,DIC(0)="AEQMZ" D ^DIC G:"^"[X EX
  1. G:Y<0 PROVID
  1. S CLNDA=+Y
  1. L +^SC(CLNDA,0):5 I '$T W !!,$C(7),"Another user is editing this record. Try again later.",! D CR G EX
  1. S TXT="Providers associated with this clinic"
  1. W !!,$S($O(^SC(CLNDA,"PR",0)):" "_TXT_":",1:" No "_TXT_".")
  1. S PRIEN=0 F S PRIEN=$O(^SC(CLNDA,"PR","B",PRIEN)) Q:'PRIEN W !,?4,"- ",$$GET1^DIQ(200,PRIEN,.01) D
  1. . S SEQ=$O(^SC(CLNDA,"PR","B",PRIEN,0)) I $$GET1^DIQ(44.1,SEQ_","_CLNDA_",",.02,"I") W ?39,"<< Default >>"
  1. ; edit default provider and provider multiple fields
  1. W !
  1. S SDACT=$G(^SC(CLNDA,"I")) I +SDACT>0 I DT>$P(SDACT,U)&($P(SDACT,U,2)=""!(DT<$P(SDACT,U,2))) D D CR G EX
  1. . W !!,$C(7)," **** Provider update on inactive clinics is not allowed ****",!
  1. . L -^SC(CLNDA,0)
  1. K DR S DR="16",DA=CLNDA,DIE=44 D ^DIE K DR
  1. I X D DPMAIL
  1. I $D(Y) Q
  1. W !
  1. K DR S DR="2600",DR(2,44.1)=".01;.02",DA=CLNDA,DIE=44 D ^DIE K DR
  1. L -^SC(CLNDA,0)
  1. ;
  1. CR W !! K DIR S DIR("T")=DTIME,DIR(0)="EA",DIR("A")="Press <Enter> to continue: "
  1. D ^DIR K DIR
  1. Q
  1. EX W @IOF K DA,DIC,DIE,DR,DIR
  1. Q
  1. DPMAIL ; default provider email
  1. N DPDA
  1. S DPDA=X
  1. L +^VA(200,DPDA):5
  1. I '$T W !!,$C(7),"Another user is editing this provider record. Try again later.",! Q
  1. S DR=".151",DA=DPDA,DIE=200 D ^DIE K DR ;Prompt for default provider email - 780
  1. L -^VA(200,DPDA)
  1. Q