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

ORLP01.m

Go to the documentation of this file.
  1. ORLP01 ; SLC/MKB,CLA - Edit Patient Lists cont ; 20 Sep 2005 1:05 PM
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**11,47,215**;Dec 17, 1997
  1. ;
  1. ; DBIA 3869 GETPLIST^SDAMA202 ^TMP($J,"SDAMA202")
  1. ;
  1. ; Modified 3/2000 by PKS/SLC to screen out inactive wards, clinics,
  1. ; and terminated/deactivated providers.
  1. ;
  1. PROV ;from ASKPT^ORLP00, option ORLP ADD PROVIDER - Add provider's patients to list, display # of patients added if not TEAM list
  1. D ASK^ORLP0(.X)
  1. I (X<0)!(X>1) Q
  1. S:'$D(ORCNT) ORCNT=$S($D(^XUTL("OR",$J,"ORLP",0)):+$P(^(0),"^",4),1:0)
  1. F S ORCT=0 D P1 Q:+ORY<1 I ORCNT>0 W:'($D(TEAM)#2) !!,ORCT_" Patients added, "_ORCNT_" total"
  1. I $G(DUOUT)=1!(ORCNT'>0) W:'($D(TEAM)#2) !!,"No patients added.",! K ORCNT G END^ORLP0
  1. D SEQ^ORLP0
  1. Q
  1. ;
  1. P1 ;
  1. K DIC
  1. S DIC=200,DIC(0)="AEQ",DIC("A")="Select PROVIDER: ",D="AK.PROVIDER^PS1^PS2^B"
  1. ; Setting of DIC("S") modified by PKS:
  1. S DIC("S")="I $D(^VA(200,""AK.PROVIDER"",$P(^(0),U))),$$ACTIVE^XUSER(+Y)"
  1. N ORPTYP,DIR
  1. D MIX^DIC1
  1. K DIC
  1. S ORY=Y
  1. Q:+Y<1
  1. S ORZ=+Y
  1. F D I $D(DIRUT)!Y]""!(Y["^") S ORY=-1 Q
  1. . S DIR(0)="S^P:PRIMARY CARE PHYSICIAN;A:ATTENDING PHYSICIAN;B:BOTH",DIR("A")="Select",DIR("B")="BOTH"
  1. . S DIR("?",1)="In order to determine how this Provider's patients will be added to this list,"
  1. . S DIR("?",2)="enter a response that will use the following rules."
  1. . S DIR("?",3)=" 'P' - Primary will add patients to the list that have the chosen provider"
  1. . S DIR("?",4)="assigned to them thru the MAS options as PRIMARY CARE PHYSICIAN."
  1. . S DIR("?",5)=" 'A' - Attending will add patients to the list that have chosen provider"
  1. . S DIR("?",6)="assigned to them thru the MAS options as ATTENDING PHYSICIAN."
  1. . S DIR("?",7)=" 'B' - Both will add patients to the list that have the chosen provider"
  1. . S DIR("?")="assigned to them thru the MAS options as PRIMARY CARE PHYSICIAN or ATTENDING PHYSICIAN."
  1. . D ^DIR
  1. . Q:Y']""
  1. . S ORPTYP=Y
  1. Q:$S($G(ORPTYP)']"":1,"ABP"'[$G(ORPTYP):1,1:0)
  1. I '$D(^DPT("APR",ORZ)),'$D(^DPT("AAP",ORZ)) W !!,"No patients found for this provider!" Q
  1. W !!,"Working..."
  1. D PREF^ORLP0
  1. I "BP"[ORPTYP S ORJ=0 F S ORJ=$O(^DPT("APR",ORZ,ORJ)) Q:ORJ<1 S ORX="",ORVP=ORJ_";DPT(" D PR1^ORLA1(ORVP,OROPREF)
  1. I "AB"[ORPTYP S ORJ=0 F ORI=0:0 S ORJ=$O(^DPT("AAP",ORZ,ORJ)) Q:ORJ<1 S ORX="",ORVP=ORJ_";DPT(" D PR1^ORLA1(ORVP,OROPREF)
  1. Q
  1. ;
  1. SPEC ; from ASKPT^ORLP00, option ORLP ADD SPECIALTY - Add treating specialty's patients to list, display # of patients added if not TEAM list
  1. D ASK^ORLP0(.X)
  1. I (X<0)!(X>1) Q
  1. S:'$D(ORCNT) ORCNT=$S($D(^XUTL("OR",$J,"ORLP",0)):+$P(^(0),"^",4),1:0)
  1. F S ORCT=0 D S1 Q:+ORY<1 I ORCNT>0 W:'($D(TEAM)#2) !!,ORCT_" Patients added, "_ORCNT_" total"
  1. I $G(DUOUT)=1!(ORCNT'>0) W:'($D(TEAM)#2) !!,"No patients added.",! G END^ORLP0
  1. D SEQ^ORLP0
  1. Q
  1. ;
  1. S1 ;
  1. K DIC
  1. S DIC="^DIC(45.7,",DIC(0)="AQEM",DIC("A")="Select SPECIALTY: "
  1. D ^DIC
  1. S ORY=Y
  1. K DIC
  1. Q:+Y<1
  1. I '$D(^DPT("ATR",+ORY)) W !!,"No patients found for this treating specialty!" Q
  1. W !!,"Working..."
  1. D PREF^ORLP0
  1. S ORJ=0 F S ORJ=$O(^DPT("ATR",+ORY,ORJ)) Q:ORJ<1 S ORX="",ORVP=ORJ_";DPT(" D PR1^ORLA1(ORVP,OROPREF)
  1. Q
  1. ;
  1. WARD ;from ASKPT^ORLP00, option ORLP ADD WARD - Add ward's patients to list, display # of patients added if not TEAM list
  1. D ASK^ORLP0(.X)
  1. I (X<0)!(X>1) Q
  1. S:'$D(ORCNT) ORCNT=$S($D(^XUTL("OR",$J,"ORLP",0)):+$P(^(0),"^",4),1:0)
  1. F S ORCT=0 D W1 Q:+ORY<1 I ORCNT>0 W:'($D(TEAM)#2) !!,ORCT_" Patients added, "_ORCNT_" total"
  1. I $G(DUOUT)=1!(ORCNT'>0) W:'($D(TEAM)#2) !!,"No patients added.",! G END^ORLP0
  1. D SEQ^ORLP0
  1. Q
  1. ;
  1. W1 ;
  1. K DIC
  1. S DIC="^DIC(42,",DIC(0)="AQEM"
  1. ; Next line added by PKS:
  1. S DIC("S")="I '$$WINACT^ORLP3U1(+Y)"
  1. D ^DIC
  1. S ORY=Y
  1. K DIC
  1. Q:+Y<1
  1. I '$D(^DPT("CN",$P(Y,"^",2))) W !!,"No Patients found on ward!" Q
  1. W !!,"Working..."
  1. D PREF^ORLP0
  1. S ORJ=0 F S ORJ=$O(^DPT("CN",$P(ORY,"^",2),ORJ)) Q:ORJ<1 S ORVP=ORJ_";DPT(",ORX="" D PR1^ORLA1(ORVP,OROPREF)
  1. Q
  1. ;
  1. CLIN ;from ASKPT^ORLP, option ORLP ADD CLINIC - Add clinic's patients to list, display # of patients added if not TEAM list
  1. D ASK^ORLP0(.X)
  1. I (X<0)!(X>1) Q
  1. S:'$D(ORCNT) ORCNT=$S($D(^XUTL("OR",$J,"ORLP",0)):+$P(^(0),"^",4),1:0)
  1. F S ORCT=0 D C1 Q:+ORY<1 I ORCNT>0 W:'($D(TEAM)#2) !!,ORCT_" Patients added, "_ORCNT_" total"
  1. I $G(DUOUT)=1!(ORCNT'>0) W:'($D(TEAM)#2) !!,"No patients added.",! G END^ORLP0
  1. D SEQ^ORLP0
  1. Q
  1. ;
  1. C1 ; DBIA 3869
  1. K DIC
  1. S DIC("A")="Select CLINIC: ",ORCT=0,ORCSTRT="",ORCEND="",ORCLIN=""
  1. S DIC("S")="I $P(^(0),""^"",3)=""C"""
  1. D LOC
  1. K DIC
  1. S ORY=Y
  1. Q:+Y<1
  1. S ORCLIN=+Y,ORDEF="C"
  1. W:$L(ORCSTRT) !,"Starting date: "
  1. S %DT=$S($L(ORCSTRT):"E",1:"AE"),X=$S($L(ORCSTRT):ORCSTRT,1:"")
  1. S:'$L(ORCSTRT) %DT("A")="Patient Appointment STARTING DATE: ",%DT("B")="T"
  1. D ^%DT
  1. I Y<0 S OREND=1 Q
  1. S ORCSTRT=Y
  1. D DD^%DT
  1. W:$L(ORCEND) !,"Ending date: "
  1. S %DT=$S($L(ORCEND):"E",1:"AE"),X=$S($L(ORCEND):ORCEND,1:"")
  1. S:'$L(ORCEND) %DT("A")="Patient Appointment ENDING DATE: ",%DT("B")=Y
  1. D ^%DT
  1. I Y<0 S OREND=1 Q
  1. S ORCEND=$P(Y,".")_.5
  1. I ORCEND<ORCSTRT S ORCTMP=ORCEND,ORCEND=ORCSTRT,ORCSTRT=ORCTMP K ORCTMP
  1. W !,"Working..."
  1. D PREF^ORLP0
  1. S ORJ=ORCSTRT
  1. N ORI,ORERR
  1. K ^TMP($J,"SDAMA202","GETPLIST")
  1. D GETPLIST^SDAMA202(+ORCLIN,"1;4","",ORCSTRT,ORCEND) ;DBIA 3869
  1. S ORERR=$$CLINERR^ORQRY01
  1. I $L(ORERR) W !,ORERR S ORY=-1,ORCNT=0 Q
  1. S ORI=0
  1. F S ORI=$O(^TMP($J,"SDAMA202","GETPLIST",ORI)) Q:ORI<1 D ;DBIA 3869
  1. . S ORJ=+$G(^TMP($J,"SDAMA202","GETPLIST",ORI,1))
  1. . S ORVP=+$G(^TMP($J,"SDAMA202","GETPLIST",ORI,4))_";DPT("
  1. . I ORJ,ORVP S ORX="" D PR1^ORLA1(ORVP,OROPREF)
  1. K ^TMP($J,"SDAMA202","GETPLIST")
  1. I '$L($O(^XUTL("OR",$J,"ORLP",0))) W *7,!,"No patients found!"
  1. Q
  1. ;
  1. LOC ;Hospital Location Look-up For Clinics
  1. ; Copied from ORUTL and modified by PKS.
  1. N DIC,ORIA,ORRA
  1. S DIC=44,DIC(0)="AEQM"
  1. ; Setting of DIC("S") modified by PKS:
  1. S DIC("S")="I $D(X),$P(^SC(+Y,0),U,3)=""C"",$$ACTLOC^ORWU(+Y)=1"
  1. D ^DIC
  1. I Y<1 Q
  1. I $D(^SC(+Y,"I")) S ORIA=+^("I"),ORRA=$P(^("I"),U,2)
  1. I $S('$D(ORIA):0,'ORIA:0,ORIA>DT:0,ORRA'>DT&(ORRA):0,1:1) W $C(7),!," This location has been inactivated.",! K ORL G LOC
  1. Q
  1. ;