Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDRRUTL1

SDRRUTL1.m

Go to the documentation of this file. 
  1. SDRRUTL1 ;10N20/MAH;Recall Reminder-Clinic Utilities ;07/13/06  11:32
  1.  ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
  1. ASKCLIN(SDRRDIV,SDRRST,SDRRND) ;
  1.  N DIR,X,Y,DIRUT,SDRRABORT
  1.  W !!,"Now you'll select the clinics."
  1.  S DIR(0)="SO^R:Range of Clinics;I:Individual Clinics;S:Stop Codes"
  1.  S DIR("A")="Select Clinics by"
  1.  S DIR("?",1)="Choose 'Range of Clinics' if you want to select a group of clinics in"
  1.  S DIR("?",2)="consecutive name order.  You'll be asked for the starting clinic and the"
  1.  S DIR("?",3)="ending clinic.  All the clinics in that range will be selected for you."
  1.  S DIR("?",4)=""
  1.  S DIR("?",5)="Choose 'Individual Clinics' if you want to select clinics individually."
  1.  S DIR("?",6)="You'll be able to use ranges here, too, as well as wild cards.  You'll"
  1.  S DIR("?",7)="even be able to de-select clinics."
  1.  S DIR("?",8)=""
  1.  S DIR("?",9)="Choose 'Stop Codes' if you want to select Stop Codes.  All clinics whose"
  1.  S DIR("?",10)="Stop Codes or Credit Stops match the ones you've chosen will be selected"
  1.  S DIR("?")="for you."
  1.  D ^DIR I $D(DIRUT) S SDRRABORT=1 Q
  1.  D @Y
  1.  Q
  1. STOPCODE(SDRRI) ; Return a clinic stop code
  1.  Q $S('SDRRI:SDRRI,1:$P($G(^DIC(40.7,SDRRI,0)),U,2))
  1. I ; Select individual clinics
  1.  N SDRRDIC,SDRRNAME,SDRRIEN,SDRRREC
  1.  W !!,"You'll be able to use ranges and wild cards to select clinics."
  1.  W !,"You'll even be able to deselect clinics."
  1.  W !,"Enter '?' at the prompt to see how."
  1.  S SDRRDIC=44
  1.  S SDRRDIC(0)="AEMNQZ"
  1.  S SDRRDIC("A")="Select Clinic: "
  1.  S SDRRDIC("B")="All"
  1.  S SDRRDIC("S")="I $$ACTIVE^SDRRUTL1(+Y,.SDRRDIV,.SDRRST,.SDRRND,^(0))"
  1.  I '$$EN^SDRRSLCT(.SDRRDIC,"SDRR") S SDRRABORT=1 Q
  1.  S (SDRRNAME,SDRRIEN)=""
  1.  F  S SDRRNAME=$O(^TMP($J,"SDRR",SDRRNAME)) Q:SDRRNAME=""  D
  1.  . F  S SDRRIEN=$O(^TMP($J,"SDRR",SDRRNAME,SDRRIEN)) Q:SDRRIEN=""  D
  1.  . . S SDRRREC=$G(^SC(SDRRIEN,0))
  1.  . . 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))
  1.  K ^TMP($J,"SDRR")
  1.  Q
  1. R ; Select range of clinics
  1.  N SDRRCLIN,SDRRIEN,SDRRREC,SDRRFROM,SDRRTHRU,SDRRI
  1.  D ASKRANGE(.SDRRCLIN,.SDRRDIV,.SDRRST,.SDRRND)
  1.  I 'SDRRCLIN S SDRRABORT=1 Q
  1.  S SDRRI=0
  1.  F  S SDRRI=$O(SDRRCLIN(SDRRI)) Q:'SDRRI  D
  1.  . S SDRRFROM=$P($P(SDRRCLIN(SDRRI),":"),U,2)
  1.  . S SDRRFROM=$O(^SC("B",SDRRFROM),-1)
  1.  . S SDRRTHRU=$P($P(SDRRCLIN(SDRRI),":",2),U,2)
  1.  . S SDRRCLIN=SDRRFROM
  1.  . F  S SDRRCLIN=$O(^SC("B",SDRRCLIN)) Q:SDRRCLIN=""  D  Q:SDRRCLIN=SDRRTHRU
  1.  . . S SDRRIEN=$O(^SC("B",SDRRCLIN,0))
  1.  . . S SDRRREC=$G(^SC(SDRRIEN,0))
  1.  . . Q:'$$ACTIVE(SDRRIEN,.SDRRDIV,.SDRRST,.SDRRND,SDRRREC)
  1.  . . 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))
  1.  Q
  1. S ; Select stop codes
  1.  N SDRRDIC,SDRRSC,SDRRSCI,SDRRNDX,SDRRIEN,SDRRREC
  1.  S SDRRDIC=40.7
  1.  S SDRRDIC(0)="AEMQZ"
  1.  S SDRRDIC("A")="Select Stop Code: "
  1.  S SDRRDIC("S")="S %=$P(^(0),U,3) I '%!(%>"_$G(SDRRST,DT)_")"
  1.  I '$$EN^SDRRSLCT(.SDRRDIC,"SDRR") S SDRRABORT=1 Q
  1.  S (SDRRSC,SDRRSCI,SDRRIEN)=""
  1.  F  S SDRRSC=$O(^TMP($J,"SDRR",SDRRSC)) Q:SDRRSC=""  D
  1.  . F  S SDRRSCI=$O(^TMP($J,"SDRR",SDRRSC,SDRRSCI)) Q:'SDRRSCI  D
  1.  . . F SDRRNDX="AST","ACST" D  ; xrefs on STOP CODE and CREDIT STOP fields
  1.  . . . F  S SDRRIEN=$O(^SC(SDRRNDX,SDRRSCI,SDRRIEN)) Q:'SDRRIEN  D
  1.  . . . . S SDRRREC=$G(^SC(SDRRIEN,0))
  1.  . . . . Q:'$$ACTIVE(SDRRIEN,.SDRRDIV,.SDRRST,.SDRRND,SDRRREC)
  1.  . . . . 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))
  1.  K ^TMP($J,"SDRR")
  1.  Q
  1. ASKRANGE(SDRRCLIN,SDRRDIV,SDRRST,SDRRND) ;
  1.  ;   DBIA #10040; Direct global reference of (#44) file 
  1.  N DIC,X,Y,DTOUT,DUOUT,SDRRCNT,SDRRFROM
  1.  S SDRRCNT=0
  1.  S DIC="^SC(",DIC(0)="AEQM"
  1.  W !
  1.  W !,"To select a range of clinics, first you select the start of the range,"
  1.  W !,"or the 'from' clinic.  Next, you select the end of the range,"
  1.  W !,"or the 'thru' clinic.  We'll select all the clinics in that range for you."
  1.  F  D  Q:Y<0
  1.  . W !
  1.  . S DIC("A")="From Clinic: "
  1.  . S DIC("S")="I $$ACTIVE^SDRRUTL1(+Y,.SDRRDIV,.SDRRST,.SDRRND,^(0))"
  1.  . D ^DIC Q:Y<0
  1.  . S SDRRFROM=Y ;S SDRRDIV(+Y)=$P(Y,U,2)
  1.  . S DIC("A")="Thru Clinic: "
  1.  . S DIC("S")="I $P(^(0),U)]"""_$O(^SC("B",$P(SDRRFROM,U,2)),-1)_""",$$ACTIVE^SDRRUTL1(+Y,.SDRRDIV,.SDRRST,.SDRRND,^(0))"
  1.  . D ^DIC Q:Y<0
  1.  . S SDRRCNT=SDRRCNT+1
  1.  . S SDRRCLIN(SDRRCNT)=SDRRFROM_":"_Y
  1.  I $D(DTOUT)!$D(DUOUT) K SDRRCLIN S SDRRCLIN=0
  1.  S SDRRCLIN=SDRRCNT
  1.  Q
  1. ACTIVE(SDRRIEN,SDRRDIV,SDRRST,SDRRND,SDRRREC) ; Is the clinic active?
  1.  ;   DBIA #10040; Direct global reference of (#44) file 
  1.  ; SDRRIEN - IEN of clinic in HOSPITAL LOCATION (#44) file
  1.  ; SDRRDIV - (optional) clinic must be in Division(s)
  1.  ;          SDRRDIV=ien  or SDRRDIV(ien)="", where ien is IEN in file 40.8
  1.  ; SDRRST  - (optional) date range start date - default=DT
  1.  ; SDRRND  - (optional) date range end date - default=SDRRST
  1.  ; SDRRREC - (optional) zero node of clinic
  1.  I '$D(SDRRREC) S SDRRREC=$G(^SC(SDRRIEN,0))
  1.  Q:$P(SDRRREC,U,3)'="C" 0  ; Not a clinic
  1.  Q:$P(SDRRREC,U,1)["*" 0
  1.  I $D(SDRRDIV)=1,$P(SDRRREC,U,15)'=SDRRDIV Q 0
  1.  I $D(SDRRDIV)>9,'$D(SDRRDIV(+$P(SDRRREC,U,15))) Q 0
  1.  S SDRRREC=$G(^SC(SDRRIEN,"I"))
  1.  Q:'SDRRREC 1
  1.  I '$G(SDRRST) S SDRRST=DT
  1.  I '$G(SDRRND) S SDRRND=SDRRST
  1.  I $P(SDRRREC,U,1)<SDRRST Q $S($P(SDRRREC,U,2)="":0,$P(SDRRREC,U,2)>SDRRND:0,1:1)
  1.  Q 1  ; Active