| [623] | 1 | ORQPT ; SLC/MKB - Patient Selection ;3/16/05 08:28
|
|---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**52,82,85,215**;Dec 17, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | ; Ref. to ^UTILITY via IA 10061
|
|---|
| 5 | ; SLC/PKS - 3/2000: Modified to deal with "Combinations."
|
|---|
| 6 | ;
|
|---|
| 7 | EN ; -- main entry point for OR PATIENT SELECTION
|
|---|
| 8 | I $G(ORVP),'($D(ORPNM)&$D(ORSSN)) K ORVP ; reset
|
|---|
| 9 | D EN^VALM("OR PATIENT SELECTION")
|
|---|
| 10 | Q
|
|---|
| 11 | ;
|
|---|
| 12 | HDR ; -- header code
|
|---|
| 13 | N X I '$G(ORVP) S X="** No patient selected **"
|
|---|
| 14 | E S X=$G(ORPNM)_" "_$G(ORSSN)
|
|---|
| 15 | S VALMHDR(1)="Current patient: "_X
|
|---|
| 16 | Q
|
|---|
| 17 | ;
|
|---|
| 18 | INIT ; -- init variables and list array
|
|---|
| 19 | ; Modifications for multiple "Combination" lists by PKS.
|
|---|
| 20 | ;
|
|---|
| 21 | ; PARAM herein might end up as: ORLP DEFAULT CLINIC WEDNESDAY
|
|---|
| 22 | ; (Param Name and current DOW)
|
|---|
| 23 | ; ORY might end up passed as: 5^5^C;1;T-360;T+60;A
|
|---|
| 24 | ; (#lines^#pts^source;serviceSection;startDate;stopDate;sort)
|
|---|
| 25 | ;
|
|---|
| 26 | N ORY,ORX,PARAM,ORYZB,ORYZE
|
|---|
| 27 | ;
|
|---|
| 28 | ;added by CLA 12/12/96 - gets SERVICE/SECTION of user:
|
|---|
| 29 | N ORSRV S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
|
|---|
| 30 | ;
|
|---|
| 31 | S ORY=$$GET^XPAR("USR^SRV.`"_$G(ORSRV),"ORLP DEFAULT LIST SOURCE",1,"I") ; Gets default list source for this user.
|
|---|
| 32 | I $L(ORY) D S ORY=ORY_";"_ORX
|
|---|
| 33 | . ; PKS: Set "PARAM" var to parameter name in param def file:
|
|---|
| 34 | . S PARAM="ORLP DEFAULT "_$S(ORY="T":"TEAM",ORY="S":"SPECIALTY",ORY="P":"PROVIDER",ORY="W":"WARD",ORY="C":"CLINIC",ORY="M":"COMBINATION",1:"")
|
|---|
| 35 | . S:ORY="C" PARAM=PARAM_" "_$$UP^XLFSTR($$DOW^XLFDT(DT)) ; For clinics, add current DOW.
|
|---|
| 36 | . S ORX=$$GET^XPAR("USR^SRV.`"_$G(ORSRV),PARAM,1,"I") ; Source param.
|
|---|
| 37 | . ; Next lines modified by PKS for "Combinations" and dates:
|
|---|
| 38 | . I (ORY="C")!(ORY="M") D
|
|---|
| 39 | . . S ORYZB=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_$G(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC START DATE",1,"I")) ; Gets clinic start date.
|
|---|
| 40 | . . I ORYZB="T+0" S ORYZB=$$FMTE^XLFDT(DT,ORYZB)
|
|---|
| 41 | . . S ORX=ORX_";"_ORYZB
|
|---|
| 42 | . . S ORYZE=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_$G(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT CLINIC STOP DATE",1,"I")) ; Add ";" & stop date.
|
|---|
| 43 | . . I ORYZE="T+0" S ORYZE=$$FMTE^XLFDT(DT,ORYZE)
|
|---|
| 44 | . . S ORX=ORX_";"_ORYZE
|
|---|
| 45 | S $P(ORY,";",5)=$$GET^XPAR("USR^SRV.`"_$G(ORSRV)_"^DIV^SYS^PKG","ORLP DEFAULT LIST ORDER",1,"I") ; Add default sort order.
|
|---|
| 46 | ;
|
|---|
| 47 | ; Call tag that builds the actual Patient Selection List:
|
|---|
| 48 | D BUILD(ORY)
|
|---|
| 49 | Q
|
|---|
| 50 | ;
|
|---|
| 51 | DEFAULT() ; -- Returns default action
|
|---|
| 52 | I '$P($G(^TMP("OR",$J,"PATIENTS",0)),U,2) Q "Change View"
|
|---|
| 53 | I XQORM("B")="Quit" Q "Close"
|
|---|
| 54 | Q "Next Screen"
|
|---|
| 55 | ;
|
|---|
| 56 | MSG() ; -- Lmgr msg bar
|
|---|
| 57 | Q "Enter the number of the patient chart to be opened"
|
|---|
| 58 | ;
|
|---|
| 59 | HELP ; -- help code
|
|---|
| 60 | N X D FULL^VALM1 S VALMBCK="R"
|
|---|
| 61 | W !!,"Enter the display number of the patient whose chart you wish to open"
|
|---|
| 62 | W !,"or enter a patient name, SSN, or initial/last 4 combination. To"
|
|---|
| 63 | W !,"change the list of patients displayed on this screen, enter CV. To"
|
|---|
| 64 | W !,"have the new list automatically displayed when selecting a new patient,"
|
|---|
| 65 | W !,"enter SV. Enter FD to search by patient name or identifier."
|
|---|
| 66 | W !!,"Press <return> to continue ..." R X:DTIME
|
|---|
| 67 | Q
|
|---|
| 68 | ;
|
|---|
| 69 | EXIT ; -- exit code
|
|---|
| 70 | K ^TMP("OR",$J,"PATIENTS"),XQORM("ALT")
|
|---|
| 71 | Q
|
|---|
| 72 | ;
|
|---|
| 73 | BUILD(LIST) ; -- build list in ^TMP("OR",$J,"PATIENTS")
|
|---|
| 74 | N ORI,ORX,ORY,LCNT,NUM,DFN,NAME,TYPE,PTR,BEG,END,SORT,DOB,RBED,%DT,X,Y,TITLE,PTID,SENS
|
|---|
| 75 | S TYPE=$E(LIST),PTR=+$P(LIST,";",2),SORT=$P(LIST,";",5)
|
|---|
| 76 | ; Next 5 lines added by PKS:
|
|---|
| 77 | I ((SORT="S")&(TYPE'="M")) S SORT="A" ; Reset invalid sorts.
|
|---|
| 78 | I TYPE="M" D ; Deal with combinations.
|
|---|
| 79 | .I ((SORT="P")!(SORT="A")!(SORT="S")) Q ; P,A,S are acceptable.
|
|---|
| 80 | .S SORT="A" ; Default.
|
|---|
| 81 | S $P(LIST,";",5)=SORT ; Reset in case of change.
|
|---|
| 82 | S BEG=$P(LIST,";",3) I $L(BEG) S X=BEG,%DT="X" D ^%DT S BEG=Y
|
|---|
| 83 | S END=$P(LIST,";",4) I $L(END) S X=END,%DT="X" D ^%DT S END=Y
|
|---|
| 84 | I TYPE="T" D TEAMPTS^ORQPTQ1(.ORY,PTR) S TITLE="Team "_$P($G(^OR(100.21,+PTR,0)),U)
|
|---|
| 85 | I TYPE="P" D PROVPTS^ORQPTQ2(.ORY,PTR) S TITLE="Provider "_$P($G(^VA(200,+PTR,0)),U)
|
|---|
| 86 | I TYPE="S" D SPECPTS^ORQPTQ2(.ORY,PTR) S TITLE="Specialty "_$P($G(^DIC(45.7,+PTR,0)),U)
|
|---|
| 87 | I TYPE="W" D WARDPTS^ORQPTQ2(.ORY,PTR) S TITLE="Ward "_$P($G(^DIC(42,+PTR,0)),U)
|
|---|
| 88 | I TYPE="C" D CLINPTS^ORQPTQ2(.ORY,PTR,BEG,END) S TITLE="Clinic "_$P($G(^SC(+PTR,0)),U)
|
|---|
| 89 | ; Next line added by PKS for "Combinations:"
|
|---|
| 90 | I TYPE="M" N MSG D COMBPTS^ORQPTQ6(1,PTR,BEG,END) S TITLE="Combination List" ; Sets MSG,LCNT,NUM, and writes ^TMP("OR",$J,"PATIENTS").
|
|---|
| 91 | ; Next section added by PKS for "Combinations:"
|
|---|
| 92 | I TYPE="M" D G BQ ; Check MSG var, then go to BQ tag.
|
|---|
| 93 | .I MSG'="" D ; Did call to COMBPTS assign an error message?
|
|---|
| 94 | ..S LCNT=1,NUM=0 ; Set defaults.
|
|---|
| 95 | ..S ^TMP("OR",$J,"PATIENTS",1,0)=" "_MSG ; Write error msg.
|
|---|
| 96 | D CLEAN^VALM10 S (LCNT,NUM)=0 ; All but "M" types reset, go on to B1.
|
|---|
| 97 | ;
|
|---|
| 98 | B1 S ORI=0 F S ORI=$O(ORY(ORI)) Q:ORI'>0 I ORY(ORI) D ; sort
|
|---|
| 99 | . S DFN=+ORY(ORI)
|
|---|
| 100 | . ;sort logic added by CLA 7/23/97:
|
|---|
| 101 | . S ORX=""
|
|---|
| 102 | . I SORT="P",(TYPE="C") S ORX=$P($G(ORY(ORI)),U,4) D
|
|---|
| 103 | .. S $P(ORX,".",2)=$E($P(ORX,".",2)_"000",1,4)
|
|---|
| 104 | ..S ORX=ORX_U_$P(ORY(ORI),U,2)
|
|---|
| 105 | . I SORT="R",(TYPE'="C") S ORX=$P($G(^DPT(+ORY(ORI),.101)),U)_U_$P(ORY(ORI),U,2)
|
|---|
| 106 | . I SORT="T" S ORX="" ; Need to add terminal digit sorting.
|
|---|
| 107 | . ; If no sort specified, default to alphabetic (plus app't if clinic type):
|
|---|
| 108 | . I ORX="" S ORX=$P(ORY(ORI),U,2)_U_$P($G(ORY(ORI)),U,4)
|
|---|
| 109 | . S ^TMP("OR",$J,"PATIENTS","B",ORX_DFN)=ORY(ORI) ; DFN ^ Name
|
|---|
| 110 | I '$D(^TMP("OR",$J,"PATIENTS")) D G BQ
|
|---|
| 111 | . N MSG
|
|---|
| 112 | . S MSG="No patients found"
|
|---|
| 113 | . S LCNT=1,NUM=0
|
|---|
| 114 | . I $D(ORY(1)) S MSG=$P(ORY(1),"^",2) ; error message from search
|
|---|
| 115 | . S ^TMP("OR",$J,"PATIENTS",1,0)=" "_MSG
|
|---|
| 116 | B2 S ORX="" F S ORX=$O(^TMP("OR",$J,"PATIENTS","B",ORX)) Q:ORX="" S ORY=^(ORX) D
|
|---|
| 117 | . S DFN=+ORY,NAME=$P(ORY,U,2)
|
|---|
| 118 | . S DOB=$$FMTE^XLFDT($P($G(^DPT(DFN,0)),U,3))
|
|---|
| 119 | . S:(TYPE'="C") RBED=$P($G(^DPT(DFN,.101)),U)
|
|---|
| 120 | . I (TYPE="C") S RBED=$S(SORT="P":$$FMTE^XLFDT($P(ORX,U)),1:$$FMTE^XLFDT($P(^TMP("OR",$J,"PATIENTS","B",ORX),U,4)))
|
|---|
| 121 | . ;Q:RBED="" removed by CLA 7/23/97 to prevent blank lines
|
|---|
| 122 | . S LCNT=LCNT+1,NUM=NUM+1
|
|---|
| 123 | . S ^TMP("OR",$J,"PATIENTS","IDX",NUM)=ORY ; DFN ^ NAME
|
|---|
| 124 | . ; Next lines modified/added by PKS on 1/24/2001:
|
|---|
| 125 | . ; Check for "sensitive" patients:
|
|---|
| 126 | . S PTID=""
|
|---|
| 127 | . S PTID=$$ID(DFN)
|
|---|
| 128 | . S SENS=$$SSN^DPTLK1(DFN)
|
|---|
| 129 | . I SENS["*" S PTID=""
|
|---|
| 130 | . S DOB=$$DOB^DPTLK1(DFN)
|
|---|
| 131 | . S ^TMP("OR",$J,"PATIENTS",LCNT,0)=$$LJ^XLFSTR(NUM,5)_$$LJ^XLFSTR(NAME,31)_$$LJ^XLFSTR(PTID,10)_$$LJ^XLFSTR(DOB,15)_$G(RBED)
|
|---|
| 132 | . D CNTRL^VALM10(LCNT,1,5,IOINHI,IOINORM)
|
|---|
| 133 | BQ S ^TMP("OR",$J,"PATIENTS",0)=LCNT_U_NUM_U_$G(LIST) ; #lines^#pts^context
|
|---|
| 134 | S ^TMP("OR",$J,"PATIENTS","#")=$O(^ORD(101,"B","ORQPT SELECT PATIENT",0))_"^1:"_NUM
|
|---|
| 135 | S RBED=$S(TYPE="C":"Appointment Date",TYPE="M":"Source Other",1:"Room-Bed")
|
|---|
| 136 | D CHGCAP^VALM("ROOM-BED",RBED) K VALMHDR
|
|---|
| 137 | S VALMCNT=LCNT,VALMBG=1,VALMBCK="R" S:$L($G(TITLE)) VALM("TITLE")=TITLE
|
|---|
| 138 | Q
|
|---|
| 139 | ;
|
|---|
| 140 | ID(DFN) ; -- Returns short ID for patient ID
|
|---|
| 141 | N ID S ID=$P($G(^DPT(DFN,.36)),U,4) ; short ID
|
|---|
| 142 | I '$L(ID) S ID=$E($P($G(^DPT(DFN,0)),U,9),6,9) ; last 4 of SSN
|
|---|
| 143 | Q "("_$E(NAME)_ID_")"
|
|---|
| 144 | ;
|
|---|
| 145 | APPT(DFN,CLINIC,FROM,TO) ; -- Return [next?] clinic appointment
|
|---|
| 146 | ; returns date/time next appt or "", returns "^error message" on error
|
|---|
| 147 | N ERR,ERRMSG,VASD,VAERR K ^UTILITY("VASD",$J) ;IA 10061
|
|---|
| 148 | S VASD("F")=FROM,VASD("T")=TO,VASD("C",CLINIC)=""
|
|---|
| 149 | D SDA^ORQRY01(.ERR,.ERRMSG)
|
|---|
| 150 | I ERR K ^UTILITY("VASD",$J) Q ERRMSG
|
|---|
| 151 | S NEXT=+$O(^UTILITY("VASD",$J,0)),NEXT=$P($G(^(NEXT,"I")),U)
|
|---|
| 152 | K ^UTILITY("VASD",$J)
|
|---|
| 153 | Q NEXT
|
|---|
| 154 | ;
|
|---|
| 155 | ALT ; -- XQORM("ALT") code to search File 2 for patient X
|
|---|
| 156 | N DIC,DFN,Y,ORX S ORX=X D FULL^VALM1
|
|---|
| 157 | S DIC=2,DIC(0)="EQM",X=$S($D(XQORMRCL):" ",1:ORX)
|
|---|
| 158 | D ^DIC I Y'>0 S VALMBCK="R" Q ;S XQORMERR=1 Q
|
|---|
| 159 | S ORX=+$G(^DPT(+Y,.35)) I ORX,'$$OK(ORX) S VALMBCK="R" Q
|
|---|
| 160 | S DFN=+Y G:DFN'=+$G(ORVP) SLCT1 ; set patient variables
|
|---|
| 161 | Q
|
|---|
| 162 | ;
|
|---|
| 163 | FIND ; -- find patient in ^DPT
|
|---|
| 164 | N X,Y,DIC,ORX,DFN
|
|---|
| 165 | S DIC=2,DIC(0)="AEQM" D FULL^VALM1
|
|---|
| 166 | D ^DIC I Y'>0 S VALMBCK="R" Q
|
|---|
| 167 | S ORX=+$G(^DPT(+Y,.35)) I ORX,'$$OK(ORX) S VALMBCK="R" Q
|
|---|
| 168 | S DFN=+Y G:DFN'=+$G(ORVP) SLCT1 ; set patient variables
|
|---|
| 169 | Q
|
|---|
| 170 | ;
|
|---|
| 171 | SELECT ; -- select patient from list
|
|---|
| 172 | N NMBR,X,Y,Z,DIC,DFN,ORX S NMBR=+$P(XQORNOD(0),"=",2)
|
|---|
| 173 | S Y=$G(^TMP("OR",$J,"PATIENTS","IDX",NMBR)),DFN=+Y
|
|---|
| 174 | I 'DFN W $C(7),!!,NMBR_" is not a valid selection.",! S VALMBCK="" H 1 Q
|
|---|
| 175 | ;W " "_$P(Y,U,2) S ^DISV(DUZ,"^DPT(")=DFN
|
|---|
| 176 | D FULL^VALM1 S DIC=2,DIC(0)="EQM",X="`"_DFN D ^DIC I Y<0 S VALMBCK="R" Q
|
|---|
| 177 | S ORX=+$G(^DPT(+Y,.35)) I ORX,'$$OK(ORX) S VALMBCK="R" Q
|
|---|
| 178 | SLCT1 ; -- may enter here with DFN from FIND
|
|---|
| 179 | N VADM,VAEL,VAIN,VA,VAERR,LOC,ORCNV
|
|---|
| 180 | D OERR^VADPT,ELIG^VADPT
|
|---|
| 181 | S LOC=+$G(^DIC(42,+VAIN(4),44))_";SC(" I 'LOC,'$D(XQAID) D
|
|---|
| 182 | . I $G(NMBR) N X S X=$$CONTEXT^ORQPT1 I $E(X)="C" S LOC=$P(X,";",2)_";SC(" Q:LOC ; use clinic if selected from list, else ask
|
|---|
| 183 | . S LOC="" ;,X=$$LOCATION^ORCMENU1(1) S:X LOC=X
|
|---|
| 184 | S ORL=LOC,ORL(0)=$P($G(^SC(+ORL,0)),U),ORL(1)=VAIN(5)
|
|---|
| 185 | S ORVP=DFN_";DPT(",ORPNM=VADM(1),ORSSN=$P(VADM(2),U,2)
|
|---|
| 186 | S ORDOB=$P(VADM(3),U,2),ORAGE=VADM(4),ORSEX=$P(VADM(5),U)
|
|---|
| 187 | S ORTS=+VAIN(3),ORWARD=VAIN(4),ORATTEND=+VAIN(11),ORSC=$G(VAEL(3))
|
|---|
| 188 | I $P($G(^DGSL(38.1,+ORVP,0)),"^",2),($G(^DPT(+ORVP,.1))]""!$D(^XUSEC("DG SENSITIVITY",DUZ))) D
|
|---|
| 189 | . ; if senstive patient and (patient inpatient or user holds key)
|
|---|
| 190 | . ; prevents sensitive patient warning from scrolling off screen
|
|---|
| 191 | . N X
|
|---|
| 192 | . W !!,"Press <return> to continue ..."
|
|---|
| 193 | . R X:DTIME
|
|---|
| 194 | SLCT2 ; -- convert patient's orders, if not already done
|
|---|
| 195 | S ORCNV=$$OTF^OR3CONV(+ORVP) Q:'ORCNV I ORCNV>0 W !,"DONE" H 1 Q
|
|---|
| 196 | I ORCNV<0 W $C(7),!!,$P(ORCNV,U,2) H 2 S VALMBCK="R" Q
|
|---|
| 197 | Q
|
|---|
| 198 | ;
|
|---|
| 199 | OK(DATE) ; -- Patient is deceased; ok to continue?
|
|---|
| 200 | N X,Y,DIR S DIR(0)="YA",DIR("B")="NO"
|
|---|
| 201 | S DIR("A")="Do you wish to continue? "
|
|---|
| 202 | W $C(7),!!,"This patient died "_$$FMTE^XLFDT(DATE)_"!"
|
|---|
| 203 | D ^DIR
|
|---|
| 204 | Q +Y
|
|---|
