SDRRPXC ;;10N20/MAH;Recall Reminder Utilities ;01/18/2008 11:32
;;5.3;Scheduling;**536**;Aug 13, 1993;Build 53
;
STOPCODE(SDRRI) ; Return a clinic stop code
Q $S('SDRRI:SDRRI,1:$P($G(^DIC(40.7,SDRRI,0)),U,2))
PERDIV(SDRRDIV) ;
S I=0
F S I=$O(SDRRDIV(I)) Q:'I S SDRRDIV(I)=$P($G(^DG(40.8,I,0),"Unknown Division"),U)
Q
ASKDIV(SDRRDIV) ;
N DIC,X,Y,I,DUOUT,DTOUT
K SDRRDIV
S SDRRDIV=0
W !
S DIC("A")="Select Medical Center Division: All// "
S DIC="^DG(40.8,"
S DIC(0)="AEQMN"
F D Q:Y=-1
. D ^DIC Q:Y=-1
. S SDRRDIV(+Y)=$P(Y,U,2)
. S DIC("A")="Another Medical Center Division: "
Q:$D(DTOUT)!$D(DUOUT)
S I=0
I $O(SDRRDIV(0)) D Q
. F S I=$O(SDRRDIV(I)) Q:'I S SDRRDIV=SDRRDIV+1
F S I=$O(^DG(40.8,I)) Q:'I S SDRRDIV(I)=$P(^(I,0),U),SDRRDIV=SDRRDIV+1
Q
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("?",11)="for you."
D ^DIR I $D(DIRUT) S SDRRABORT=1 Q
D @Y
Q
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^SDRRPXC(+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) ;
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^SDRRPXC(+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^SDRRPXC(+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?
; 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[HSDRRPXC 5876 printed Oct 16, 2024@19:01:15 Page 2
SDRRPXC ;;10N20/MAH;Recall Reminder Utilities ;01/18/2008 11:32
+1 ;;5.3;Scheduling;**536**;Aug 13, 1993;Build 53
+2 ;
STOPCODE(SDRRI) ; Return a clinic stop code
+1 QUIT $SELECT('SDRRI:SDRRI,1:$PIECE($GET(^DIC(40.7,SDRRI,0)),U,2))
PERDIV(SDRRDIV) ;
+1 SET I=0
+2 FOR
SET I=$ORDER(SDRRDIV(I))
if 'I
QUIT
SET SDRRDIV(I)=$PIECE($GET(^DG(40.8,I,0),"Unknown Division"),U)
+3 QUIT
ASKDIV(SDRRDIV) ;
+1 NEW DIC,X,Y,I,DUOUT,DTOUT
+2 KILL SDRRDIV
+3 SET SDRRDIV=0
+4 WRITE !
+5 SET DIC("A")="Select Medical Center Division: All// "
+6 SET DIC="^DG(40.8,"
+7 SET DIC(0)="AEQMN"
+8 FOR
Begin DoDot:1
+9 DO ^DIC
if Y=-1
QUIT
+10 SET SDRRDIV(+Y)=$PIECE(Y,U,2)
+11 SET DIC("A")="Another Medical Center Division: "
End DoDot:1
if Y=-1
QUIT
+12 if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+13 SET I=0
+14 IF $ORDER(SDRRDIV(0))
Begin DoDot:1
+15 FOR
SET I=$ORDER(SDRRDIV(I))
if 'I
QUIT
SET SDRRDIV=SDRRDIV+1
End DoDot:1
QUIT
+16 FOR
SET I=$ORDER(^DG(40.8,I))
if 'I
QUIT
SET SDRRDIV(I)=$PIECE(^(I,0),U)
SET SDRRDIV=SDRRDIV+1
+17 QUIT
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("?",11)="for you."
+16 DO ^DIR
IF $DATA(DIRUT)
SET SDRRABORT=1
QUIT
+17 DO @Y
+18 QUIT
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^SDRRPXC(+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 NEW DIC,X,Y,DTOUT,DUOUT,SDRRCNT,SDRRFROM
+2 SET SDRRCNT=0
+3 SET DIC="^SC("
SET DIC(0)="AEQM"
+4 WRITE !
+5 WRITE !,"To select a range of clinics, first you select the start of the range,"
+6 WRITE !,"or the 'from' clinic. Next, you select the end of the range,"
+7 WRITE !,"or the 'thru' clinic. We'll select all the clinics in that range for you."
+8 FOR
Begin DoDot:1
+9 WRITE !
+10 SET DIC("A")="From Clinic: "
+11 SET DIC("S")="I $$ACTIVE^SDRRPXC(+Y,.SDRRDIV,.SDRRST,.SDRRND,^(0))"
+12 DO ^DIC
if Y<0
QUIT
+13 ;S SDRRDIV(+Y)=$P(Y,U,2)
SET SDRRFROM=Y
+14 SET DIC("A")="Thru Clinic: "
+15 SET DIC("S")="I $P(^(0),U)]"""_$ORDER(^SC("B",$PIECE(SDRRFROM,U,2)),-1)_""",$$ACTIVE^SDRRPXC(+Y,.SDRRDIV,.SDRRST,.SDRRND,^(0))"
+16 DO ^DIC
if Y<0
QUIT
+17 SET SDRRCNT=SDRRCNT+1
+18 SET SDRRCLIN(SDRRCNT)=SDRRFROM_":"_Y
End DoDot:1
if Y<0
QUIT
+19 IF $DATA(DTOUT)!$DATA(DUOUT)
KILL SDRRCLIN
SET SDRRCLIN=0
+20 SET SDRRCLIN=SDRRCNT
+21 QUIT
ACTIVE(SDRRIEN,SDRRDIV,SDRRST,SDRRND,SDRRREC) ; Is the clinic active?
+1 ; SDRRIEN - IEN of clinic in HOSPITAL LOCATION (#44) file
+2 ; SDRRDIV - (optional) clinic must be in Division(s)
+3 ; SDRRDIV=ien or SDRRDIV(ien)="", where ien is IEN in file 40.8
+4 ; SDRRST - (optional) date range start date - default=DT
+5 ; SDRRND - (optional) date range end date - default=SDRRST
+6 ; SDRRREC - (optional) zero node of clinic
+7 IF '$DATA(SDRRREC)
SET SDRRREC=$GET(^SC(SDRRIEN,0))
+8 ; Not a clinic
if $PIECE(SDRRREC,U,3)'="C"
QUIT 0
+9 if $PIECE(SDRRREC,U,1)["*"
QUIT 0
+10 IF $DATA(SDRRDIV)=1
IF $PIECE(SDRRREC,U,15)'=SDRRDIV
QUIT 0
+11 IF $DATA(SDRRDIV)>9
IF '$DATA(SDRRDIV(+$PIECE(SDRRREC,U,15)))
QUIT 0
+12 SET SDRRREC=$GET(^SC(SDRRIEN,"I"))
+13 if 'SDRRREC
QUIT 1
+14 IF '$GET(SDRRST)
SET SDRRST=DT
+15 IF '$GET(SDRRND)
SET SDRRND=SDRRST
+16 IF $PIECE(SDRRREC,U,1)<SDRRST
QUIT $SELECT($PIECE(SDRRREC,U,2)="":0,$PIECE(SDRRREC,U,2)>SDRRND:0,1:1)
+17 ; Active
QUIT 1
