ORLP01 ; SLC/MKB,CLA - Edit Patient Lists cont ; 20 Sep 2005 1:05 PM
;;3.0;ORDER ENTRY/RESULTS REPORTING;**11,47,215**;Dec 17, 1997
;
; DBIA 3869 GETPLIST^SDAMA202 ^TMP($J,"SDAMA202")
;
; Modified 3/2000 by PKS/SLC to screen out inactive wards, clinics,
; and terminated/deactivated providers.
;
PROV ;from ASKPT^ORLP00, option ORLP ADD PROVIDER - Add provider's patients to list, display # of patients added if not TEAM list
D ASK^ORLP0(.X)
I (X<0)!(X>1) Q
S:'$D(ORCNT) ORCNT=$S($D(^XUTL("OR",$J,"ORLP",0)):+$P(^(0),"^",4),1:0)
F S ORCT=0 D P1 Q:+ORY<1 I ORCNT>0 W:'($D(TEAM)#2) !!,ORCT_" Patients added, "_ORCNT_" total"
I $G(DUOUT)=1!(ORCNT'>0) W:'($D(TEAM)#2) !!,"No patients added.",! K ORCNT G END^ORLP0
D SEQ^ORLP0
Q
;
P1 ;
K DIC
S DIC=200,DIC(0)="AEQ",DIC("A")="Select PROVIDER: ",D="AK.PROVIDER^PS1^PS2^B"
; Setting of DIC("S") modified by PKS:
S DIC("S")="I $D(^VA(200,""AK.PROVIDER"",$P(^(0),U))),$$ACTIVE^XUSER(+Y)"
N ORPTYP,DIR
D MIX^DIC1
K DIC
S ORY=Y
Q:+Y<1
S ORZ=+Y
F D I $D(DIRUT)!Y]""!(Y["^") S ORY=-1 Q
. S DIR(0)="S^P:PRIMARY CARE PHYSICIAN;A:ATTENDING PHYSICIAN;B:BOTH",DIR("A")="Select",DIR("B")="BOTH"
. S DIR("?",1)="In order to determine how this Provider's patients will be added to this list,"
. S DIR("?",2)="enter a response that will use the following rules."
. S DIR("?",3)=" 'P' - Primary will add patients to the list that have the chosen provider"
. S DIR("?",4)="assigned to them thru the MAS options as PRIMARY CARE PHYSICIAN."
. S DIR("?",5)=" 'A' - Attending will add patients to the list that have chosen provider"
. S DIR("?",6)="assigned to them thru the MAS options as ATTENDING PHYSICIAN."
. S DIR("?",7)=" 'B' - Both will add patients to the list that have the chosen provider"
. S DIR("?")="assigned to them thru the MAS options as PRIMARY CARE PHYSICIAN or ATTENDING PHYSICIAN."
. D ^DIR
. Q:Y']""
. S ORPTYP=Y
Q:$S($G(ORPTYP)']"":1,"ABP"'[$G(ORPTYP):1,1:0)
I '$D(^DPT("APR",ORZ)),'$D(^DPT("AAP",ORZ)) W !!,"No patients found for this provider!" Q
W !!,"Working..."
D PREF^ORLP0
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)
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)
Q
;
SPEC ; from ASKPT^ORLP00, option ORLP ADD SPECIALTY - Add treating specialty's patients to list, display # of patients added if not TEAM list
D ASK^ORLP0(.X)
I (X<0)!(X>1) Q
S:'$D(ORCNT) ORCNT=$S($D(^XUTL("OR",$J,"ORLP",0)):+$P(^(0),"^",4),1:0)
F S ORCT=0 D S1 Q:+ORY<1 I ORCNT>0 W:'($D(TEAM)#2) !!,ORCT_" Patients added, "_ORCNT_" total"
I $G(DUOUT)=1!(ORCNT'>0) W:'($D(TEAM)#2) !!,"No patients added.",! G END^ORLP0
D SEQ^ORLP0
Q
;
S1 ;
K DIC
S DIC="^DIC(45.7,",DIC(0)="AQEM",DIC("A")="Select SPECIALTY: "
D ^DIC
S ORY=Y
K DIC
Q:+Y<1
I '$D(^DPT("ATR",+ORY)) W !!,"No patients found for this treating specialty!" Q
W !!,"Working..."
D PREF^ORLP0
S ORJ=0 F S ORJ=$O(^DPT("ATR",+ORY,ORJ)) Q:ORJ<1 S ORX="",ORVP=ORJ_";DPT(" D PR1^ORLA1(ORVP,OROPREF)
Q
;
WARD ;from ASKPT^ORLP00, option ORLP ADD WARD - Add ward's patients to list, display # of patients added if not TEAM list
D ASK^ORLP0(.X)
I (X<0)!(X>1) Q
S:'$D(ORCNT) ORCNT=$S($D(^XUTL("OR",$J,"ORLP",0)):+$P(^(0),"^",4),1:0)
F S ORCT=0 D W1 Q:+ORY<1 I ORCNT>0 W:'($D(TEAM)#2) !!,ORCT_" Patients added, "_ORCNT_" total"
I $G(DUOUT)=1!(ORCNT'>0) W:'($D(TEAM)#2) !!,"No patients added.",! G END^ORLP0
D SEQ^ORLP0
Q
;
W1 ;
K DIC
S DIC="^DIC(42,",DIC(0)="AQEM"
; Next line added by PKS:
S DIC("S")="I '$$WINACT^ORLP3U1(+Y)"
D ^DIC
S ORY=Y
K DIC
Q:+Y<1
I '$D(^DPT("CN",$P(Y,"^",2))) W !!,"No Patients found on ward!" Q
W !!,"Working..."
D PREF^ORLP0
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)
Q
;
CLIN ;from ASKPT^ORLP, option ORLP ADD CLINIC - Add clinic's patients to list, display # of patients added if not TEAM list
D ASK^ORLP0(.X)
I (X<0)!(X>1) Q
S:'$D(ORCNT) ORCNT=$S($D(^XUTL("OR",$J,"ORLP",0)):+$P(^(0),"^",4),1:0)
F S ORCT=0 D C1 Q:+ORY<1 I ORCNT>0 W:'($D(TEAM)#2) !!,ORCT_" Patients added, "_ORCNT_" total"
I $G(DUOUT)=1!(ORCNT'>0) W:'($D(TEAM)#2) !!,"No patients added.",! G END^ORLP0
D SEQ^ORLP0
Q
;
C1 ; DBIA 3869
K DIC
S DIC("A")="Select CLINIC: ",ORCT=0,ORCSTRT="",ORCEND="",ORCLIN=""
S DIC("S")="I $P(^(0),""^"",3)=""C"""
D LOC
K DIC
S ORY=Y
Q:+Y<1
S ORCLIN=+Y,ORDEF="C"
W:$L(ORCSTRT) !,"Starting date: "
S %DT=$S($L(ORCSTRT):"E",1:"AE"),X=$S($L(ORCSTRT):ORCSTRT,1:"")
S:'$L(ORCSTRT) %DT("A")="Patient Appointment STARTING DATE: ",%DT("B")="T"
D ^%DT
I Y<0 S OREND=1 Q
S ORCSTRT=Y
D DD^%DT
W:$L(ORCEND) !,"Ending date: "
S %DT=$S($L(ORCEND):"E",1:"AE"),X=$S($L(ORCEND):ORCEND,1:"")
S:'$L(ORCEND) %DT("A")="Patient Appointment ENDING DATE: ",%DT("B")=Y
D ^%DT
I Y<0 S OREND=1 Q
S ORCEND=$P(Y,".")_.5
I ORCEND<ORCSTRT S ORCTMP=ORCEND,ORCEND=ORCSTRT,ORCSTRT=ORCTMP K ORCTMP
W !,"Working..."
D PREF^ORLP0
S ORJ=ORCSTRT
N ORI,ORERR
K ^TMP($J,"SDAMA202","GETPLIST")
D GETPLIST^SDAMA202(+ORCLIN,"1;4","",ORCSTRT,ORCEND) ;DBIA 3869
S ORERR=$$CLINERR^ORQRY01
I $L(ORERR) W !,ORERR S ORY=-1,ORCNT=0 Q
S ORI=0
F S ORI=$O(^TMP($J,"SDAMA202","GETPLIST",ORI)) Q:ORI<1 D ;DBIA 3869
. S ORJ=+$G(^TMP($J,"SDAMA202","GETPLIST",ORI,1))
. S ORVP=+$G(^TMP($J,"SDAMA202","GETPLIST",ORI,4))_";DPT("
. I ORJ,ORVP S ORX="" D PR1^ORLA1(ORVP,OROPREF)
K ^TMP($J,"SDAMA202","GETPLIST")
I '$L($O(^XUTL("OR",$J,"ORLP",0))) W *7,!,"No patients found!"
Q
;
LOC ;Hospital Location Look-up For Clinics
; Copied from ORUTL and modified by PKS.
N DIC,ORIA,ORRA
S DIC=44,DIC(0)="AEQM"
; Setting of DIC("S") modified by PKS:
S DIC("S")="I $D(X),$P(^SC(+Y,0),U,3)=""C"",$$ACTLOC^ORWU(+Y)=1"
D ^DIC
I Y<1 Q
I $D(^SC(+Y,"I")) S ORIA=+^("I"),ORRA=$P(^("I"),U,2)
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
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORLP01 6172 printed Apr 09, 2024@21:37:45 Page 2
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
+2 ;
+3 ; DBIA 3869 GETPLIST^SDAMA202 ^TMP($J,"SDAMA202")
+4 ;
+5 ; Modified 3/2000 by PKS/SLC to screen out inactive wards, clinics,
+6 ; and terminated/deactivated providers.
+7 ;
PROV ;from ASKPT^ORLP00, option ORLP ADD PROVIDER - Add provider's patients to list, display # of patients added if not TEAM list
+1 DO ASK^ORLP0(.X)
+2 IF (X<0)!(X>1)
QUIT
+3 if '$DATA(ORCNT)
SET ORCNT=$SELECT($DATA(^XUTL("OR",$JOB,"ORLP",0)):+$PIECE(^(0),"^",4),1:0)
+4 FOR
SET ORCT=0
DO P1
if +ORY<1
QUIT
IF ORCNT>0
if '($DATA(TEAM)#2)
WRITE !!,ORCT_" Patients added, "_ORCNT_" total"
+5 IF $GET(DUOUT)=1!(ORCNT'>0)
if '($DATA(TEAM)#2)
WRITE !!,"No patients added.",!
KILL ORCNT
GOTO END^ORLP0
+6 DO SEQ^ORLP0
+7 QUIT
+8 ;
P1 ;
+1 KILL DIC
+2 SET DIC=200
SET DIC(0)="AEQ"
SET DIC("A")="Select PROVIDER: "
SET D="AK.PROVIDER^PS1^PS2^B"
+3 ; Setting of DIC("S") modified by PKS:
+4 SET DIC("S")="I $D(^VA(200,""AK.PROVIDER"",$P(^(0),U))),$$ACTIVE^XUSER(+Y)"
+5 NEW ORPTYP,DIR
+6 DO MIX^DIC1
+7 KILL DIC
+8 SET ORY=Y
+9 if +Y<1
QUIT
+10 SET ORZ=+Y
+11 FOR
Begin DoDot:1
+12 SET DIR(0)="S^P:PRIMARY CARE PHYSICIAN;A:ATTENDING PHYSICIAN;B:BOTH"
SET DIR("A")="Select"
SET DIR("B")="BOTH"
+13 SET DIR("?",1)="In order to determine how this Provider's patients will be added to this list,"
+14 SET DIR("?",2)="enter a response that will use the following rules."
+15 SET DIR("?",3)=" 'P' - Primary will add patients to the list that have the chosen provider"
+16 SET DIR("?",4)="assigned to them thru the MAS options as PRIMARY CARE PHYSICIAN."
+17 SET DIR("?",5)=" 'A' - Attending will add patients to the list that have chosen provider"
+18 SET DIR("?",6)="assigned to them thru the MAS options as ATTENDING PHYSICIAN."
+19 SET DIR("?",7)=" 'B' - Both will add patients to the list that have the chosen provider"
+20 SET DIR("?")="assigned to them thru the MAS options as PRIMARY CARE PHYSICIAN or ATTENDING PHYSICIAN."
+21 DO ^DIR
+22 if Y']""
QUIT
+23 SET ORPTYP=Y
End DoDot:1
IF $DATA(DIRUT)!Y]""!(Y["^")
SET ORY=-1
QUIT
+24 if $SELECT($GET(ORPTYP)']""
QUIT
+25 IF '$DATA(^DPT("APR",ORZ))
IF '$DATA(^DPT("AAP",ORZ))
WRITE !!,"No patients found for this provider!"
QUIT
+26 WRITE !!,"Working..."
+27 DO PREF^ORLP0
+28 IF "BP"[ORPTYP
SET ORJ=0
FOR
SET ORJ=$ORDER(^DPT("APR",ORZ,ORJ))
if ORJ<1
QUIT
SET ORX=""
SET ORVP=ORJ_";DPT("
DO PR1^ORLA1(ORVP,OROPREF)
+29 IF "AB"[ORPTYP
SET ORJ=0
FOR ORI=0:0
SET ORJ=$ORDER(^DPT("AAP",ORZ,ORJ))
if ORJ<1
QUIT
SET ORX=""
SET ORVP=ORJ_";DPT("
DO PR1^ORLA1(ORVP,OROPREF)
+30 QUIT
+31 ;
SPEC ; from ASKPT^ORLP00, option ORLP ADD SPECIALTY - Add treating specialty's patients to list, display # of patients added if not TEAM list
+1 DO ASK^ORLP0(.X)
+2 IF (X<0)!(X>1)
QUIT
+3 if '$DATA(ORCNT)
SET ORCNT=$SELECT($DATA(^XUTL("OR",$JOB,"ORLP",0)):+$PIECE(^(0),"^",4),1:0)
+4 FOR
SET ORCT=0
DO S1
if +ORY<1
QUIT
IF ORCNT>0
if '($DATA(TEAM)#2)
WRITE !!,ORCT_" Patients added, "_ORCNT_" total"
+5 IF $GET(DUOUT)=1!(ORCNT'>0)
if '($DATA(TEAM)#2)
WRITE !!,"No patients added.",!
GOTO END^ORLP0
+6 DO SEQ^ORLP0
+7 QUIT
+8 ;
S1 ;
+1 KILL DIC
+2 SET DIC="^DIC(45.7,"
SET DIC(0)="AQEM"
SET DIC("A")="Select SPECIALTY: "
+3 DO ^DIC
+4 SET ORY=Y
+5 KILL DIC
+6 if +Y<1
QUIT
+7 IF '$DATA(^DPT("ATR",+ORY))
WRITE !!,"No patients found for this treating specialty!"
QUIT
+8 WRITE !!,"Working..."
+9 DO PREF^ORLP0
+10 SET ORJ=0
FOR
SET ORJ=$ORDER(^DPT("ATR",+ORY,ORJ))
if ORJ<1
QUIT
SET ORX=""
SET ORVP=ORJ_";DPT("
DO PR1^ORLA1(ORVP,OROPREF)
+11 QUIT
+12 ;
WARD ;from ASKPT^ORLP00, option ORLP ADD WARD - Add ward's patients to list, display # of patients added if not TEAM list
+1 DO ASK^ORLP0(.X)
+2 IF (X<0)!(X>1)
QUIT
+3 if '$DATA(ORCNT)
SET ORCNT=$SELECT($DATA(^XUTL("OR",$JOB,"ORLP",0)):+$PIECE(^(0),"^",4),1:0)
+4 FOR
SET ORCT=0
DO W1
if +ORY<1
QUIT
IF ORCNT>0
if '($DATA(TEAM)#2)
WRITE !!,ORCT_" Patients added, "_ORCNT_" total"
+5 IF $GET(DUOUT)=1!(ORCNT'>0)
if '($DATA(TEAM)#2)
WRITE !!,"No patients added.",!
GOTO END^ORLP0
+6 DO SEQ^ORLP0
+7 QUIT
+8 ;
W1 ;
+1 KILL DIC
+2 SET DIC="^DIC(42,"
SET DIC(0)="AQEM"
+3 ; Next line added by PKS:
+4 SET DIC("S")="I '$$WINACT^ORLP3U1(+Y)"
+5 DO ^DIC
+6 SET ORY=Y
+7 KILL DIC
+8 if +Y<1
QUIT
+9 IF '$DATA(^DPT("CN",$PIECE(Y,"^",2)))
WRITE !!,"No Patients found on ward!"
QUIT
+10 WRITE !!,"Working..."
+11 DO PREF^ORLP0
+12 SET ORJ=0
FOR
SET ORJ=$ORDER(^DPT("CN",$PIECE(ORY,"^",2),ORJ))
if ORJ<1
QUIT
SET ORVP=ORJ_";DPT("
SET ORX=""
DO PR1^ORLA1(ORVP,OROPREF)
+13 QUIT
+14 ;
CLIN ;from ASKPT^ORLP, option ORLP ADD CLINIC - Add clinic's patients to list, display # of patients added if not TEAM list
+1 DO ASK^ORLP0(.X)
+2 IF (X<0)!(X>1)
QUIT
+3 if '$DATA(ORCNT)
SET ORCNT=$SELECT($DATA(^XUTL("OR",$JOB,"ORLP",0)):+$PIECE(^(0),"^",4),1:0)
+4 FOR
SET ORCT=0
DO C1
if +ORY<1
QUIT
IF ORCNT>0
if '($DATA(TEAM)#2)
WRITE !!,ORCT_" Patients added, "_ORCNT_" total"
+5 IF $GET(DUOUT)=1!(ORCNT'>0)
if '($DATA(TEAM)#2)
WRITE !!,"No patients added.",!
GOTO END^ORLP0
+6 DO SEQ^ORLP0
+7 QUIT
+8 ;
C1 ; DBIA 3869
+1 KILL DIC
+2 SET DIC("A")="Select CLINIC: "
SET ORCT=0
SET ORCSTRT=""
SET ORCEND=""
SET ORCLIN=""
+3 SET DIC("S")="I $P(^(0),""^"",3)=""C"""
+4 DO LOC
+5 KILL DIC
+6 SET ORY=Y
+7 if +Y<1
QUIT
+8 SET ORCLIN=+Y
SET ORDEF="C"
+9 if $LENGTH(ORCSTRT)
WRITE !,"Starting date: "
+10 SET %DT=$SELECT($LENGTH(ORCSTRT):"E",1:"AE")
SET X=$SELECT($LENGTH(ORCSTRT):ORCSTRT,1:"")
+11 if '$LENGTH(ORCSTRT)
SET %DT("A")="Patient Appointment STARTING DATE: "
SET %DT("B")="T"
+12 DO ^%DT
+13 IF Y<0
SET OREND=1
QUIT
+14 SET ORCSTRT=Y
+15 DO DD^%DT
+16 if $LENGTH(ORCEND)
WRITE !,"Ending date: "
+17 SET %DT=$SELECT($LENGTH(ORCEND):"E",1:"AE")
SET X=$SELECT($LENGTH(ORCEND):ORCEND,1:"")
+18 if '$LENGTH(ORCEND)
SET %DT("A")="Patient Appointment ENDING DATE: "
SET %DT("B")=Y
+19 DO ^%DT
+20 IF Y<0
SET OREND=1
QUIT
+21 SET ORCEND=$PIECE(Y,".")_.5
+22 IF ORCEND<ORCSTRT
SET ORCTMP=ORCEND
SET ORCEND=ORCSTRT
SET ORCSTRT=ORCTMP
KILL ORCTMP
+23 WRITE !,"Working..."
+24 DO PREF^ORLP0
+25 SET ORJ=ORCSTRT
+26 NEW ORI,ORERR
+27 KILL ^TMP($JOB,"SDAMA202","GETPLIST")
+28 ;DBIA 3869
DO GETPLIST^SDAMA202(+ORCLIN,"1;4","",ORCSTRT,ORCEND)
+29 SET ORERR=$$CLINERR^ORQRY01
+30 IF $LENGTH(ORERR)
WRITE !,ORERR
SET ORY=-1
SET ORCNT=0
QUIT
+31 SET ORI=0
+32 ;DBIA 3869
FOR
SET ORI=$ORDER(^TMP($JOB,"SDAMA202","GETPLIST",ORI))
if ORI<1
QUIT
Begin DoDot:1
+33 SET ORJ=+$GET(^TMP($JOB,"SDAMA202","GETPLIST",ORI,1))
+34 SET ORVP=+$GET(^TMP($JOB,"SDAMA202","GETPLIST",ORI,4))_";DPT("
+35 IF ORJ
IF ORVP
SET ORX=""
DO PR1^ORLA1(ORVP,OROPREF)
End DoDot:1
+36 KILL ^TMP($JOB,"SDAMA202","GETPLIST")
+37 IF '$LENGTH($ORDER(^XUTL("OR",$JOB,"ORLP",0)))
WRITE *7,!,"No patients found!"
+38 QUIT
+39 ;
LOC ;Hospital Location Look-up For Clinics
+1 ; Copied from ORUTL and modified by PKS.
+2 NEW DIC,ORIA,ORRA
+3 SET DIC=44
SET DIC(0)="AEQM"
+4 ; Setting of DIC("S") modified by PKS:
+5 SET DIC("S")="I $D(X),$P(^SC(+Y,0),U,3)=""C"",$$ACTLOC^ORWU(+Y)=1"
+6 DO ^DIC
+7 IF Y<1
QUIT
+8 IF $DATA(^SC(+Y,"I"))
SET ORIA=+^("I")
SET ORRA=$PIECE(^("I"),U,2)
+9 IF $SELECT('$DATA(ORIA):0,'ORIA:0,ORIA>DT:0,ORRA'>DT&(ORRA):0,1:1)
WRITE $CHAR(7),!," This location has been inactivated.",!
KILL ORL
GOTO LOC
+10 QUIT
+11 ;
