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