- 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/ORWPT16.m
r613 r623 1 ORWPT16 ; SLC/KCM - Patient Lookup Functions - 16bit ;7/20/96 15:43 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242 3 ; 4 IDINFO(ORY,DFN) ; Return identifying information for a patient 5 ; PID^DOB^AGE^SEX^SC%^TYPE^WARD^RM-BED^NAME 6 N OR0,OR36,OR1,OR101,VAEL,VAERR 7 S OR0=$G(^DPT(DFN,0)),OR36=$G(^(.36)),OR1=$G(^(.1)),OR101=$G(^(.101)) 8 D ELIG^VADPT 9 S ORY=$P(OR36,U,3)_U_$P(OR0,U,3)_U_U_$P(OR0,U,2) 10 S ORY=ORY_U_$P(VAEL(3),U,2)_U_$P(VAEL(6),U,2)_U_$P(OR1,U)_U_$P(OR101,U) 11 I $P(OR0,U,3) S $P(ORY,U,3)=DT-$P(OR0,U,3)\10000 12 I '$L($P(ORY,U,1)) D 13 . S X=$P(OR0,U,9),$P(ORY,U,1)=$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,99) 14 S $P(ORY,U,9)=$P(OR0,U,1) 15 Q 16 DEMOG(VAL,DFN) ; procedure 17 ; Return common patient demographic info 18 ; NAME^SEX^DOB^SSN^WARDID^WARDNAME^RMBED^ADMITTIME^DIED ;^SC%^ELIGTYPE 19 S X=^DPT(DFN,0),VAL=$P(X,U,1,3)_U_$P(X,U,9)_U_U_$G(^(.1))_U_$G(^(.101)) 20 S X=$P(VAL,U,6) I $L(X) S $P(VAL,U,5)=$O(^SC("B",X,0)) 21 S X=$G(^DPT(DFN,.105)) I X S $P(VAL,U,8)=$P(^DGPM(X,0),U,1) 22 I $L($P($G(^DPT(DFN,.35)),U,1)) S $P(VAL,U,9)=$P(^(.35),U,1) 23 Q 24 PSCNVT(VAL,DFN) ; procedure 25 ; Call conversion routine for pharmacy (both inpatient and outpatient) 26 S VAL=0 27 Q 28 LISTALL(Y,DIR,FROM) ; Return a bolus of patient names 29 N I,IEN,CNT S CNT=44,I=0 30 ; 31 I DIR=0 D ; Forward direction 32 . F S FROM=$O(^DPT("B",FROM)) Q:FROM="" D Q:I=CNT 33 . . S IEN=0 F S IEN=$O(^DPT("B",FROM,IEN)) Q:'IEN D Q:I=CNT 34 . . . ; S X=$P($G(^DPT(IEN,0)),"^",9) 35 . . . ; S X=$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,99) 36 . . . ; S X1=$G(^DPT(IEN,.1))_" "_$G(^DPT(IEN,.101)) 37 . . . S I=I+1 S Y(I)=IEN_"^"_FROM ;_"^"_X ; _"^"_X1 ;" ("_X_")" 38 . I $G(Y(CNT))="" S I=I+1,Y(I)="" 39 ; 40 I DIR=1 D ; Reverse direction 41 . F S FROM=$O(^DPT("B",FROM),-1) Q:FROM="" D Q:I=CNT 42 . . S IEN=0 F S IEN=$O(^DPT("B",FROM,IEN)) Q:'IEN D Q:I=CNT 43 . . . ; S X=$P($G(^DPT(IEN,0)),"^",9) 44 . . . ; S X=$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,99) 45 . . . ; S X1=$G(^DPT(IEN,.1))_" "_$G(^DPT(IEN,.101)) 46 . . . S I=I+1 S Y(I)=IEN_"^"_FROM ;_"^"_X ; _"^"_X1 ;" ("_X_")" 47 Q 48 LOOKUP(Y,FROM) ; Return a set of patient names 49 N I,X 50 D FIND^DIC(2,"","","M",FROM) 51 S I=0,Y="" 52 F S I=$O(^TMP("DILIST",$J,1,I)) Q:'I D 53 . S X=^TMP("DILIST",$J,"ID",I,.09) 54 . S X=$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,99) 55 . S Y(I)=^TMP("DILIST",$J,2,I)_"^"_^TMP("DILIST",$J,1,I)_"^"_X 56 K ^TMP("DILIST",$J) 57 Q 58 GETVSIT(Y,DFN,LOC,ADATE) ; procedure 59 ; Return a visit given a patient, location, and date/time 60 N VSIT,VSITPKG 61 S (VSIT,VSIT("VDT"))=ADATE,VSIT("PAT")=DFN,VSIT("LOC")=LOC 62 S VSIT("SVC")="A",VSIT("PRI")="P",VSIT(0)="NMD1",VSITPKG="OR" 63 D ^VSIT 64 S Y=VSIT("IEN") I +VSIT("IEN")'>0 S Y="" Q 65 I +VSIT("LOC") S Y=Y_U_VSIT("LOC")_U_$P(^SC(+VSIT("LOC"),0),U,1,2) 66 Q 67 APPTLST(LST,DFN) ; procedure 68 ; Return a list of appointments 69 N I,ILST S ILST=0 70 D GETAPPT^TIUVSIT(DFN) 71 S I=0 F S I=$O(^TMP("TIUVNI",$J,I)) Q:'I D 72 . S ILST=ILST+1 73 . S LST(ILST)=$P(^TMP("TIUVNI",$J,I),U,1,2)_U_$P(^TMP("TIUVN",$J,I),U,1,2) 74 K ^TMP("TIUVN",$J),^TMP("TIUVNI",$J) 75 Q 76 ADMITLST(LST,DFN) ; procedure 77 ; Return a list of admissions 78 N TIM,MOV,X0,Y,MTIM,XTIM,XTYP,XLOC,HLOC,ILST S ILST=0 79 S TIM="" F S TIM=$O(^DGPM("ATID1",DFN,TIM)) Q:TIM'>0 D 80 . S MOV=0 F S MOV=$O(^DGPM("ATID1",DFN,TIM,MOV)) Q:MOV'>0 D 81 . . S X0=^DGPM(MOV,0) 82 . . S MTIM=$P(X0,U,1),Y=MTIM D DD^%DT S XTIM=Y 83 . . S XTYP=$P($G(^DG(405.1,+$P(X0,U,4),0)),U,1) 84 . . S XLOC=$P($G(^DIC(42,+$P(X0,U,6),0)),U,1),HLOC=+$G(^(44)) 85 . . S ILST=ILST+1,LST(ILST)=MTIM_U_HLOC_U_XTIM_U_XTYP_U_"TO: "_XLOC 86 Q 1 ORWPT16 ; SLC/KCM - Patient Lookup Functions - 16bit ;7/20/96 15:43 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997 3 ; 4 IDINFO(ORY,DFN) ; Return identifying information for a patient 5 ; PID^DOB^AGE^SEX^SC%^TYPE^WARD^RM-BED^NAME 6 N OR0,OR36,OR1,OR101,VAEL,VAERR 7 S OR0=$G(^DPT(DFN,0)),OR36=$G(^(.36)),OR1=$G(^(.1)),OR101=$G(^(.101)) 8 D ELIG^VADPT 9 S ORY=$P(OR36,U,3)_U_$P(OR0,U,3)_U_U_$P(OR0,U,2) 10 S ORY=ORY_U_$P(VAEL(3),U,2)_U_$P(VAEL(6),U,2)_U_$P(OR1,U)_U_$P(OR101,U) 11 I $P(OR0,U,3) S $P(ORY,U,3)=DT-$P(OR0,U,3)\10000 12 I '$L($P(ORY,U,1)) D 13 . S X=$P(OR0,U,9),$P(ORY,U,1)=$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,99) 14 S $P(ORY,U,9)=$P(OR0,U,1) 15 Q 16 DEMOG(VAL,DFN) ; procedure 17 ; Return common patient demographic info 18 ; NAME^SEX^DOB^SSN^WARDID^WARDNAME^RMBED^ADMITTIME^DIED ;^SC%^ELIGTYPE 19 S X=^DPT(DFN,0),VAL=$P(X,U,1,3)_U_$P(X,U,9)_U_U_$G(^(.1))_U_$G(^(.101)) 20 S X=$P(VAL,U,6) I $L(X) S $P(VAL,U,5)=$O(^SC("B",X,0)) 21 S X=$G(^DPT(DFN,.105)) I X S $P(VAL,U,8)=$P(^DGPM(X,0),U,1) 22 I $L($P($G(^DPT(DFN,.35)),U,1)) S $P(VAL,U,9)=$P(^(.35),U,1) 23 Q 24 PSCNVT(VAL,DFN) ; procedure 25 ; Call conversion routine for pharmacy (both inpatient and outpatient) 26 S VAL=0 27 S:'$D(IOST) IOST="P-OTHER" ; don't know why broker doesn't define IOST 28 S VAL=$$OTF^OR3CONV(DFN,1) 29 ; D EN1^PSOHLUP(DFN,0) 30 ; D EN^LR7OV2(DFN,0) 31 ; S VAL=1 32 Q 33 LISTALL(Y,DIR,FROM) ; Return a bolus of patient names 34 N I,IEN,CNT S CNT=44,I=0 35 ; 36 I DIR=0 D ; Forward direction 37 . F S FROM=$O(^DPT("B",FROM)) Q:FROM="" D Q:I=CNT 38 . . S IEN=0 F S IEN=$O(^DPT("B",FROM,IEN)) Q:'IEN D Q:I=CNT 39 . . . ; S X=$P($G(^DPT(IEN,0)),"^",9) 40 . . . ; S X=$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,99) 41 . . . ; S X1=$G(^DPT(IEN,.1))_" "_$G(^DPT(IEN,.101)) 42 . . . S I=I+1 S Y(I)=IEN_"^"_FROM ;_"^"_X ; _"^"_X1 ;" ("_X_")" 43 . I $G(Y(CNT))="" S I=I+1,Y(I)="" 44 ; 45 I DIR=1 D ; Reverse direction 46 . F S FROM=$O(^DPT("B",FROM),-1) Q:FROM="" D Q:I=CNT 47 . . S IEN=0 F S IEN=$O(^DPT("B",FROM,IEN)) Q:'IEN D Q:I=CNT 48 . . . ; S X=$P($G(^DPT(IEN,0)),"^",9) 49 . . . ; S X=$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,99) 50 . . . ; S X1=$G(^DPT(IEN,.1))_" "_$G(^DPT(IEN,.101)) 51 . . . S I=I+1 S Y(I)=IEN_"^"_FROM ;_"^"_X ; _"^"_X1 ;" ("_X_")" 52 Q 53 LOOKUP(Y,FROM) ; Return a set of patient names 54 N I,X 55 D FIND^DIC(2,"","","M",FROM) 56 S I=0,Y="" 57 F S I=$O(^TMP("DILIST",$J,1,I)) Q:'I D 58 . S X=^TMP("DILIST",$J,"ID",I,.09) 59 . S X=$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,99) 60 . S Y(I)=^TMP("DILIST",$J,2,I)_"^"_^TMP("DILIST",$J,1,I)_"^"_X 61 K ^TMP("DILIST",$J) 62 Q 63 GETVSIT(Y,DFN,LOC,ADATE) ; procedure 64 ; Return a visit given a patient, location, and date/time 65 N VSIT,VSITPKG 66 S (VSIT,VSIT("VDT"))=ADATE,VSIT("PAT")=DFN,VSIT("LOC")=LOC 67 S VSIT("SVC")="A",VSIT("PRI")="P",VSIT(0)="NMD1",VSITPKG="OR" 68 D ^VSIT 69 S Y=VSIT("IEN") I +VSIT("IEN")'>0 S Y="" Q 70 I +VSIT("LOC") S Y=Y_U_VSIT("LOC")_U_$P(^SC(+VSIT("LOC"),0),U,1,2) 71 Q 72 APPTLST(LST,DFN) ; procedure 73 ; Return a list of appointments 74 N I,ILST S ILST=0 75 D GETAPPT^TIUVSIT(DFN) 76 S I=0 F S I=$O(^TMP("TIUVNI",$J,I)) Q:'I D 77 . S ILST=ILST+1 78 . S LST(ILST)=$P(^TMP("TIUVNI",$J,I),U,1,2)_U_$P(^TMP("TIUVN",$J,I),U,1,2) 79 K ^TMP("TIUVN",$J),^TMP("TIUVNI",$J) 80 Q 81 ADMITLST(LST,DFN) ; procedure 82 ; Return a list of admissions 83 N TIM,MOV,X0,Y,MTIM,XTIM,XTYP,XLOC,HLOC,ILST S ILST=0 84 S TIM="" F S TIM=$O(^DGPM("ATID1",DFN,TIM)) Q:TIM'>0 D 85 . S MOV=0 F S MOV=$O(^DGPM("ATID1",DFN,TIM,MOV)) Q:MOV'>0 D 86 . . S X0=^DGPM(MOV,0) 87 . . S MTIM=$P(X0,U,1),Y=MTIM D DD^%DT S XTIM=Y 88 . . S XTYP=$P($G(^DG(405.1,+$P(X0,U,4),0)),U,1) 89 . . S XLOC=$P($G(^DIC(42,+$P(X0,U,6),0)),U,1),HLOC=+$G(^(44)) 90 . . S ILST=ILST+1,LST(ILST)=MTIM_U_HLOC_U_XTIM_U_XTYP_U_"TO: "_XLOC 91 Q
Note:
See TracChangeset
for help on using the changeset viewer.
