SDTMPUT2 ;MS/SJA - VISTA-BULK DEFAULT PROVIDER UPDATE ;May 15, 2022
;;5.3;Scheduling;**817,859**;Aug 13, 1993;Build 10
;
;
N AA,ACT,ALL,CLN,CNT,LN,DIV,III,NUM,LOC,RESTCD,SC,SDACT,STCODE,STCD,STOP,SDASH,SDOUT,STIEN,VAL,SEL,STFLG
N TOT,TOTAL,VAUTD,CLIEN,PRIEN,XX
EN ;
K ^TMP($J)
S $P(SDASH,"=",80)="",(SEL,ACT,DIV)="",(ALL,SDOUT)=0
W @IOF W !,?20,"Bulk update for Default Provider field",!
D ASK Q:SDOUT
S:$G(VAUTD)=1 DIV="ALL"
W ! D @SEL
G EN
;
C ; clinic
K ^TMP($J) S (TOTAL,TOT)=0
K DIC,DTOUT,DUOUT S DIC="^SC(",DIC(0)="AEQM",DIC("A")="Select Clinic: "
C1 D ^DIC I Y>0 S ^TMP($J,"CL",+Y)="",DIC("A")="Another one:" G C1
I $D(DTOUT)!($D(DUOUT))!('$O(^TMP($J,"CL",0))) Q
F III=0:0 S III=$O(^TMP($J,"CL",III)) Q:'III D
. W:TOTAL=0 !,SDASH,!
. D PRC(III)
W !!
W !,"Total number of clinics updated ",TOT," out of ",TOTAL
W !! S DIR(0)="EA",DIR("A")="Press <Enter> to continue" D ^DIR K DIR
Q
;
S ; stop codes
K ^TMP($J) S (LN,TOTAL,TOT)=0
K DIC,DTOUT,DUOUT S DIC="^SD(40.6,",DIC(0)="AEMQ",DIC("A")="Select Telehealth Stop Code: "
S1 D ^DIC I Y>0 S ^TMP($J,"ST",+Y)="",DIC("A")="Select another Telehealth Stop Code: " G S1
I $D(DTOUT)!($D(DUOUT))!('$O(^TMP($J,"ST",0))) Q
W !
F STIEN=0:0 S STIEN=$O(^TMP($J,"ST",STIEN)) Q:'STIEN S CLN=$$ST(STIEN)
F III=0:0 S III=$O(^TMP($J,"CL",III)) Q:'III S STOP=$G(^(III)) D
. W:TOTAL=0 !,SDASH,!
. S LN=LN+1 W:'(LN#50) "." D PRC(III,STOP)
W !!
W !,"Total number of clinics updated ",TOT," out of ",TOTAL
W !! S DIR(0)="EA",DIR("A")="Press <Enter> to continue" D ^DIR K DIR
Q
;
P ; provider selection
K ^TMP($J) S (TOTAL,TOT)=0
S DIC=200,DIC("A")="Select Provider: ",DIC(0)="AEMQ",DIC("S")="I $$SCREEN^SDUTL2(Y,DT)"
P1 D ^DIC I Y>0 S ^TMP($J,"PR",+Y)="",DIC("A")="Another one:" G P1
I $D(DTOUT)!($D(DUOUT))!('$O(^TMP($J,"PR",0))) Q
F III=0:0 S III=$O(^TMP($J,"PR",III)) Q:'III D
. W:TOTAL=0 !!,SDASH,!
. D PRU(III)
W !!
W !,"Total number of clinics updated ",TOT," out of ",TOTAL
W !! S DIR(0)="EA",DIR("A")="Press <Enter> to continue" D ^DIR K DIR
Q
;
ST(STIEN) ; stop codes search
N FLAG,FLG1,FLG2,CODE,P1,P2,P407F,P407S,II,NODE0,CLSTP1,CLSTP2,XX
S (FLAG,P407F,P407S,P1,P2)=0
S CODE=$G(^SD(40.6,STIEN,0)),P1=$E(CODE,1,3),P2=$E(CODE,4,6)
S P407F=$O(^DIC(40.7,"C",P1,0)) S:P2 P407S=$O(^DIC(40.7,"C",P2,0))
S II=0
F S II=$O(^SC(II)) Q:'II S FLAG=0 D
. S NODE0=$G(^SC(II,0)),CLSTP1=$P(NODE0,U,7),CLSTP2=$P(NODE0,U,18)
. I (SC="P"&($G(CLSTP1)="")!(SC="S"&$G(CLSTP2)="")) Q
. I SC="P" I $G(P407F)=$G(CLSTP1)!(CLSTP1=$G(P407S)) S FLAG=1
. I SC="S" I $G(P407F)=$G(CLSTP2)!(CLSTP2=$G(P407S)) S FLAG=1
. I 'FLAG Q
. S XX=$$ACTIVE(II)
. I 'XX&(ACT="A") Q
. S ^TMP($J,"CL",II)=$S(CLSTP1:$$GET1^DIQ(40.7,CLSTP1,1),1:"")_U_$S(CLSTP2:$$GET1^DIQ(40.7,CLSTP2,1),1:"")
Q 1
;
EXIT ; kill and exit
K DTOUT,DUOUT,DTOT
K ^TMP($J)
Q
;
ASK ; selection options
W ! K DIR,Y S DIR(0)="SA^C:Clinic;S:Stop Code;P:Provider;Q:Quit"
S DIR("A")="Select (C)linic, (S)top Code, (P)rovider, or (Q)uit: "
S DIR("B")="C"
D ^DIR K DIR I Y="Q"!$D(DTOUT)!$D(DUOUT) S SDOUT=1 Q
S ACT="A" W !
S SEL=Y W ! I SEL'="S" Q
S DIR(0)="SA^P:Primary Stop Code;S:Secondary Stop Code"
S DIR("A")="(P)rimary Stop Code, (S)econdary Stop Code: "
S DIR("B")="P"
D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SDOUT=1 Q
S SC=Y
Q
;
ACTIVE(LOC) ;determine if clinic is active
; Output X:1=ACTIVE,
; X:0=INACTIVE
N NODE,I1,I2,X
S X=0
S NODE=$G(^SC(LOC,"I")) Q:NODE="" 1
S I1=$P(NODE,U,1) ;inactive date/time
S I2=$P(NODE,U,2) ;reactive date/time
I (I1="") S X=1 Q X
I ((I1'="")&(I1>DT))!((I2'="")&(I2'>DT)) S X=1 Q X
Q X
;
PRU(PRIEN) ; call for provider call
S RESTCD=",136,444,446,490,644,646,690,694,699,723,901,"
S (CLN,CNT,TOTAL)=0,VAL="" F S CLN=$O(^SC("AVADPR",PRIEN,CLN)) Q:'CLN S TOTAL=TOTAL+1 D
. S (CNT,NUM)=0 F S NUM=$O(^SC(CLN,"PR",NUM)) Q:'NUM S CNT=CNT+1,AA=$G(^(NUM,0)) S:$P(AA,U,2) VAL=$P(AA,U)_U_CLN
. I $G(CLN) S STOP=$$SC(CLN),STCD=$TR(STOP," ()","")
. ; 859
. S STFLG=0 F II=1,2 S STCODE=$P(STCD,"/",II) I STCODE,RESTCD[(","_STCODE_",") D Q
.. S STFLG=1
.. W !,CLN,?12,$$GET1^DIQ(44,CLN,.01),STOP
.. W !,?8,"--- Telehealth Patient Site Stop Codes are not allowed for Bulk",!,?12,"Default Provider Update"
. I STFLG Q
. ; 859
. S SDACT=$G(^SC(CLN,"I")) I +SDACT>0 I DT>$P(SDACT,U)&($P(SDACT,U,2)=""!(DT<$P(SDACT,U,2))) D Q
. . W !,CLN,?12,$$GET1^DIQ(44,CLN,.01),STOP W !,?8,"--- Provider update on inactive clinics is not allowed.",!
. ;
. I $$GET1^DIQ(44,CLN,16,"I") W !,CLN,?12,$$GET1^DIQ(44,$P(VAL,U,2),.01),STOP W !,?8,"--- No action taken, default provider is already set.",! Q
. I CNT>1 W !,$P(VAL,U,2),?12,$$GET1^DIQ(44,$P(VAL,U,2),.01),STOP W !,?8,"--- No action taken, multiple providers assigned.",! Q
. I CNT=1,'$$GET1^DIQ(44,CLN,16,"I"),+VAL D
. . K DR S DR="16////"_$P(VAL,U),DA=CLN,DIE=44 D ^DIE K DA,DIE,DR
. . W !,$P(VAL,U,2),?12,$$GET1^DIQ(44,CLN,.01),STOP W !,?8,">>> Default Provider set to: ",$$GET1^DIQ(200,+VAL,.01),! S TOT=TOT+1
. I CNT=1,('$$GET1^DIQ(44,CLN,16,"I")&('+VAL)) W !,CLIEN,?12,$$GET1^DIQ(44,CLN,.01),STOP W !,?8,"--- No action taken, no default provider found.",!
. I CNT=0,('$$GET1^DIQ(44,CLN,16,"I")&('+VAL)) W !,CLIEN,?12,$$GET1^DIQ(44,CLN,.01),STOP W !,?8,"--- No action taken, no Providers found.",!
Q
;
PRC(CLIEN,STCODE) ; call for clinic search
S RESTCD=",136,444,446,490,644,646,690,694,699,723,901,",TOTAL=TOTAL+1
S (CNT,NUM)=0,STOP="",VAL="" F S NUM=$O(^SC(CLIEN,"PR",NUM)) Q:'NUM S CNT=CNT+1,AA=$G(^(NUM,0)) S:$P(AA,U,2) VAL=$P(AA,U)_U_CLIEN
I $G(CLIEN) S STOP=$$SC(CLIEN),STCD=$TR(STOP," ()","")
I SEL="S" S II=$S(SC="P":1,1:2) I $P(STCODE,U,II),RESTCD[(","_$P(STCODE,U,II)_",") D Q
. W !,CLIEN,?12,$$GET1^DIQ(44,CLIEN,.01),$$SC(CLIEN)
. W !,?8,"--- Telehealth Patient Site Stop Codes are not allowed for Bulk",!,?12,"Default Provider Update"
; 859
S STFLG=0 F II=1,2 S STCODE=$P(STCD,"/",II) I STCODE,RESTCD[(","_STCODE_",") D Q
. S STFLG=1
. W !,CLIEN,?12,$$GET1^DIQ(44,CLIEN,.01),STOP
. W !,?8,"--- Telehealth Patient Site Stop Codes are not allowed for Bulk",!,?12,"Default Provider Update"
I STFLG Q
; 859
S SDACT=$G(^SC(CLIEN,"I")) I +SDACT>0 I DT>$P(SDACT,U)&($P(SDACT,U,2)=""!(DT<$P(SDACT,U,2))) D Q
. W !,CLIEN,?12,$$GET1^DIQ(44,CLIEN,.01),STOP W !,?8,"--- Provider update on inactive clinics is not allowed.",!
;
I $$GET1^DIQ(44,CLIEN,16,"I") W !,CLIEN,?12,$$GET1^DIQ(44,CLIEN,.01),STOP W !,?8,"--- No action taken, default provider is already set.",! Q
I CNT>1,$G(VAL) W !,$P(VAL,U,2),?12,$$GET1^DIQ(44,$P(VAL,U,2),.01),$$SC($P(VAL,U,2)) W !,?8,"--- No action taken, multiple providers assigned.",! Q
I CNT=1,$G(VAL),'$$GET1^DIQ(44,CLIEN,16,"I"),+VAL D
. K DR S DR="16////"_$P(VAL,U),DA=CLIEN,DIE=44 D ^DIE K DA,DIE,DR
. W !,$P(VAL,U,2),?12,$$GET1^DIQ(44,CLIEN,.01),STOP W !,?8,">>> Default Provider is set to: ",$$GET1^DIQ(200,+VAL,.01),! S TOT=TOT+1
I CNT=1,('$$GET1^DIQ(44,CLIEN,16,"I")&('+VAL)) W !,CLIEN,?12,$$GET1^DIQ(44,CLIEN,.01),STOP W !,?8,"--- No action taken, no default provider found.",!
I CNT=0,('$$GET1^DIQ(44,CLIEN,16,"I")&('+VAL)) W !,CLIEN,?12,$$GET1^DIQ(44,CLIEN,.01),STOP W !,?8,"--- No action taken, no Providers found.",!
Q
;
SC(CLIEN) ; call to return clinic stop codes
N NODE0,RESULT
S NODE0=$G(^SC(CLIEN,0))
S RESULT=" ("_$$GET1^DIQ(40.7,$P(NODE0,U,7),1)_"/"_$$GET1^DIQ(40.7,$P(NODE0,U,18),1)_")"
Q RESULT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDTMPUT2 7508 printed Nov 22, 2024@18:11:32 Page 2
SDTMPUT2 ;MS/SJA - VISTA-BULK DEFAULT PROVIDER UPDATE ;May 15, 2022
+1 ;;5.3;Scheduling;**817,859**;Aug 13, 1993;Build 10
+2 ;
+3 ;
+4 NEW AA,ACT,ALL,CLN,CNT,LN,DIV,III,NUM,LOC,RESTCD,SC,SDACT,STCODE,STCD,STOP,SDASH,SDOUT,STIEN,VAL,SEL,STFLG
+5 NEW TOT,TOTAL,VAUTD,CLIEN,PRIEN,XX
EN ;
+1 KILL ^TMP($JOB)
+2 SET $PIECE(SDASH,"=",80)=""
SET (SEL,ACT,DIV)=""
SET (ALL,SDOUT)=0
+3 WRITE @IOF
WRITE !,?20,"Bulk update for Default Provider field",!
+4 DO ASK
if SDOUT
QUIT
+5 if $GET(VAUTD)=1
SET DIV="ALL"
+6 WRITE !
DO @SEL
+7 GOTO EN
+8 ;
C ; clinic
+1 KILL ^TMP($JOB)
SET (TOTAL,TOT)=0
+2 KILL DIC,DTOUT,DUOUT
SET DIC="^SC("
SET DIC(0)="AEQM"
SET DIC("A")="Select Clinic: "
C1 DO ^DIC
IF Y>0
SET ^TMP($JOB,"CL",+Y)=""
SET DIC("A")="Another one:"
GOTO C1
+1 IF $DATA(DTOUT)!($DATA(DUOUT))!('$ORDER(^TMP($JOB,"CL",0)))
QUIT
+2 FOR III=0:0
SET III=$ORDER(^TMP($JOB,"CL",III))
if 'III
QUIT
Begin DoDot:1
+3 if TOTAL=0
WRITE !,SDASH,!
+4 DO PRC(III)
End DoDot:1
+5 WRITE !!
+6 WRITE !,"Total number of clinics updated ",TOT," out of ",TOTAL
+7 WRITE !!
SET DIR(0)="EA"
SET DIR("A")="Press <Enter> to continue"
DO ^DIR
KILL DIR
+8 QUIT
+9 ;
S ; stop codes
+1 KILL ^TMP($JOB)
SET (LN,TOTAL,TOT)=0
+2 KILL DIC,DTOUT,DUOUT
SET DIC="^SD(40.6,"
SET DIC(0)="AEMQ"
SET DIC("A")="Select Telehealth Stop Code: "
S1 DO ^DIC
IF Y>0
SET ^TMP($JOB,"ST",+Y)=""
SET DIC("A")="Select another Telehealth Stop Code: "
GOTO S1
+1 IF $DATA(DTOUT)!($DATA(DUOUT))!('$ORDER(^TMP($JOB,"ST",0)))
QUIT
+2 WRITE !
+3 FOR STIEN=0:0
SET STIEN=$ORDER(^TMP($JOB,"ST",STIEN))
if 'STIEN
QUIT
SET CLN=$$ST(STIEN)
+4 FOR III=0:0
SET III=$ORDER(^TMP($JOB,"CL",III))
if 'III
QUIT
SET STOP=$GET(^(III))
Begin DoDot:1
+5 if TOTAL=0
WRITE !,SDASH,!
+6 SET LN=LN+1
if '(LN#50)
WRITE "."
DO PRC(III,STOP)
End DoDot:1
+7 WRITE !!
+8 WRITE !,"Total number of clinics updated ",TOT," out of ",TOTAL
+9 WRITE !!
SET DIR(0)="EA"
SET DIR("A")="Press <Enter> to continue"
DO ^DIR
KILL DIR
+10 QUIT
+11 ;
P ; provider selection
+1 KILL ^TMP($JOB)
SET (TOTAL,TOT)=0
+2 SET DIC=200
SET DIC("A")="Select Provider: "
SET DIC(0)="AEMQ"
SET DIC("S")="I $$SCREEN^SDUTL2(Y,DT)"
P1 DO ^DIC
IF Y>0
SET ^TMP($JOB,"PR",+Y)=""
SET DIC("A")="Another one:"
GOTO P1
+1 IF $DATA(DTOUT)!($DATA(DUOUT))!('$ORDER(^TMP($JOB,"PR",0)))
QUIT
+2 FOR III=0:0
SET III=$ORDER(^TMP($JOB,"PR",III))
if 'III
QUIT
Begin DoDot:1
+3 if TOTAL=0
WRITE !!,SDASH,!
+4 DO PRU(III)
End DoDot:1
+5 WRITE !!
+6 WRITE !,"Total number of clinics updated ",TOT," out of ",TOTAL
+7 WRITE !!
SET DIR(0)="EA"
SET DIR("A")="Press <Enter> to continue"
DO ^DIR
KILL DIR
+8 QUIT
+9 ;
ST(STIEN) ; stop codes search
+1 NEW FLAG,FLG1,FLG2,CODE,P1,P2,P407F,P407S,II,NODE0,CLSTP1,CLSTP2,XX
+2 SET (FLAG,P407F,P407S,P1,P2)=0
+3 SET CODE=$GET(^SD(40.6,STIEN,0))
SET P1=$EXTRACT(CODE,1,3)
SET P2=$EXTRACT(CODE,4,6)
+4 SET P407F=$ORDER(^DIC(40.7,"C",P1,0))
if P2
SET P407S=$ORDER(^DIC(40.7,"C",P2,0))
+5 SET II=0
+6 FOR
SET II=$ORDER(^SC(II))
if 'II
QUIT
SET FLAG=0
Begin DoDot:1
+7 SET NODE0=$GET(^SC(II,0))
SET CLSTP1=$PIECE(NODE0,U,7)
SET CLSTP2=$PIECE(NODE0,U,18)
+8 IF (SC="P"&($GET(CLSTP1)="")!(SC="S"&$GET(CLSTP2)=""))
QUIT
+9 IF SC="P"
IF $GET(P407F)=$GET(CLSTP1)!(CLSTP1=$GET(P407S))
SET FLAG=1
+10 IF SC="S"
IF $GET(P407F)=$GET(CLSTP2)!(CLSTP2=$GET(P407S))
SET FLAG=1
+11 IF 'FLAG
QUIT
+12 SET XX=$$ACTIVE(II)
+13 IF 'XX&(ACT="A")
QUIT
+14 SET ^TMP($JOB,"CL",II)=$SELECT(CLSTP1:$$GET1^DIQ(40.7,CLSTP1,1),1:"")_U_$SELECT(CLSTP2:$$GET1^DIQ(40.7,CLSTP2,1),1:"")
End DoDot:1
+15 QUIT 1
+16 ;
EXIT ; kill and exit
+1 KILL DTOUT,DUOUT,DTOT
+2 KILL ^TMP($JOB)
+3 QUIT
+4 ;
ASK ; selection options
+1 WRITE !
KILL DIR,Y
SET DIR(0)="SA^C:Clinic;S:Stop Code;P:Provider;Q:Quit"
+2 SET DIR("A")="Select (C)linic, (S)top Code, (P)rovider, or (Q)uit: "
+3 SET DIR("B")="C"
+4 DO ^DIR
KILL DIR
IF Y="Q"!$DATA(DTOUT)!$DATA(DUOUT)
SET SDOUT=1
QUIT
+5 SET ACT="A"
WRITE !
+6 SET SEL=Y
WRITE !
IF SEL'="S"
QUIT
+7 SET DIR(0)="SA^P:Primary Stop Code;S:Secondary Stop Code"
+8 SET DIR("A")="(P)rimary Stop Code, (S)econdary Stop Code: "
+9 SET DIR("B")="P"
+10 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SDOUT=1
QUIT
+11 SET SC=Y
+12 QUIT
+13 ;
ACTIVE(LOC) ;determine if clinic is active
+1 ; Output X:1=ACTIVE,
+2 ; X:0=INACTIVE
+3 NEW NODE,I1,I2,X
+4 SET X=0
+5 SET NODE=$GET(^SC(LOC,"I"))
if NODE=""
QUIT 1
+6 ;inactive date/time
SET I1=$PIECE(NODE,U,1)
+7 ;reactive date/time
SET I2=$PIECE(NODE,U,2)
+8 IF (I1="")
SET X=1
QUIT X
+9 IF ((I1'="")&(I1>DT))!((I2'="")&(I2'>DT))
SET X=1
QUIT X
+10 QUIT X
+11 ;
PRU(PRIEN) ; call for provider call
+1 SET RESTCD=",136,444,446,490,644,646,690,694,699,723,901,"
+2 SET (CLN,CNT,TOTAL)=0
SET VAL=""
FOR
SET CLN=$ORDER(^SC("AVADPR",PRIEN,CLN))
if 'CLN
QUIT
SET TOTAL=TOTAL+1
Begin DoDot:1
+3 SET (CNT,NUM)=0
FOR
SET NUM=$ORDER(^SC(CLN,"PR",NUM))
if 'NUM
QUIT
SET CNT=CNT+1
SET AA=$GET(^(NUM,0))
if $PIECE(AA,U,2)
SET VAL=$PIECE(AA,U)_U_CLN
+4 IF $GET(CLN)
SET STOP=$$SC(CLN)
SET STCD=$TRANSLATE(STOP," ()","")
+5 ; 859
+6 SET STFLG=0
FOR II=1,2
SET STCODE=$PIECE(STCD,"/",II)
IF STCODE
IF RESTCD[(","_STCODE_",")
Begin DoDot:2
+7 SET STFLG=1
+8 WRITE !,CLN,?12,$$GET1^DIQ(44,CLN,.01),STOP
+9 WRITE !,?8,"--- Telehealth Patient Site Stop Codes are not allowed for Bulk",!,?12,"Default Provider Update"
End DoDot:2
QUIT
+10 IF STFLG
QUIT
+11 ; 859
+12 SET SDACT=$GET(^SC(CLN,"I"))
IF +SDACT>0
IF DT>$PIECE(SDACT,U)&($PIECE(SDACT,U,2)=""!(DT<$PIECE(SDACT,U,2)))
Begin DoDot:2
+13 WRITE !,CLN,?12,$$GET1^DIQ(44,CLN,.01),STOP
WRITE !,?8,"--- Provider update on inactive clinics is not allowed.",!
End DoDot:2
QUIT
+14 ;
+15 IF $$GET1^DIQ(44,CLN,16,"I")
WRITE !,CLN,?12,$$GET1^DIQ(44,$PIECE(VAL,U,2),.01),STOP
WRITE !,?8,"--- No action taken, default provider is already set.",!
QUIT
+16 IF CNT>1
WRITE !,$PIECE(VAL,U,2),?12,$$GET1^DIQ(44,$PIECE(VAL,U,2),.01),STOP
WRITE !,?8,"--- No action taken, multiple providers assigned.",!
QUIT
+17 IF CNT=1
IF '$$GET1^DIQ(44,CLN,16,"I")
IF +VAL
Begin DoDot:2
+18 KILL DR
SET DR="16////"_$PIECE(VAL,U)
SET DA=CLN
SET DIE=44
DO ^DIE
KILL DA,DIE,DR
+19 WRITE !,$PIECE(VAL,U,2),?12,$$GET1^DIQ(44,CLN,.01),STOP
WRITE !,?8,">>> Default Provider set to: ",$$GET1^DIQ(200,+VAL,.01),!
SET TOT=TOT+1
End DoDot:2
+20 IF CNT=1
IF ('$$GET1^DIQ(44,CLN,16,"I")&('+VAL))
WRITE !,CLIEN,?12,$$GET1^DIQ(44,CLN,.01),STOP
WRITE !,?8,"--- No action taken, no default provider found.",!
+21 IF CNT=0
IF ('$$GET1^DIQ(44,CLN,16,"I")&('+VAL))
WRITE !,CLIEN,?12,$$GET1^DIQ(44,CLN,.01),STOP
WRITE !,?8,"--- No action taken, no Providers found.",!
End DoDot:1
+22 QUIT
+23 ;
PRC(CLIEN,STCODE) ; call for clinic search
+1 SET RESTCD=",136,444,446,490,644,646,690,694,699,723,901,"
SET TOTAL=TOTAL+1
+2 SET (CNT,NUM)=0
SET STOP=""
SET VAL=""
FOR
SET NUM=$ORDER(^SC(CLIEN,"PR",NUM))
if 'NUM
QUIT
SET CNT=CNT+1
SET AA=$GET(^(NUM,0))
if $PIECE(AA,U,2)
SET VAL=$PIECE(AA,U)_U_CLIEN
+3 IF $GET(CLIEN)
SET STOP=$$SC(CLIEN)
SET STCD=$TRANSLATE(STOP," ()","")
+4 IF SEL="S"
SET II=$SELECT(SC="P":1,1:2)
IF $PIECE(STCODE,U,II)
IF RESTCD[(","_$PIECE(STCODE,U,II)_",")
Begin DoDot:1
+5 WRITE !,CLIEN,?12,$$GET1^DIQ(44,CLIEN,.01),$$SC(CLIEN)
+6 WRITE !,?8,"--- Telehealth Patient Site Stop Codes are not allowed for Bulk",!,?12,"Default Provider Update"
End DoDot:1
QUIT
+7 ; 859
+8 SET STFLG=0
FOR II=1,2
SET STCODE=$PIECE(STCD,"/",II)
IF STCODE
IF RESTCD[(","_STCODE_",")
Begin DoDot:1
+9 SET STFLG=1
+10 WRITE !,CLIEN,?12,$$GET1^DIQ(44,CLIEN,.01),STOP
+11 WRITE !,?8,"--- Telehealth Patient Site Stop Codes are not allowed for Bulk",!,?12,"Default Provider Update"
End DoDot:1
QUIT
+12 IF STFLG
QUIT
+13 ; 859
+14 SET SDACT=$GET(^SC(CLIEN,"I"))
IF +SDACT>0
IF DT>$PIECE(SDACT,U)&($PIECE(SDACT,U,2)=""!(DT<$PIECE(SDACT,U,2)))
Begin DoDot:1
+15 WRITE !,CLIEN,?12,$$GET1^DIQ(44,CLIEN,.01),STOP
WRITE !,?8,"--- Provider update on inactive clinics is not allowed.",!
End DoDot:1
QUIT
+16 ;
+17 IF $$GET1^DIQ(44,CLIEN,16,"I")
WRITE !,CLIEN,?12,$$GET1^DIQ(44,CLIEN,.01),STOP
WRITE !,?8,"--- No action taken, default provider is already set.",!
QUIT
+18 IF CNT>1
IF $GET(VAL)
WRITE !,$PIECE(VAL,U,2),?12,$$GET1^DIQ(44,$PIECE(VAL,U,2),.01),$$SC($PIECE(VAL,U,2))
WRITE !,?8,"--- No action taken, multiple providers assigned.",!
QUIT
+19 IF CNT=1
IF $GET(VAL)
IF '$$GET1^DIQ(44,CLIEN,16,"I")
IF +VAL
Begin DoDot:1
+20 KILL DR
SET DR="16////"_$PIECE(VAL,U)
SET DA=CLIEN
SET DIE=44
DO ^DIE
KILL DA,DIE,DR
+21 WRITE !,$PIECE(VAL,U,2),?12,$$GET1^DIQ(44,CLIEN,.01),STOP
WRITE !,?8,">>> Default Provider is set to: ",$$GET1^DIQ(200,+VAL,.01),!
SET TOT=TOT+1
End DoDot:1
+22 IF CNT=1
IF ('$$GET1^DIQ(44,CLIEN,16,"I")&('+VAL))
WRITE !,CLIEN,?12,$$GET1^DIQ(44,CLIEN,.01),STOP
WRITE !,?8,"--- No action taken, no default provider found.",!
+23 IF CNT=0
IF ('$$GET1^DIQ(44,CLIEN,16,"I")&('+VAL))
WRITE !,CLIEN,?12,$$GET1^DIQ(44,CLIEN,.01),STOP
WRITE !,?8,"--- No action taken, no Providers found.",!
+24 QUIT
+25 ;
SC(CLIEN) ; call to return clinic stop codes
+1 NEW NODE0,RESULT
+2 SET NODE0=$GET(^SC(CLIEN,0))
+3 SET RESULT=" ("_$$GET1^DIQ(40.7,$PIECE(NODE0,U,7),1)_"/"_$$GET1^DIQ(40.7,$PIECE(NODE0,U,18),1)_")"
+4 QUIT RESULT
+5 ;
