SDRRUTL1 ;10N20/MAH;Recall Reminder-Clinic Utilities ;07/13/06 11:32
;;5.3;Scheduling;**536**;Aug 13, 1993;Build 53
ASKCLIN(SDRRDIV,SDRRST,SDRRND) ;
N DIR,X,Y,DIRUT,SDRRABORT
W !!,"Now you'll select the clinics."
S DIR(0)="SO^R:Range of Clinics;I:Individual Clinics;S:Stop Codes"
S DIR("A")="Select Clinics by"
S DIR("?",1)="Choose 'Range of Clinics' if you want to select a group of clinics in"
S DIR("?",2)="consecutive name order. You'll be asked for the starting clinic and the"
S DIR("?",3)="ending clinic. All the clinics in that range will be selected for you."
S DIR("?",4)=""
S DIR("?",5)="Choose 'Individual Clinics' if you want to select clinics individually."
S DIR("?",6)="You'll be able to use ranges here, too, as well as wild cards. You'll"
S DIR("?",7)="even be able to de-select clinics."
S DIR("?",8)=""
S DIR("?",9)="Choose 'Stop Codes' if you want to select Stop Codes. All clinics whose"
S DIR("?",10)="Stop Codes or Credit Stops match the ones you've chosen will be selected"
S DIR("?")="for you."
D ^DIR I $D(DIRUT) S SDRRABORT=1 Q
D @Y
Q
STOPCODE(SDRRI) ; Return a clinic stop code
Q $S('SDRRI:SDRRI,1:$P($G(^DIC(40.7,SDRRI,0)),U,2))
I ; Select individual clinics
N SDRRDIC,SDRRNAME,SDRRIEN,SDRRREC
W !!,"You'll be able to use ranges and wild cards to select clinics."
W !,"You'll even be able to deselect clinics."
W !,"Enter '?' at the prompt to see how."
S SDRRDIC=44
S SDRRDIC(0)="AEMNQZ"
S SDRRDIC("A")="Select Clinic: "
S SDRRDIC("B")="All"
S SDRRDIC("S")="I $$ACTIVE^SDRRUTL1(+Y,.SDRRDIV,.SDRRST,.SDRRND,^(0))"
I '$$EN^SDRRSLCT(.SDRRDIC,"SDRR") S SDRRABORT=1 Q
S (SDRRNAME,SDRRIEN)=""
F S SDRRNAME=$O(^TMP($J,"SDRR",SDRRNAME)) Q:SDRRNAME="" D
. F S SDRRIEN=$O(^TMP($J,"SDRR",SDRRNAME,SDRRIEN)) Q:SDRRIEN="" D
. . S SDRRREC=$G(^SC(SDRRIEN,0))
. . S ^TMP("SDRR",$J,"DIV",$P(SDRRREC,U,15),"CLIN",$P(SDRRREC,U))=SDRRIEN_U_$$STOPCODE($P(SDRRREC,U,7))_U_$$STOPCODE($P(SDRRREC,U,18))
K ^TMP($J,"SDRR")
Q
R ; Select range of clinics
N SDRRCLIN,SDRRIEN,SDRRREC,SDRRFROM,SDRRTHRU,SDRRI
D ASKRANGE(.SDRRCLIN,.SDRRDIV,.SDRRST,.SDRRND)
I 'SDRRCLIN S SDRRABORT=1 Q
S SDRRI=0
F S SDRRI=$O(SDRRCLIN(SDRRI)) Q:'SDRRI D
. S SDRRFROM=$P($P(SDRRCLIN(SDRRI),":"),U,2)
. S SDRRFROM=$O(^SC("B",SDRRFROM),-1)
. S SDRRTHRU=$P($P(SDRRCLIN(SDRRI),":",2),U,2)
. S SDRRCLIN=SDRRFROM
. F S SDRRCLIN=$O(^SC("B",SDRRCLIN)) Q:SDRRCLIN="" D Q:SDRRCLIN=SDRRTHRU
. . S SDRRIEN=$O(^SC("B",SDRRCLIN,0))
. . S SDRRREC=$G(^SC(SDRRIEN,0))
. . Q:'$$ACTIVE(SDRRIEN,.SDRRDIV,.SDRRST,.SDRRND,SDRRREC)
. . S ^TMP("SDRR",$J,"DIV",$P(SDRRREC,U,15),"CLIN",$P(SDRRREC,U))=SDRRIEN_U_$$STOPCODE($P(SDRRREC,U,7))_U_$$STOPCODE($P(SDRRREC,U,18))
Q
S ; Select stop codes
N SDRRDIC,SDRRSC,SDRRSCI,SDRRNDX,SDRRIEN,SDRRREC
S SDRRDIC=40.7
S SDRRDIC(0)="AEMQZ"
S SDRRDIC("A")="Select Stop Code: "
S SDRRDIC("S")="S %=$P(^(0),U,3) I '%!(%>"_$G(SDRRST,DT)_")"
I '$$EN^SDRRSLCT(.SDRRDIC,"SDRR") S SDRRABORT=1 Q
S (SDRRSC,SDRRSCI,SDRRIEN)=""
F S SDRRSC=$O(^TMP($J,"SDRR",SDRRSC)) Q:SDRRSC="" D
. F S SDRRSCI=$O(^TMP($J,"SDRR",SDRRSC,SDRRSCI)) Q:'SDRRSCI D
. . F SDRRNDX="AST","ACST" D ; xrefs on STOP CODE and CREDIT STOP fields
. . . F S SDRRIEN=$O(^SC(SDRRNDX,SDRRSCI,SDRRIEN)) Q:'SDRRIEN D
. . . . S SDRRREC=$G(^SC(SDRRIEN,0))
. . . . Q:'$$ACTIVE(SDRRIEN,.SDRRDIV,.SDRRST,.SDRRND,SDRRREC)
. . . . S ^TMP("SDRR",$J,"DIV",$P(SDRRREC,U,15),"CLIN",$P(SDRRREC,U))=SDRRIEN_U_$$STOPCODE($P(SDRRREC,U,7))_U_$$STOPCODE($P(SDRRREC,U,18))
K ^TMP($J,"SDRR")
Q
ASKRANGE(SDRRCLIN,SDRRDIV,SDRRST,SDRRND) ;
; DBIA #10040; Direct global reference of (#44) file
N DIC,X,Y,DTOUT,DUOUT,SDRRCNT,SDRRFROM
S SDRRCNT=0
S DIC="^SC(",DIC(0)="AEQM"
W !
W !,"To select a range of clinics, first you select the start of the range,"
W !,"or the 'from' clinic. Next, you select the end of the range,"
W !,"or the 'thru' clinic. We'll select all the clinics in that range for you."
F D Q:Y<0
. W !
. S DIC("A")="From Clinic: "
. S DIC("S")="I $$ACTIVE^SDRRUTL1(+Y,.SDRRDIV,.SDRRST,.SDRRND,^(0))"
. D ^DIC Q:Y<0
. S SDRRFROM=Y ;S SDRRDIV(+Y)=$P(Y,U,2)
. S DIC("A")="Thru Clinic: "
. S DIC("S")="I $P(^(0),U)]"""_$O(^SC("B",$P(SDRRFROM,U,2)),-1)_""",$$ACTIVE^SDRRUTL1(+Y,.SDRRDIV,.SDRRST,.SDRRND,^(0))"
. D ^DIC Q:Y<0
. S SDRRCNT=SDRRCNT+1
. S SDRRCLIN(SDRRCNT)=SDRRFROM_":"_Y
I $D(DTOUT)!$D(DUOUT) K SDRRCLIN S SDRRCLIN=0
S SDRRCLIN=SDRRCNT
Q
ACTIVE(SDRRIEN,SDRRDIV,SDRRST,SDRRND,SDRRREC) ; Is the clinic active?
; DBIA #10040; Direct global reference of (#44) file
; SDRRIEN - IEN of clinic in HOSPITAL LOCATION (#44) file
; SDRRDIV - (optional) clinic must be in Division(s)
; SDRRDIV=ien or SDRRDIV(ien)="", where ien is IEN in file 40.8
; SDRRST - (optional) date range start date - default=DT
; SDRRND - (optional) date range end date - default=SDRRST
; SDRRREC - (optional) zero node of clinic
I '$D(SDRRREC) S SDRRREC=$G(^SC(SDRRIEN,0))
Q:$P(SDRRREC,U,3)'="C" 0 ; Not a clinic
Q:$P(SDRRREC,U,1)["*" 0
I $D(SDRRDIV)=1,$P(SDRRREC,U,15)'=SDRRDIV Q 0
I $D(SDRRDIV)>9,'$D(SDRRDIV(+$P(SDRRREC,U,15))) Q 0
S SDRRREC=$G(^SC(SDRRIEN,"I"))
Q:'SDRRREC 1
I '$G(SDRRST) S SDRRST=DT
I '$G(SDRRND) S SDRRND=SDRRST
I $P(SDRRREC,U,1)<SDRRST Q $S($P(SDRRREC,U,2)="":0,$P(SDRRREC,U,2)>SDRRND:0,1:1)
Q 1 ; Active
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDRRUTL1 5406 printed Oct 16, 2024@19:01:24 Page 2
SDRRUTL1 ;10N20/MAH;Recall Reminder-Clinic Utilities ;07/13/06 11:32
+1 ;;5.3;Scheduling;**536**;Aug 13, 1993;Build 53
ASKCLIN(SDRRDIV,SDRRST,SDRRND) ;
+1 NEW DIR,X,Y,DIRUT,SDRRABORT
+2 WRITE !!,"Now you'll select the clinics."
+3 SET DIR(0)="SO^R:Range of Clinics;I:Individual Clinics;S:Stop Codes"
+4 SET DIR("A")="Select Clinics by"
+5 SET DIR("?",1)="Choose 'Range of Clinics' if you want to select a group of clinics in"
+6 SET DIR("?",2)="consecutive name order. You'll be asked for the starting clinic and the"
+7 SET DIR("?",3)="ending clinic. All the clinics in that range will be selected for you."
+8 SET DIR("?",4)=""
+9 SET DIR("?",5)="Choose 'Individual Clinics' if you want to select clinics individually."
+10 SET DIR("?",6)="You'll be able to use ranges here, too, as well as wild cards. You'll"
+11 SET DIR("?",7)="even be able to de-select clinics."
+12 SET DIR("?",8)=""
+13 SET DIR("?",9)="Choose 'Stop Codes' if you want to select Stop Codes. All clinics whose"
+14 SET DIR("?",10)="Stop Codes or Credit Stops match the ones you've chosen will be selected"
+15 SET DIR("?")="for you."
+16 DO ^DIR
IF $DATA(DIRUT)
SET SDRRABORT=1
QUIT
+17 DO @Y
+18 QUIT
STOPCODE(SDRRI) ; Return a clinic stop code
+1 QUIT $SELECT('SDRRI:SDRRI,1:$PIECE($GET(^DIC(40.7,SDRRI,0)),U,2))
I ; Select individual clinics
+1 NEW SDRRDIC,SDRRNAME,SDRRIEN,SDRRREC
+2 WRITE !!,"You'll be able to use ranges and wild cards to select clinics."
+3 WRITE !,"You'll even be able to deselect clinics."
+4 WRITE !,"Enter '?' at the prompt to see how."
+5 SET SDRRDIC=44
+6 SET SDRRDIC(0)="AEMNQZ"
+7 SET SDRRDIC("A")="Select Clinic: "
+8 SET SDRRDIC("B")="All"
+9 SET SDRRDIC("S")="I $$ACTIVE^SDRRUTL1(+Y,.SDRRDIV,.SDRRST,.SDRRND,^(0))"
+10 IF '$$EN^SDRRSLCT(.SDRRDIC,"SDRR")
SET SDRRABORT=1
QUIT
+11 SET (SDRRNAME,SDRRIEN)=""
+12 FOR
SET SDRRNAME=$ORDER(^TMP($JOB,"SDRR",SDRRNAME))
if SDRRNAME=""
QUIT
Begin DoDot:1
+13 FOR
SET SDRRIEN=$ORDER(^TMP($JOB,"SDRR",SDRRNAME,SDRRIEN))
if SDRRIEN=""
QUIT
Begin DoDot:2
+14 SET SDRRREC=$GET(^SC(SDRRIEN,0))
+15 SET ^TMP("SDRR",$JOB,"DIV",$PIECE(SDRRREC,U,15),"CLIN",$PIECE(SDRRREC,U))=SDRRIEN_U_$$STOPCODE($PIECE(SDRRREC,U,7))_U_$$STOPCODE($PIECE(SDRRREC,U,18))
End DoDot:2
End DoDot:1
+16 KILL ^TMP($JOB,"SDRR")
+17 QUIT
R ; Select range of clinics
+1 NEW SDRRCLIN,SDRRIEN,SDRRREC,SDRRFROM,SDRRTHRU,SDRRI
+2 DO ASKRANGE(.SDRRCLIN,.SDRRDIV,.SDRRST,.SDRRND)
+3 IF 'SDRRCLIN
SET SDRRABORT=1
QUIT
+4 SET SDRRI=0
+5 FOR
SET SDRRI=$ORDER(SDRRCLIN(SDRRI))
if 'SDRRI
QUIT
Begin DoDot:1
+6 SET SDRRFROM=$PIECE($PIECE(SDRRCLIN(SDRRI),":"),U,2)
+7 SET SDRRFROM=$ORDER(^SC("B",SDRRFROM),-1)
+8 SET SDRRTHRU=$PIECE($PIECE(SDRRCLIN(SDRRI),":",2),U,2)
+9 SET SDRRCLIN=SDRRFROM
+10 FOR
SET SDRRCLIN=$ORDER(^SC("B",SDRRCLIN))
if SDRRCLIN=""
QUIT
Begin DoDot:2
+11 SET SDRRIEN=$ORDER(^SC("B",SDRRCLIN,0))
+12 SET SDRRREC=$GET(^SC(SDRRIEN,0))
+13 if '$$ACTIVE(SDRRIEN,.SDRRDIV,.SDRRST,.SDRRND,SDRRREC)
QUIT
+14 SET ^TMP("SDRR",$JOB,"DIV",$PIECE(SDRRREC,U,15),"CLIN",$PIECE(SDRRREC,U))=SDRRIEN_U_$$STOPCODE($PIECE(SDRRREC,U,7))_U_$$STOPCODE($PIECE(SDRRREC,U,18))
End DoDot:2
if SDRRCLIN=SDRRTHRU
QUIT
End DoDot:1
+15 QUIT
S ; Select stop codes
+1 NEW SDRRDIC,SDRRSC,SDRRSCI,SDRRNDX,SDRRIEN,SDRRREC
+2 SET SDRRDIC=40.7
+3 SET SDRRDIC(0)="AEMQZ"
+4 SET SDRRDIC("A")="Select Stop Code: "
+5 SET SDRRDIC("S")="S %=$P(^(0),U,3) I '%!(%>"_$GET(SDRRST,DT)_")"
+6 IF '$$EN^SDRRSLCT(.SDRRDIC,"SDRR")
SET SDRRABORT=1
QUIT
+7 SET (SDRRSC,SDRRSCI,SDRRIEN)=""
+8 FOR
SET SDRRSC=$ORDER(^TMP($JOB,"SDRR",SDRRSC))
if SDRRSC=""
QUIT
Begin DoDot:1
+9 FOR
SET SDRRSCI=$ORDER(^TMP($JOB,"SDRR",SDRRSC,SDRRSCI))
if 'SDRRSCI
QUIT
Begin DoDot:2
+10 ; xrefs on STOP CODE and CREDIT STOP fields
FOR SDRRNDX="AST","ACST"
Begin DoDot:3
+11 FOR
SET SDRRIEN=$ORDER(^SC(SDRRNDX,SDRRSCI,SDRRIEN))
if 'SDRRIEN
QUIT
Begin DoDot:4
+12 SET SDRRREC=$GET(^SC(SDRRIEN,0))
+13 if '$$ACTIVE(SDRRIEN,.SDRRDIV,.SDRRST,.SDRRND,SDRRREC)
QUIT
+14 SET ^TMP("SDRR",$JOB,"DIV",$PIECE(SDRRREC,U,15),"CLIN",$PIECE(SDRRREC,U))=SDRRIEN_U_$$STOPCODE($PIECE(SDRRREC,U,7))_U_$$STOPCODE($PIECE(SDRRREC,U,18))
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+15 KILL ^TMP($JOB,"SDRR")
+16 QUIT
ASKRANGE(SDRRCLIN,SDRRDIV,SDRRST,SDRRND) ;
+1 ; DBIA #10040; Direct global reference of (#44) file
+2 NEW DIC,X,Y,DTOUT,DUOUT,SDRRCNT,SDRRFROM
+3 SET SDRRCNT=0
+4 SET DIC="^SC("
SET DIC(0)="AEQM"
+5 WRITE !
+6 WRITE !,"To select a range of clinics, first you select the start of the range,"
+7 WRITE !,"or the 'from' clinic. Next, you select the end of the range,"
+8 WRITE !,"or the 'thru' clinic. We'll select all the clinics in that range for you."
+9 FOR
Begin DoDot:1
+10 WRITE !
+11 SET DIC("A")="From Clinic: "
+12 SET DIC("S")="I $$ACTIVE^SDRRUTL1(+Y,.SDRRDIV,.SDRRST,.SDRRND,^(0))"
+13 DO ^DIC
if Y<0
QUIT
+14 ;S SDRRDIV(+Y)=$P(Y,U,2)
SET SDRRFROM=Y
+15 SET DIC("A")="Thru Clinic: "
+16 SET DIC("S")="I $P(^(0),U)]"""_$ORDER(^SC("B",$PIECE(SDRRFROM,U,2)),-1)_""",$$ACTIVE^SDRRUTL1(+Y,.SDRRDIV,.SDRRST,.SDRRND,^(0))"
+17 DO ^DIC
if Y<0
QUIT
+18 SET SDRRCNT=SDRRCNT+1
+19 SET SDRRCLIN(SDRRCNT)=SDRRFROM_":"_Y
End DoDot:1
if Y<0
QUIT
+20 IF $DATA(DTOUT)!$DATA(DUOUT)
KILL SDRRCLIN
SET SDRRCLIN=0
+21 SET SDRRCLIN=SDRRCNT
+22 QUIT
ACTIVE(SDRRIEN,SDRRDIV,SDRRST,SDRRND,SDRRREC) ; Is the clinic active?
+1 ; DBIA #10040; Direct global reference of (#44) file
+2 ; SDRRIEN - IEN of clinic in HOSPITAL LOCATION (#44) file
+3 ; SDRRDIV - (optional) clinic must be in Division(s)
+4 ; SDRRDIV=ien or SDRRDIV(ien)="", where ien is IEN in file 40.8
+5 ; SDRRST - (optional) date range start date - default=DT
+6 ; SDRRND - (optional) date range end date - default=SDRRST
+7 ; SDRRREC - (optional) zero node of clinic
+8 IF '$DATA(SDRRREC)
SET SDRRREC=$GET(^SC(SDRRIEN,0))
+9 ; Not a clinic
if $PIECE(SDRRREC,U,3)'="C"
QUIT 0
+10 if $PIECE(SDRRREC,U,1)["*"
QUIT 0
+11 IF $DATA(SDRRDIV)=1
IF $PIECE(SDRRREC,U,15)'=SDRRDIV
QUIT 0
+12 IF $DATA(SDRRDIV)>9
IF '$DATA(SDRRDIV(+$PIECE(SDRRREC,U,15)))
QUIT 0
+13 SET SDRRREC=$GET(^SC(SDRRIEN,"I"))
+14 if 'SDRRREC
QUIT 1
+15 IF '$GET(SDRRST)
SET SDRRST=DT
+16 IF '$GET(SDRRND)
SET SDRRND=SDRRST
+17 IF $PIECE(SDRRREC,U,1)<SDRRST
QUIT $SELECT($PIECE(SDRRREC,U,2)="":0,$PIECE(SDRRREC,U,2)>SDRRND:0,1:1)
+18 ; Active
QUIT 1
