- 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 Mar 13, 2025@22:05:57 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
