- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORQPT.m
r613 r623 1 ORQPT ; SLC/MKB - Patient Selection ; 4/18/07 7:20am 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**52,82,85,215,243**;Dec 17, 1997;Build 242 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 Q 196 ; 197 OK(DATE) ; -- Patient is deceased; ok to continue? 198 N X,Y,DIR S DIR(0)="YA",DIR("B")="NO" 199 S DIR("A")="Do you wish to continue? " 200 W $C(7),!!,"This patient died "_$$FMTE^XLFDT(DATE)_"!" 201 D ^DIR 202 Q +Y 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
Note:
See TracChangeset
for help on using the changeset viewer.
