- 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 Jan 18, 2025@03:32:29 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 ;