- ORLA1 ; slc/dcm,cla - Order activity alerts ;3/10/05 15:10
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**11,82,215**;Dec 17, 1997
- ;
- ; DBIA 3869 GETPLIST^SDAMA202 ^TMP($J,"SDAMA202")
- ;
- BUILD ;
- D PARAM^ORU1
- K:$D(ORDEF) ^XUTL("OR",$J,"ORLP"),^("ORW"),^("ORU"),^("ORV")
- B1 ;
- D PREF
- I $D(ORDEF),ORDEF="P"!(ORDEF="T"),$D(^OR(100.21,+$G(ORPRIM),0)) S X=$P(^(0),"^")_" patient list",ORY=ORPRIM_"^"_$P(^(0),"^"),ORTITLE=$S($D(^XUTL("OR",$J,"ORLP",0)):$S('$P(^(0),"^",2):"PATIENT LIST",1:X),1:X),ORCOLW=40-($L(ORTITLE)\2) D P1 Q
- I $D(ORDEF),ORDEF="W",ORWARD,$D(^DIC(42,ORWARD,0)) S X=$P(^(0),"^")_" ward list",ORY=ORWARD_"^"_$P(^(0),"^"),ORTITLE=$S($D(^XUTL("OR",$J,"ORLP",0)):$S('$P(^(0),"^",2):"PATIENT LIST",1:X),1:X),ORCOLW=40-($L(ORTITLE)\2) D W1 Q
- I $D(ORDEF),ORDEF="C",ORCLIN,$D(^SC(ORCLIN,0)) S X=$P(^(0),"^")_" clinic list",ORY=ORCLIN_"^"_$P(^(0),"^"),ORTITLE=$S($D(^XUTL("OR",$J,"ORLP",0)):$S('$P(^(0),"^",2):"PATIENT LIST",1:X),1:X),ORCOLW=40-($L(ORTITLE)\2) D C0 Q
- I $D(ORDEF),ORDEF="V",ORPROV,$D(^VA(200,ORPROV,0)) S X=$P(^(0),"^")_" patient list",ORY=ORPROV_"^"_$P(^(0),"^"),ORTITLE=$S($D(^XUTL("OR",$J,"ORLP",0)):$S('$P(^(0),"^",2):"PATIENT LIST",1:X),1:X),ORCOLW=40-($L(ORTITLE)\2) D V1^ORLA11 Q
- I $D(ORDEF),ORDEF="S",ORSPEC,$D(^DIC(45.7,ORSPEC,0)) S X=$P(^(0),"^")_" specialty list",ORY=ORSPEC_"^"_$P(^(0),"^"),ORTITLE=$S($D(^XUTL("OR",$J,"ORLP",0)):$S('$P(^(0),"^",2):"PATIENT LIST",1:X),1:X),ORCOLW=40-($L(ORTITLE)\2) D S1^ORLA11 Q
- Q
- P1 ; Loading the Primary Patient List
- S (ORCNT,J)=0
- F S J=$O(^OR(100.21,+ORY,10,J)) Q:J<1 S ORX=^(J,0),ORVP=$P(ORX,"^") D PR1(ORVP,OROPREF)
- D PR2(OROPREF,ORTITLE,ORDEF)
- K ORI,ORJ,ORURMBD,ORUVP,ORVP,ORX,ORY
- Q
- W1 ;
- W !,"Loading Ward Patient List..."
- S (ORCNT,ORJ)=0
- F S ORJ=$O(^DPT("CN",$P(ORY,"^",2),ORJ)) Q:ORJ<1 S ORX="",ORVP=ORJ_";DPT(" D PR1(ORVP,OROPREF)
- D PR2(OROPREF,ORTITLE,ORDEF)
- K ORI,ORJ,ORURMBD,ORUVP,ORVP,ORX,ORY
- Q
- C0 ; DBIA 3869
- ; SLC/PKS - 5/15/2000: Next line added to fix a reported problem:
- N %DT,ORI,ORERR
- 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 !,"Loading Clinic Patient List..."
- K ^TMP($J,"SDAMA202","GETPLIST")
- S ORCNT=0
- D GETPLIST^SDAMA202(+ORCLIN,"1;4","",ORCSTRT,ORCEND) ;DBIA 3869
- S ORERR=$$CLINERR^ORQRY01
- I $L(ORERR) W !,ORERR Q
- S ORI=0
- F S ORI=$O(^TMP($J,"SDAMA202","GETPLIST",ORI)) Q:ORI<1 D ;DBIA 3869
- . S ORCLDT=+$G(^TMP($J,"SDAMA202","GETPLIST",ORI,1))
- . S DFN=+$G(^TMP($J,"SDAMA202","GETPLIST",ORI,4))
- . I DFN,ORCLDT S ORX="" D C1
- K ORCLDT,ORI,ORURMBD,ORUVP,ORVP,ORX,ORY
- K ^TMP($J,"SDAMA202","GETPLIST")
- I '$L($O(^XUTL("OR",$J,"ORLP",0))) W $C(7),!,"No patients found" D READ^ORUTL Q
- H 1
- Q
- END ;
- G END^ORLA11
- Q
- C1 ;
- S ORVP=DFN_";DPT("
- D PR1(ORVP,OROPREF,ORCLDT)
- I '$D(^XUTL("OR",$J,"ORLP",ORUVP)),$D(^DPT(DFN,0)) S ORCNT=ORCNT+1,ORUPNM=$P(^(0),"^"),ORUSSN=$P(^(0),"^",9) S ^XUTL("OR",$J,"ORLP",ORUVP,0)=ORUPNM_"^"_ORUSSN_"^"_ORVP
- D PR2(OROPREF,ORTITLE,ORDEF)
- Q
- PR1(ORVP,OROPREF,ORCLDT) ;from ORLA11
- Q:'$G(ORVP)
- I '$D(^DPT(+ORVP)) W !,"Data inconsistency found, no entry for DFN="_+ORVP Q
- S ORUVP=+ORVP
- Q:$D(^XUTL("OR",$J,"ORLP",ORUVP))
- N DFN,RB,VAIN,VADM,X
- S ORCNT=ORCNT+1
- S DFN=ORUVP,X=$G(^DPT(ORUVP,0)),ORUPNM=$P(X,U),ORUSSN=$P(X,U,9)
- D INP^VADPT
- S ORURMBD=VAIN(5)
- I ORURMBD']"" S ORURMBD="~"
- S ORUPNM=$S($L(ORUPNM)'>15:ORUPNM,1:$$NAME^ORU(ORUPNM,"LAST, FI MI"))
- S:$L(ORUPNM)<16 ORUPNM=ORUPNM_$E(" ",$L(ORUPNM),16)
- S RB=ORURMBD,ORURMBD=ORURMBD_$E(" ",$L(ORURMBD),8)
- S ^XUTL("OR",$J,"ORLP",ORUVP,0)=ORUPNM_"^"_ORUSSN_"^"_ORVP_"^"_$P(ORX,"^",2)_"^"_ORURMBD
- I $D(ORCLDT),ORCLDT S X=ORCLDT D LTIM S ^(0)=^(0)_"^"_X
- S ^XUTL("OR",$J,"ORLP","B",ORUPNM,ORUVP)=""
- S:$D(ORCT) ORCT=ORCT+1
- D KVAR^VADPT
- ; terminal digit x-ref
- I OROPREF="T" S S=ORUSSN,S="A"_$E(S,8,9)_$E(S,6,7)_$E(S,1,5)_$E(S,10,11),^XUTL("OR",$J,"ORLP","C",S,ORUVP)="" K S Q
- ; room bed x-ref
- I OROPREF="R" S ^XUTL("OR",$J,"ORLP","D",RB,ORUVP)="" Q
- ; clinic date x-ref
- I $G(ORCLDT) S ^XUTL("OR",$J,"ORLP","D",ORCLDT,ORUVP)=""
- Q
- PR2(OROPREF,ORTITLE,ORDEF) ;
- S:$L($O(^XUTL("OR",$J,"ORLP",0))) ^(0)=$S($L($G(ORTITLE)):ORTITLE,1:"Current PATIENT List")_"^1^"_$S(OROPREF="T":"C",OROPREF="R":"D",OROPREF="C"&($G(ORDEF)="C"):"D",1:"B")_"^"_ORCNT
- Q
- LTIM ;
- Q:'$L(X)
- S X=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)_$S(X[".":" "_$E(X_"0",9,10)_":"_$E(X_"000",11,12),1:"")
- Q
- KIL ;
- Q:'$D(^XUTL("OR",$J,"ORLP"))
- W !,"The current patient list will be cleared."
- K ^XUTL("OR",$J,"ORLP"),^("ORV"),^("ORU"),^("ORW")
- Q
- PREF ;Get a preference
- N ORSRV
- S ORSRV=$P($G(^VA(200,DUZ,5)),"^"),OROPREF=$$GET^XPAR("USR^SRV.`"_$G(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT LIST ORDER",1,"I")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORLA1 5183 printed Jan 18, 2025@03:32:25 Page 2
- ORLA1 ; slc/dcm,cla - Order activity alerts ;3/10/05 15:10
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**11,82,215**;Dec 17, 1997
- +2 ;
- +3 ; DBIA 3869 GETPLIST^SDAMA202 ^TMP($J,"SDAMA202")
- +4 ;
- BUILD ;
- +1 DO PARAM^ORU1
- +2 if $DATA(ORDEF)
- KILL ^XUTL("OR",$JOB,"ORLP"),^("ORW"),^("ORU"),^("ORV")
- B1 ;
- +1 DO PREF
- +2 IF $DATA(ORDEF)
- IF ORDEF="P"!(ORDEF="T")
- IF $DATA(^OR(100.21,+$GET(ORPRIM),0))
- SET X=$PIECE(^(0),"^")_" patient list"
- SET ORY=ORPRIM_"^"_$PIECE(^(0),"^")
- SET ORTITLE=$SELECT($DATA(^XUTL("OR",$JOB,"ORLP",0)):$SELECT('$PIECE(^(0),"^",2):"PATIENT LIST",1:X),1:X)
- SET ORCOLW=40-($LENGTH(ORTITLE)\2)
- DO P1
- QUIT
- +3 IF $DATA(ORDEF)
- IF ORDEF="W"
- IF ORWARD
- IF $DATA(^DIC(42,ORWARD,0))
- SET X=$PIECE(^(0),"^")_" ward list"
- SET ORY=ORWARD_"^"_$PIECE(^(0),"^")
- SET ORTITLE=$SELECT($DATA(^XUTL("OR",$JOB,"ORLP",0)):$SELECT('$PIECE(^(0),"^",2):"PATIENT LIST",1:X),1:X)
- SET ORCOLW=40-($LENGTH(ORTITLE)\2)
- DO W1
- QUIT
- +4 IF $DATA(ORDEF)
- IF ORDEF="C"
- IF ORCLIN
- IF $DATA(^SC(ORCLIN,0))
- SET X=$PIECE(^(0),"^")_" clinic list"
- SET ORY=ORCLIN_"^"_$PIECE(^(0),"^")
- SET ORTITLE=$SELECT($DATA(^XUTL("OR",$JOB,"ORLP",0)):$SELECT('$PIECE(^(0),"^",2):"PATIENT LIST",1:X),1:X)
- SET ORCOLW=40-($LENGTH(ORTITLE)\2)
- DO C0
- QUIT
- +5 IF $DATA(ORDEF)
- IF ORDEF="V"
- IF ORPROV
- IF $DATA(^VA(200,ORPROV,0))
- SET X=$PIECE(^(0),"^")_" patient list"
- SET ORY=ORPROV_"^"_$PIECE(^(0),"^")
- SET ORTITLE=$SELECT($DATA(^XUTL("OR",$JOB,"ORLP",0)):$SELECT('$PIECE(^(0),"^",2):"PATIENT LIST",1:X),1:X)
- SET ORCOLW=40-($LENGTH(ORTITLE)\2)
- DO V1^ORLA11
- QUIT
- +6 IF $DATA(ORDEF)
- IF ORDEF="S"
- IF ORSPEC
- IF $DATA(^DIC(45.7,ORSPEC,0))
- SET X=$PIECE(^(0),"^")_" specialty list"
- SET ORY=ORSPEC_"^"_$PIECE(^(0),"^")
- SET ORTITLE=$SELECT($DATA(^XUTL("OR",$JOB,"ORLP",0)):$SELECT('$PIECE(^(0),"^",2):"PATIENT LIST",1:X),1:X)
- SET ORCOLW=40-($LENGTH(ORTITLE)\2)
- DO S1^ORLA11
- QUIT
- +7 QUIT
- P1 ; Loading the Primary Patient List
- +1 SET (ORCNT,J)=0
- +2 FOR
- SET J=$ORDER(^OR(100.21,+ORY,10,J))
- if J<1
- QUIT
- SET ORX=^(J,0)
- SET ORVP=$PIECE(ORX,"^")
- DO PR1(ORVP,OROPREF)
- +3 DO PR2(OROPREF,ORTITLE,ORDEF)
- +4 KILL ORI,ORJ,ORURMBD,ORUVP,ORVP,ORX,ORY
- +5 QUIT
- W1 ;
- +1 WRITE !,"Loading Ward Patient List..."
- +2 SET (ORCNT,ORJ)=0
- +3 FOR
- SET ORJ=$ORDER(^DPT("CN",$PIECE(ORY,"^",2),ORJ))
- if ORJ<1
- QUIT
- SET ORX=""
- SET ORVP=ORJ_";DPT("
- DO PR1(ORVP,OROPREF)
- +4 DO PR2(OROPREF,ORTITLE,ORDEF)
- +5 KILL ORI,ORJ,ORURMBD,ORUVP,ORVP,ORX,ORY
- +6 QUIT
- C0 ; DBIA 3869
- +1 ; SLC/PKS - 5/15/2000: Next line added to fix a reported problem:
- +2 NEW %DT,ORI,ORERR
- +3 if $LENGTH(ORCSTRT)
- WRITE !,"Starting date: "
- +4 SET %DT=$SELECT($LENGTH(ORCSTRT):"E",1:"AE")
- SET X=$SELECT($LENGTH(ORCSTRT):ORCSTRT,1:"")
- +5 if '$LENGTH(ORCSTRT)
- SET %DT("A")="Patient Appointment STARTING DATE: "
- SET %DT("B")="T"
- +6 DO ^%DT
- +7 IF Y<0
- SET OREND=1
- QUIT
- +8 SET ORCSTRT=Y
- +9 DO DD^%DT
- +10 if $LENGTH(ORCEND)
- WRITE !,"Ending date: "
- +11 SET %DT=$SELECT($LENGTH(ORCEND):"E",1:"AE")
- SET X=$SELECT($LENGTH(ORCEND):ORCEND,1:"")
- +12 if '$LENGTH(ORCEND)
- SET %DT("A")="Patient Appointment ENDING DATE: "
- SET %DT("B")=Y
- +13 DO ^%DT
- +14 IF Y<0
- SET OREND=1
- QUIT
- +15 SET ORCEND=$PIECE(Y,".")_.5
- +16 IF ORCEND<ORCSTRT
- SET ORCTMP=ORCEND
- SET ORCEND=ORCSTRT
- SET ORCSTRT=ORCTMP
- KILL ORCTMP
- +17 WRITE !,"Loading Clinic Patient List..."
- +18 KILL ^TMP($JOB,"SDAMA202","GETPLIST")
- +19 SET ORCNT=0
- +20 ;DBIA 3869
- DO GETPLIST^SDAMA202(+ORCLIN,"1;4","",ORCSTRT,ORCEND)
- +21 SET ORERR=$$CLINERR^ORQRY01
- +22 IF $LENGTH(ORERR)
- WRITE !,ORERR
- QUIT
- +23 SET ORI=0
- +24 ;DBIA 3869
- FOR
- SET ORI=$ORDER(^TMP($JOB,"SDAMA202","GETPLIST",ORI))
- if ORI<1
- QUIT
- Begin DoDot:1
- +25 SET ORCLDT=+$GET(^TMP($JOB,"SDAMA202","GETPLIST",ORI,1))
- +26 SET DFN=+$GET(^TMP($JOB,"SDAMA202","GETPLIST",ORI,4))
- +27 IF DFN
- IF ORCLDT
- SET ORX=""
- DO C1
- End DoDot:1
- +28 KILL ORCLDT,ORI,ORURMBD,ORUVP,ORVP,ORX,ORY
- +29 KILL ^TMP($JOB,"SDAMA202","GETPLIST")
- +30 IF '$LENGTH($ORDER(^XUTL("OR",$JOB,"ORLP",0)))
- WRITE $CHAR(7),!,"No patients found"
- DO READ^ORUTL
- QUIT
- +31 HANG 1
- +32 QUIT
- END ;
- +1 GOTO END^ORLA11
- +2 QUIT
- C1 ;
- +1 SET ORVP=DFN_";DPT("
- +2 DO PR1(ORVP,OROPREF,ORCLDT)
- +3 IF '$DATA(^XUTL("OR",$JOB,"ORLP",ORUVP))
- IF $DATA(^DPT(DFN,0))
- SET ORCNT=ORCNT+1
- SET ORUPNM=$PIECE(^(0),"^")
- SET ORUSSN=$PIECE(^(0),"^",9)
- SET ^XUTL("OR",$JOB,"ORLP",ORUVP,0)=ORUPNM_"^"_ORUSSN_"^"_ORVP
- +4 DO PR2(OROPREF,ORTITLE,ORDEF)
- +5 QUIT
- PR1(ORVP,OROPREF,ORCLDT) ;from ORLA11
- +1 if '$GET(ORVP)
- QUIT
- +2 IF '$DATA(^DPT(+ORVP))
- WRITE !,"Data inconsistency found, no entry for DFN="_+ORVP
- QUIT
- +3 SET ORUVP=+ORVP
- +4 if $DATA(^XUTL("OR",$JOB,"ORLP",ORUVP))
- QUIT
- +5 NEW DFN,RB,VAIN,VADM,X
- +6 SET ORCNT=ORCNT+1
- +7 SET DFN=ORUVP
- SET X=$GET(^DPT(ORUVP,0))
- SET ORUPNM=$PIECE(X,U)
- SET ORUSSN=$PIECE(X,U,9)
- +8 DO INP^VADPT
- +9 SET ORURMBD=VAIN(5)
- +10 IF ORURMBD']""
- SET ORURMBD="~"
- +11 SET ORUPNM=$SELECT($LENGTH(ORUPNM)'>15:ORUPNM,1:$$NAME^ORU(ORUPNM,"LAST, FI MI"))
- +12 if $LENGTH(ORUPNM)<16
- SET ORUPNM=ORUPNM_$EXTRACT(" ",$LENGTH(ORUPNM),16)
- +13 SET RB=ORURMBD
- SET ORURMBD=ORURMBD_$EXTRACT(" ",$LENGTH(ORURMBD),8)
- +14 SET ^XUTL("OR",$JOB,"ORLP",ORUVP,0)=ORUPNM_"^"_ORUSSN_"^"_ORVP_"^"_$PIECE(ORX,"^",2)_"^"_ORURMBD
- +15 IF $DATA(ORCLDT)
- IF ORCLDT
- SET X=ORCLDT
- DO LTIM
- SET ^(0)=^(0)_"^"_X
- +16 SET ^XUTL("OR",$JOB,"ORLP","B",ORUPNM,ORUVP)=""
- +17 if $DATA(ORCT)
- SET ORCT=ORCT+1
- +18 DO KVAR^VADPT
- +19 ; terminal digit x-ref
- +20 IF OROPREF="T"
- SET S=ORUSSN
- SET S="A"_$EXTRACT(S,8,9)_$EXTRACT(S,6,7)_$EXTRACT(S,1,5)_$EXTRACT(S,10,11)
- SET ^XUTL("OR",$JOB,"ORLP","C",S,ORUVP)=""
- KILL S
- QUIT
- +21 ; room bed x-ref
- +22 IF OROPREF="R"
- SET ^XUTL("OR",$JOB,"ORLP","D",RB,ORUVP)=""
- QUIT
- +23 ; clinic date x-ref
- +24 IF $GET(ORCLDT)
- SET ^XUTL("OR",$JOB,"ORLP","D",ORCLDT,ORUVP)=""
- +25 QUIT
- PR2(OROPREF,ORTITLE,ORDEF) ;
- +1 if $LENGTH($ORDER(^XUTL("OR",$JOB,"ORLP",0)))
- SET ^(0)=$SELECT($LENGTH($GET(ORTITLE)):ORTITLE,1:"Current PATIENT List")_"^1^"_$SELECT(OROPREF="T":"C",OROPREF="R":"D",OROPREF="C"&($GET(ORDEF)="C"):"D",1:"B")_"^"_ORCNT
- +2 QUIT
- LTIM ;
- +1 if '$LENGTH(X)
- QUIT
- +2 SET X=$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)_$SELECT(X[".":" "_$EXTRACT(X_"0",9,10)_":"_$EXTRACT(X_"000",11,12),1:"")
- +3 QUIT
- KIL ;
- +1 if '$DATA(^XUTL("OR",$JOB,"ORLP"))
- QUIT
- +2 WRITE !,"The current patient list will be cleared."
- +3 KILL ^XUTL("OR",$JOB,"ORLP"),^("ORV"),^("ORU"),^("ORW")
- +4 QUIT
- PREF ;Get a preference
- +1 NEW ORSRV
- +2 SET ORSRV=$PIECE($GET(^VA(200,DUZ,5)),"^")
- SET OROPREF=$$GET^XPAR("USR^SRV.`"_$GET(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT LIST ORDER",1,"I")
- +3 QUIT