- 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 Jan 18, 2025@04:02:43 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